strict reading of files; bug fix in readFiles in ShellState

This commit is contained in:
aarne
2007-09-16 20:52:27 +00:00
parent 3a9d7c11f7
commit 4d2992d69f
4 changed files with 27 additions and 13 deletions

View File

@@ -38,9 +38,11 @@ getNoparseFromFile :: Options -> FilePath -> IO NoParse
getNoparseFromFile opts file = do getNoparseFromFile opts file = do
let f = maybe file id $ getOptVal opts noparseFile let f = maybe file id $ getOptVal opts noparseFile
s <- readFile f s <- readFile f
return $ igns s let tree = buildTree $ flip zip (repeat ()) $ concat $ map getIgnores $ lines s
tree `seq` return $ igns tree
where where
igns s i = isInBinTree i $ buildTree $ flip zip (repeat ()) $ concat $ map getIgnores $ lines s igns tree i = isInBinTree i tree
-- where -- where
getIgnores s = case dropWhile (/="--#") (words s) of getIgnores s = case dropWhile (/="--#") (words s) of
_:"noparse":fs -> map identC fs _:"noparse":fs -> map identC fs

View File

@@ -282,7 +282,7 @@ updateShellState opts ign mcnc sh ((_,sgr,gr,eenv),rts) = do
treebanks = treebanks sh, treebanks = treebanks sh,
probss = zip concrs probss, probss = zip concrs probss,
gloptions = gloptions sh, --- opts, -- this would be command-line options gloptions = gloptions sh, --- opts, -- this would be command-line options
readFiles = [ft | ft@(_,(f,_)) <- readFiles sh, notInrts f] ++ rts, readFiles = [ft | ft@(f,(_,_)) <- readFiles sh, notInrts f] ++ rts,
absCats = csi, absCats = csi,
statistics = [StDepTypes deps,StBoundVars binds], statistics = [StDepTypes deps,StBoundVars binds],
transfers = transfers sh, transfers = transfers sh,

View File

@@ -304,6 +304,7 @@ getModuleHeader ws = case ws of
---- ((MTyOther,name),(m,MUInstance):(n,MUOther):[(n,MUComplete) | n <- ms]) ---- ((MTyOther,name),(m,MUInstance):(n,MUOther):[(n,MUComplete) | n <- ms])
m:"with":ms -> ((MTyOther,name),(m,MUOther):[(n,MUComplete) | n <- ms]) m:"with":ms -> ((MTyOther,name),(m,MUOther):[(n,MUComplete) | n <- ms])
ms -> ((MTyOther,name),[(n,MUOther) | n <- ms]) ms -> ((MTyOther,name),[(n,MUOther) | n <- ms])
_ -> error "the file is empty"
unComm s = case s of unComm s = case s of
'-':'-':cs -> unComm $ dropWhile (/='\n') cs '-':'-':cs -> unComm $ dropWhile (/='\n') cs
@@ -323,14 +324,14 @@ lexs s = x:xs where
-- | options can be passed to the compiler by comments in @--#@, in the main file -- | options can be passed to the compiler by comments in @--#@, in the main file
getOptionsFromFile :: FilePath -> IO Options getOptionsFromFile :: FilePath -> IO Options
getOptionsFromFile file = do getOptionsFromFile file = do
s <- readFileIf file s <- readFileIfStrict file
let ls = filter (isPrefixOf "--#") $ lines s let ls = filter (isPrefixOf "--#") $ lines s
return $ fst $ getOptions "-" $ map (unwords . words . drop 3) ls return $ fst $ getOptions "-" $ map (unwords . words . drop 3) ls
-- | check if old GF file -- | check if old GF file
isOldFile :: FilePath -> IO Bool isOldFile :: FilePath -> IO Bool
isOldFile f = do isOldFile f = do
s <- readFileIf f s <- readFileIfStrict f
let s' = unComm s let s' = unComm s
return $ not (null s') && old (head (words s')) return $ not (null s') && old (head (words s'))
where where

View File

