forked from GitHub/gf-core
strict reading of files; bug fix in readFiles in ShellState
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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,
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user