summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorkrasimir <krasimir@chalmers.se>2008-04-17 12:56:46 +0000
committerkrasimir <krasimir@chalmers.se>2008-04-17 12:56:46 +0000
commit21e5a60ce20652826a8d74a4357706fca86edfa9 (patch)
treebb2197e68ce51bcf84f3cdf7526e0ada801273d4 /src
parent0ea2798b3cc9bf60e99e01089ea2eddba64a9cbf (diff)
ByteString.readFile should be used instead of readFileStrict. This fixes the problem with the open files
Diffstat (limited to 'src')
-rw-r--r--src/GF/Devel/GetGrammar.hs1
-rw-r--r--src/GF/Devel/ReadFiles.hs8
-rw-r--r--src/GF/Devel/UseIO.hs33
-rw-r--r--src/GF/Source/LexGF.hs18
4 files changed, 31 insertions, 29 deletions
diff --git a/src/GF/Devel/GetGrammar.hs b/src/GF/Devel/GetGrammar.hs
index 4b54f789d..e8136b1dd 100644
--- a/src/GF/Devel/GetGrammar.hs
+++ b/src/GF/Devel/GetGrammar.hs
@@ -34,6 +34,7 @@ import GF.Devel.ReadFiles ----
import Data.Char (toUpper)
import Data.List (nub)
+import qualified Data.ByteString.Char8 as BS
import Control.Monad (foldM)
import System (system)
diff --git a/src/GF/Devel/ReadFiles.hs b/src/GF/Devel/ReadFiles.hs
index a99bc01b2..0a1d69d2a 100644
--- a/src/GF/Devel/ReadFiles.hs
+++ b/src/GF/Devel/ReadFiles.hs
@@ -35,6 +35,8 @@ import Data.Char
import Control.Monad
import Data.List
import System.Directory
+import qualified Data.ByteString.Char8 as BS
+
type ModName = String
type ModEnv = [(ModName,ModTime)]
@@ -202,7 +204,7 @@ getImports ps = get [] where
get ds file0 = do
let name = justModuleName file0 ---- fileBody file0
(p,s) <- tryRead name
- let ((typ,mname),imps) = importsOfFile s
+ let ((typ,mname),imps) = importsOfFile (BS.unpack s)
let namebody = justFileName name
ioeErr $ testErr (mname == namebody) $
"module name" +++ mname +++ "differs from file name" +++ namebody
@@ -317,14 +319,14 @@ lexs s = x:xs where
getOptionsFromFile :: FilePath -> IO Options
getOptionsFromFile file = do
s <- readFileIfStrict file
- let ls = filter (isPrefixOf "--#") $ lines s
+ let ls = filter (isPrefixOf "--#") $ lines (BS.unpack s)
return $ fst $ getOptions "-" $ map (unwords . words . drop 3) ls
-- | check if old GF file
isOldFile :: FilePath -> IO Bool
isOldFile f = do
s <- readFileIfStrict f
- let s' = unComm s
+ let s' = unComm (BS.unpack s)
return $ not (null s') && old (head (words s'))
where
old = flip elem $ words
diff --git a/src/GF/Devel/UseIO.hs b/src/GF/Devel/UseIO.hs
index db276ae75..e7b6e490e 100644
--- a/src/GF/Devel/UseIO.hs
+++ b/src/GF/Devel/UseIO.hs
@@ -26,6 +26,7 @@ import System.IO.Error
import System.Environment
import System.CPUTime
import Control.Monad
+import qualified Data.ByteString.Char8 as BS
#ifdef mingw32_HOST_OS
import System.Win32.DLL
@@ -80,20 +81,16 @@ putPoint' f opts msg act = do
ve $ putCPU
return a
-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
+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
@@ -116,12 +113,12 @@ getFilePathMsg msg paths file = get paths where
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,BS.ByteString)
readFileIfPath paths file = do
mpfile <- ioeIO $ getFilePath paths file
case mpfile of
Just pfile -> do
- s <- ioeIO $ readFileStrict pfile
+ s <- ioeIO $ BS.readFile pfile
return (justInitPath pfile,s)
_ -> ioeErr $ Bad ("File " ++ file ++ " does not exist.")
@@ -319,8 +316,8 @@ putPointEVerb opts = putPointE (addOption beVerbose opts)
gfLibraryPath = "GF_LIB_PATH"
-- ((do {s <- readFile f; return (return s)}) )
-readFileIOE :: FilePath -> IOE (String)
-readFileIOE f = ioe $ catch (readFileStrict f >>= return . return)
+readFileIOE :: FilePath -> IOE BS.ByteString
+readFileIOE f = ioe $ catch (BS.readFile f >>= return . return)
(\_ -> return (Bad (reportOn f))) where
reportOn f = "File " ++ f ++ " not found."
@@ -331,15 +328,15 @@ readFileIOE f = ioe $ catch (readFileStrict f >>= return . return)
-- it returns not only contents of the file, but also the path used
--
-- FIXME: unix-specific, \/ is \\ on Windows
-readFileLibraryIOE :: String -> FilePath -> IOE (FilePath, String)
+readFileLibraryIOE :: String -> FilePath -> IOE (FilePath, BS.ByteString)
readFileLibraryIOE ini f =
- ioe $ catch ((do {s <- readFileStrict initPath; return (return (initPath,s))}))
+ ioe $ catch (do {s <- BS.readFile initPath; return (return (initPath,s))})
(\_ -> tryLibrary ini f) where
- tryLibrary :: String -> FilePath -> IO (Err (FilePath, String))
+ tryLibrary :: String -> FilePath -> IO (Err (FilePath, BS.ByteString))
tryLibrary ini f =
catch (do {
lp <- getLibPath;
- s <- readFileStrict (lp ++ f);
+ s <- BS.readFile (lp ++ f);
return (return (lp ++ f, s))
}) (\_ -> return (Bad (reportOn f)))
initPath = addInitFilePath ini f
diff --git a/src/GF/Source/LexGF.hs b/src/GF/Source/LexGF.hs
index 6bdd4ab9f..89067b6b6 100644
--- a/src/GF/Source/LexGF.hs
+++ b/src/GF/Source/LexGF.hs
@@ -4,6 +4,7 @@
module GF.Source.LexGF where
+import qualified Data.ByteString.Char8 as BS
#if __GLASGOW_HASKELL__ >= 603
#include "ghcconfig.h"
@@ -119,24 +120,25 @@ alexMove (Pn a l c) _ = Pn (a+1) l (c+1)
type AlexInput = (Posn, -- current position,
Char, -- previous char
- String) -- current input string
+ BS.ByteString) -- current input string
-tokens :: String -> [Token]
+tokens :: BS.ByteString -> [Token]
tokens str = go (alexStartPos, '\n', str)
where
- go :: (Posn, Char, String) -> [Token]
+ go :: AlexInput -> [Token]
go inp@(pos, _, str) =
case alexScan inp 0 of
AlexEOF -> []
AlexError (pos, _, _) -> [Err pos]
AlexSkip inp' len -> go inp'
- AlexToken inp' len act -> act pos (take len str) : (go inp')
+ AlexToken inp' len act -> act pos (BS.unpack (BS.take len str)) : (go inp')
alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
-alexGetChar (p, c, []) = Nothing
-alexGetChar (p, _, (c:s)) =
- let p' = alexMove p c
- in p' `seq` Just (c, (p', c, s))
+alexGetChar (p,_,cs) | BS.null cs = Nothing
+ | otherwise = let c = BS.head cs
+ cs' = BS.tail cs
+ p' = alexMove p c
+ in p' `seq` cs' `seq` Just (c, (p', c, cs'))
alexInputPrevChar :: AlexInput -> Char
alexInputPrevChar (p, c, s) = c