@@ -72,8 +72,16 @@ putPoint' f opts msg act = do
ve $ putCPU ve $ putCPU
return a return a
readFileIf :: String -> IO String readFileStrict :: String -> IO String
readFileIf f = catch (readFile f) (\_ -> reportOn f) where readFileStrict f = do
s <- readFile f
return $ seq (length s) ()
return s
readFileIf = readFileIfs readFile
readFileIfStrict = readFileIfs readFileStrict
readFileIfs rf f = catch (rf f) (\_ -> reportOn f) where
reportOn f = do reportOn f = do
putStrLnFlush ("File " ++ f ++ " does not exist. Returned empty string") putStrLnFlush ("File " ++ f ++ " does not exist. Returned empty string")
return "" return ""
@@ -94,15 +102,18 @@ getFilePath ps file = getFilePathMsg ("file" +++ file +++ "not found\n") ps file
getFilePathMsg :: String -> [FilePath] -> String -> IO (Maybe FilePath) getFilePathMsg :: String -> [FilePath] -> String -> IO (Maybe FilePath)
getFilePathMsg msg paths file = get paths where getFilePathMsg msg paths file = get paths where
get [] = putStrFlush msg >> return Nothing get [] = putStrFlush msg >> return Nothing
get (p:ps) = let pfile = prefixPathName p file in get (p:ps) = do
catch (readFile pfile >> return (Just pfile)) (\_ -> get ps) let pfile = prefixPathName p file
exist <- doesFileExist pfile
if exist then return (Just pfile) else get ps
--- catch (readFileStrict pfile >> return (Just pfile)) (\_ -> get ps)
readFileIfPath :: [FilePath] -> String -> IOE (FilePath,String) readFileIfPath :: [FilePath] -> String -> IOE (FilePath,String)
readFileIfPath paths file = do readFileIfPath paths file = do
mpfile <- ioeIO $ getFilePath paths file mpfile <- ioeIO $ getFilePath paths file
case mpfile of case mpfile of
Just pfile -> do Just pfile -> do
s <- ioeIO $ readFile pfile s <- ioeIO $ readFileStrict pfile
return (justInitPath pfile,s) return (justInitPath pfile,s)
_ -> ioeErr $ Bad ("File " ++ file ++ " does not exist.") _ -> ioeErr $ Bad ("File " ++ file ++ " does not exist.")
@@ -298,7 +309,7 @@ gfLibraryPath = "GF_LIB_PATH"
-- ((do {s <- readFile f; return (return s)}) ) -- ((do {s <- readFile f; return (return s)}) )
readFileIOE :: FilePath -> IOE (String) readFileIOE :: FilePath -> IOE (String)
readFileIOE f = ioe $ catch (readFile f >>= return . return) readFileIOE f = ioe $ catch (readFileStrict f >>= return . return)
(\_ -> return (Bad (reportOn f))) where (\_ -> return (Bad (reportOn f))) where
reportOn f = "File " ++ f ++ " not found." reportOn f = "File " ++ f ++ " not found."
@@ -311,13 +322,13 @@ readFileIOE f = ioe $ catch (readFile f >>= return . return)
-- FIXME: unix-specific, \/ is \\ on Windows -- FIXME: unix-specific, \/ is \\ on Windows
readFileLibraryIOE :: String -> FilePath -> IOE (FilePath, String) readFileLibraryIOE :: String -> FilePath -> IOE (FilePath, String)
readFileLibraryIOE ini f = readFileLibraryIOE ini f =
ioe $ catch ((do {s <- readFile initPath; return (return (initPath,s))})) ioe $ catch ((do {s <- readFileStrict initPath; return (return (initPath,s))}))
(\_ -> tryLibrary ini f) where (\_ -> tryLibrary ini f) where
tryLibrary :: String -> FilePath -> IO (Err (FilePath, String)) tryLibrary :: String -> FilePath -> IO (Err (FilePath, String))
tryLibrary ini f = tryLibrary ini f =
catch (do { catch (do {
lp <- getLibPath; lp <- getLibPath;
s <- readFile (lp ++ f); s <- readFileStrict (lp ++ f);
return (return (lp ++ f, s)) return (return (lp ++ f, s))
}) (\_ -> return (Bad (reportOn f))) }) (\_ -> return (Bad (reportOn f)))
initPath = addInitFilePath ini f initPath = addInitFilePath ini f