gfe as preprocessing to compiler

1 files changed, 24 insertions, 10 deletions

diff --git a/src/GF/Compile/MkConcrete.hs b/src/GF/Compile/MkConcrete.hs
index ee01b2232..7d228de39 100644
--- a/src/GF/Compile/MkConcrete.hs
+++ b/src/GF/Compile/MkConcrete.hs
@@ -20,15 +20,20 @@ import GF.Grammar.Grammar (Term(Q,QC)) ---
 import GF.Grammar.Macros (composSafeOp, record2subst)
 import GF.Compile.ShellState (firstStateGrammar)
 import GF.Compile.PGrammar (pTerm)
+import GF.Compile.Compile
 import GF.API
 import qualified GF.Embed.EmbedAPI as EA
 
 import GF.Data.Operations
 import GF.Infra.UseIO
 import GF.Infra.Option
+import GF.Infra.ReadFiles
+import GF.System.Arch
 
+import System.Directory
 import Data.Char
 import Control.Monad
+import Data.List
 
 -- translate strings into lin rules by parsing in a resource
 -- grammar. AR 2/6/2005
@@ -47,12 +52,16 @@ import Control.Monad
 -- notice: we use a hand-crafted lexer and parser in order to preserve
 -- the layout and comments in the rest of the file.
 
-
 mkConcretes :: [FilePath] -> IO ()
-mkConcretes [] = putStrLn "no files to process"
-mkConcretes files@(file:_) = do
-  cont <- liftM lines $ readFileIf file
-  let res = getResPath cont
+mkConcretes files = do
+  ress <- mapM getResPath files
+  let grps = groupBy (\a b -> fst a == fst b) $ 
+               sortBy (\a b -> compare (fst a) (fst b)) $ zip ress files
+  mapM_ mkCncGroups [(r,map snd gs) | gs@((r,_):_) <- grps]
+
+mkCncGroups (res,files) = do
+  putStrLnFlush $ "Going to preprocess examples in " ++ unwords files
+  putStrLn $ "Compiling resource " ++ res
   egr <- appIOE $ 
     optFile2grammar (options 
       [useOptimizer "share",fromSource,beSilent,notEmitCode]) res --- for -mcfg
@@ -60,6 +69,7 @@ mkConcretes files@(file:_) = do
   let parser cat = errVal ([],"No parse") . 
                    optParseArgErrMsg (options [newMParser, firstCat cat, beVerbose]) gr
   let morpho = isKnownWord gr
+  putStrLn "Building parser"
   mapM_ (mkConcrete parser morpho) files
 
 type Parser = String -> String -> ([Tree],String)
@@ -69,13 +79,16 @@ mkConcrete :: Parser -> Morpho -> FilePath -> IO ()
 mkConcrete parser morpho file = do
   cont <- liftM getExLines $ readFileIf file
   let out = suffixFile "gf" $ justModuleName file
-  writeFile out ""
+  writeFile out $ "-- File generated by GF from " ++ file
+  appendFile out "\n"
   mapM_ (mkCnc out parser morpho) cont
 
-getResPath :: [String] -> String
-getResPath s = case head (dropWhile (all isSpace) s) of
-  '-':'-':'#':path -> reverse (takeWhile (not . (=='=')) (reverse path))
-  _ -> error "first line must be --# -resource=<PATH>" 
+getResPath :: FilePath -> IO String
+getResPath file = do
+  s <- liftM lines $ readFileIf file
+  return $ case head (dropWhile (all isSpace) s) of
+    '-':'-':'#':path -> reverse (takeWhile (not . (=='=')) (reverse path))
+    _ -> error "first line must be --# -resource=<PATH>" 
 
 getExLines :: String -> [Either String String]
 getExLines = getl . lines where
@@ -135,3 +148,4 @@ doSubst subst0 trm = prt_ $ subt subst trm where
     Q  _ c -> maybe t id $ lookup c g
     QC _ c -> maybe t id $ lookup c g
     _      -> composSafeOp (subt g) t
+