From 4d2992d69fb8d254e59f8e7fc0208377bcbe8779 Mon Sep 17 00:00:00 2001 From: aarne Date: Sun, 16 Sep 2007 20:52:27 +0000 Subject: [PATCH] strict reading of files; bug fix in readFiles in ShellState --- src/GF/Compile/NoParse.hs | 6 ++++-- src/GF/Compile/ShellState.hs | 2 +- src/GF/Infra/ReadFiles.hs | 5 +++-- src/GF/Infra/UseIO.hs | 27 +++++++++++++++++++-------- 4 files changed, 27 insertions(+), 13 deletions(-) diff --git a/src/GF/Compile/NoParse.hs b/src/GF/Compile/NoParse.hs index 0e37c9f95..c8f828970 100644 --- a/src/GF/Compile/NoParse.hs +++ b/src/GF/Compile/NoParse.hs @@ -38,9 +38,11 @@ getNoparseFromFile :: Options -> FilePath -> IO NoParse getNoparseFromFile opts file = do let f = maybe file id $ getOptVal opts noparseFile s <- readFile f - return $ igns s + let tree = buildTree $ flip zip (repeat ()) $ concat $ map getIgnores $ lines s + tree `seq` return $ igns tree where - igns s i = isInBinTree i $ buildTree $ flip zip (repeat ()) $ concat $ map getIgnores $ lines s + igns tree i = isInBinTree i tree + -- where getIgnores s = case dropWhile (/="--#") (words s) of _:"noparse":fs -> map identC fs diff --git a/src/GF/Compile/ShellState.hs b/src/GF/Compile/ShellState.hs index 3793b8651..e01171b18 100644 --- a/src/GF/Compile/ShellState.hs +++ b/src/GF/Compile/ShellState.hs @@ -282,7 +282,7 @@ updateShellState opts ign mcnc sh ((_,sgr,gr,eenv),rts) = do treebanks = treebanks sh, probss = zip concrs probss, 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, statistics = [StDepTypes deps,StBoundVars binds], transfers = transfers sh, diff --git a/src/GF/Infra/ReadFiles.hs b/src/GF/Infra/ReadFiles.hs index 699eb5081..fa3298158 100644 --- a/src/GF/Infra/ReadFiles.hs +++ b/src/GF/Infra/ReadFiles.hs @@ -304,6 +304,7 @@ getModuleHeader ws = case ws of ---- ((MTyOther,name),(m,MUInstance):(n,MUOther):[(n,MUComplete) | n <- ms]) m:"with":ms -> ((MTyOther,name),(m,MUOther):[(n,MUComplete) | n <- ms]) ms -> ((MTyOther,name),[(n,MUOther) | n <- ms]) + _ -> error "the file is empty" unComm s = case s of '-':'-':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 getOptionsFromFile :: FilePath -> IO Options getOptionsFromFile file = do - s <- readFileIf file + s <- readFileIfStrict file let ls = filter (isPrefixOf "--#") $ lines s return $ fst $ getOptions "-" $ map (unwords . words . drop 3) ls -- | check if old GF file isOldFile :: FilePath -> IO Bool isOldFile f = do - s <- readFileIf f + s <- readFileIfStrict f let s' = unComm s return $ not (null s') && old (head (words s')) where diff --git a/src/GF/Infra/UseIO.hs b/src/GF/Infra/UseIO.hs index dd8ad8d1a..101f09c54 100644 --- a/src/GF/Infra/UseIO.hs +++ b/src/GF/Infra/UseIO.hs @@ -72,8 +72,16 @@ putPoint' f opts msg act = do ve $ putCPU return a -readFileIf :: String -> IO String -readFileIf f = catch (readFile f) (\_ -> reportOn f) where +readFileStrict :: String -> IO String +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 putStrLnFlush ("File " ++ f ++ " does not exist. Returned empty string") return "" @@ -94,15 +102,18 @@ getFilePath ps file = getFilePathMsg ("file" +++ file +++ "not found\n") ps file getFilePathMsg :: String -> [FilePath] -> String -> IO (Maybe FilePath) getFilePathMsg msg paths file = get paths where get [] = putStrFlush msg >> return Nothing - get (p:ps) = let pfile = prefixPathName p file in - catch (readFile pfile >> return (Just pfile)) (\_ -> get ps) + get (p:ps) = do + 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 paths file = do mpfile <- ioeIO $ getFilePath paths file case mpfile of Just pfile -> do - s <- ioeIO $ readFile pfile + s <- ioeIO $ readFileStrict pfile return (justInitPath pfile,s) _ -> ioeErr $ Bad ("File " ++ file ++ " does not exist.") @@ -298,7 +309,7 @@ gfLibraryPath = "GF_LIB_PATH" -- ((do {s <- readFile f; return (return s)}) ) 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 reportOn f = "File " ++ f ++ " not found." @@ -311,13 +322,13 @@ readFileIOE f = ioe $ catch (readFile f >>= return . return) -- FIXME: unix-specific, \/ is \\ on Windows readFileLibraryIOE :: String -> FilePath -> IOE (FilePath, String) 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 :: String -> FilePath -> IO (Err (FilePath, String)) tryLibrary ini f = catch (do { lp <- getLibPath; - s <- readFile (lp ++ f); + s <- readFileStrict (lp ++ f); return (return (lp ++ f, s)) }) (\_ -> return (Bad (reportOn f))) initPath = addInitFilePath ini f