ByteString.readFile should be used instead of readFileStrict. This fixes the problem with the open files

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)
 

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 

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
+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
    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 :: FilePath -> IOE BS.ByteString
-readFileIOE f = ioe $ catch (readFileStrict f >>= return . return)
+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

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,_,cs) | BS.null cs  = Nothing
-alexGetChar (p, _, (c:s)) =
+                     | otherwise = let c   = BS.head cs
-    let p' = alexMove p c
+                                       cs' = BS.tail cs
-     in p' `seq` Just (c, (p', c, s))
+                                       p'  = alexMove p c
+                                    in p' `seq` cs' `seq` Just (c, (p', c, cs'))
 
 alexInputPrevChar :: AlexInput -> Char
 alexInputPrevChar (p, c, s) = c