From 8333aee547913ff295b3ba4fd2dd58718fc23be2 Mon Sep 17 00:00:00 2001 From: krasimir Date: Sat, 31 Jan 2009 20:36:41 +0000 Subject: [PATCH] some dead code elimination in UseIO and ReadFiles --- src/GF/Compile/ReadFiles.hs | 19 +++++++++-- src/GF/Compile/TypeCheck.hs | 1 - src/GF/Data/Operations.hs | 7 +--- src/GF/Infra/UseIO.hs | 68 ------------------------------------- 4 files changed, 17 insertions(+), 78 deletions(-) diff --git a/src/GF/Compile/ReadFiles.hs b/src/GF/Compile/ReadFiles.hs index f8b6f9e51..53ecaab89 100644 --- a/src/GF/Compile/ReadFiles.hs +++ b/src/GF/Compile/ReadFiles.hs @@ -88,13 +88,13 @@ getAllFiles opts ps env file = do findModule :: ModName -> IOE ModuleInfo findModule name = do (file,gfTime,gfoTime) <- do - mb_gfFile <- ioeIO $ getFilePathMsg "" ps (gfFile name) + mb_gfFile <- ioeIO $ getFilePath ps (gfFile name) case mb_gfFile of Just gfFile -> do gfTime <- ioeIO $ getModificationTime gfFile mb_gfoTime <- ioeIO $ catch (liftM Just $ getModificationTime (replaceExtension gfFile "gfo")) (\_->return Nothing) return (gfFile, Just gfTime, mb_gfoTime) - Nothing -> do mb_gfoFile <- ioeIO $ getFilePathMsg "" ps (gfoFile name) + Nothing -> do mb_gfoFile <- ioeIO $ getFilePath ps (gfoFile name) case mb_gfoFile of Just gfoFile -> do gfoTime <- ioeIO $ getModificationTime gfoFile return (gfoFile, Nothing, Just gfoTime) @@ -212,7 +212,20 @@ importsOfModule (m,mi) = (modName m,depModInfo mi []) -- | options can be passed to the compiler by comments in @--#@, in the main file getOptionsFromFile :: FilePath -> IOE Options getOptionsFromFile file = do - s <- ioeIO $ readFileIfStrict file + s <- ioe $ catch (fmap Ok $ BS.readFile file) + (\_ -> return (Bad $ "File " ++ file ++ " does not exist")) let ls = filter (BS.isPrefixOf (BS.pack "--#")) $ BS.lines s fs = map (BS.unpack . BS.unwords . BS.words . BS.drop 3) ls ioeErr $ parseModuleOptions fs + +getFilePath :: [FilePath] -> String -> IO (Maybe FilePath) +getFilePath paths file = get paths + where + get [] = return Nothing + get (p:ps) = do + let pfile = p file + exist <- doesFileExist pfile + if not exist + then get ps + else do pfile <- canonicalizePath pfile + return (Just pfile) diff --git a/src/GF/Compile/TypeCheck.hs b/src/GF/Compile/TypeCheck.hs index 04fb44b18..ae2c9abde 100644 --- a/src/GF/Compile/TypeCheck.hs +++ b/src/GF/Compile/TypeCheck.hs @@ -32,7 +32,6 @@ import GF.Grammar.Unify --- import GF.Compile.TC import Control.Monad (foldM, liftM, liftM2) -import Data.List (nub) --- -- | invariant way of creating TCEnv from context initTCEnv gamma = diff --git a/src/GF/Data/Operations.hs b/src/GF/Data/Operations.hs index 9b8f30fe1..bd5d6f452 100644 --- a/src/GF/Data/Operations.hs +++ b/src/GF/Data/Operations.hs @@ -21,7 +21,7 @@ module GF.Data.Operations (-- * misc functions Err(..), err, maybeErr, testErr, errVal, errIn, lookupErr, mapPairListM, mapPairsM, pairM, - (!?), singleton, mapsErr, mapsErrTree, + singleton, mapsErr, mapsErrTree, -- ** checking checkUnique, @@ -77,7 +77,6 @@ infixr 5 +++ infixr 5 ++- infixr 5 ++++ infixr 5 +++++ -infixl 9 !? ifNull :: b -> ([a] -> b) -> [a] -> b ifNull b f xs = if null xs then b else f xs @@ -118,10 +117,6 @@ mapPairsM f xys = mapM (\ (x,y) -> liftM ((,) x) (f y)) xys pairM :: Monad a => (b -> a c) -> (b,b) -> a (c,c) pairM op (t1,t2) = liftM2 (,) (op t1) (op t2) --- @!!@ with the error monad -(!?) :: [a] -> Int -> Err a -xs !? i = foldr (const . return) (Bad "too few elements in list") $ drop i xs - singleton :: a -> [a] singleton = (:[]) diff --git a/src/GF/Infra/UseIO.hs b/src/GF/Infra/UseIO.hs index b4cf48f1f..c0cd95eeb 100644 --- a/src/GF/Infra/UseIO.hs +++ b/src/GF/Infra/UseIO.hs @@ -49,48 +49,10 @@ errOptIO os e m = case m of putIfVerb os k return e -readFileIf f = catch (readFile f) (\_ -> reportOn f) where - reportOn f = do - putStrLnFlush ("File " ++ f ++ " does not exist. Returned empty string") - return "" - -readFileIfStrict f = catch (BS.readFile f) (\_ -> reportOn f) where - reportOn f = do - putStrLnFlush ("File " ++ f ++ " does not exist. Returned empty string") - return BS.empty - type FileName = String type InitPath = String type FullPath = String -getFilePath :: [FilePath] -> String -> IO (Maybe FilePath) -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) = do - let pfile = p file - exist <- doesFileExist pfile - if not exist - then get ps - else do pfile <- canonicalizePath pfile - return (Just pfile) - -readFileIfPath :: [FilePath] -> String -> IOE (FilePath,BS.ByteString) -readFileIfPath paths file = do - mpfile <- ioeIO $ getFilePath paths file - case mpfile of - Just pfile -> do - s <- ioeIO $ BS.readFile pfile - return (dropFileName pfile,s) - _ -> ioeErr $ Bad ("File " ++ file ++ " does not exist.") - -doesFileExistPath :: [FilePath] -> String -> IOE Bool -doesFileExistPath paths file = do - mpfile <- ioeIO $ getFilePathMsg "" paths file - return $ maybe False (const True) mpfile - gfLibraryPath = "GF_LIB_PATH" gfGrammarPathVar = "GF_GRAMMAR_PATH" @@ -143,10 +105,6 @@ splitInModuleSearchPath s = case break isPathSep s of -- -getLineWell :: IO String -> IO String -getLineWell ios = - catch getLine (\e -> if (isEOFError e) then ios else ioError e) - putStrFlush :: String -> IO () putStrFlush s = putStr s >> hFlush stdout @@ -223,29 +181,3 @@ putPointE v opts msg act = do readFileIOE :: FilePath -> IOE BS.ByteString readFileIOE f = ioe $ catch (BS.readFile f >>= return . return) (\e -> return (Bad (show e))) - --- | like readFileIOE but look also in the GF library if file not found --- --- intended semantics: if file is not found, try @\$GF_LIB_PATH\/file@ --- (even if file is an absolute path, but this should always fail) --- it returns not only contents of the file, but also the path used -readFileLibraryIOE :: String -> FilePath -> IOE (FilePath, BS.ByteString) -readFileLibraryIOE ini f = ioe $ do - lp <- getLibraryPath - tryRead ini $ \_ -> - tryRead lp $ \e -> - return (Bad (show e)) - where - tryRead path onError = - catch (BS.readFile fpath >>= \s -> return (return (fpath,s))) - onError - where - fpath = path f - --- | example -koeIOE :: IO () -koeIOE = useIOE () $ do - s <- ioeIO $ getLine - s2 <- ioeErr $ mapM (!? 2) $ words s - ioeIO $ putStrLn s2 -