prelude sources to lib/src; present in StructuralEng; refactored checkGFCC

3 files changed, 25 insertions, 18 deletions

diff --git a/src/GF/Devel/GFC.hs b/src/GF/Devel/GFC.hs
index d074cf4fe..6780d32cb 100644
--- a/src/GF/Devel/GFC.hs
+++ b/src/GF/Devel/GFC.hs
@@ -10,6 +10,7 @@ import GF.GFCC.DataGFCC
 import GF.GFCC.ParGFCC
 import GF.Devel.UseIO
 import GF.Infra.Option
+import GF.GFCC.ErrM
 
 mainGFC :: [String] -> IO ()
 mainGFC xx = do
@@ -20,32 +21,38 @@ mainGFC xx = do
       gr <- batchCompile opts fs
       let name = justModuleName (last fs)
       let (abs,gc0) = mkCanon2gfcc opts name gr
-      gc1 <- check gc0
+      gc1 <- checkGFCCio gc0
       let gc = if oElem (iOpt "noopt") opts then gc1 else optGFCC gc1
-      let target = abs ++ ".gfcc"
-      writeFile target (printGFCC gc)
-      putStrLn $ "wrote file " ++ target
-      mapM_ (alsoPrint opts abs gc) printOptions
+      let target = targetName opts abs
+      let gfccFile =  target ++ ".gfcc"
+      writeFile gfccFile (printGFCC gc)
+      putStrLn $ "wrote file " ++ gfccFile
+      mapM_ (alsoPrint opts target gc) printOptions
 
     -- gfc -o target.gfcc source_1.gfcc ... source_n.gfcc
-    _ | all ((=="gfcc") . fileSuffix) fs && oElem (iOpt "o") opts -> do
-      let target:sources = fs
-      gfccs <- mapM file2gfcc sources
+    _ | all ((=="gfcc") . fileSuffix) fs -> do
+      gfccs <- mapM file2gfcc fs
       let gfcc = foldl1 unionGFCC gfccs
-      writeFile target (printGFCC gfcc)
+      let abs = printCId $ absname gfcc
+      let target = targetName opts abs
+      let gfccFile =  target ++ ".gfcc"
+      writeFile gfccFile (printGFCC gfcc)
+      putStrLn $ "wrote file " ++ gfccFile
+      mapM_ (alsoPrint opts target gfcc) printOptions
       
     _ -> do
       mapM_ (batchCompile opts) (map return fs)
       putStrLn "Done."
 
-check gfcc = do
-  (gc,b) <- checkGFCC gfcc
-  putStrLn $ if b then "OK" else "Corrupted GFCC"
-  return gc
-
-file2gfcc f =
-  readFileIf f >>= err (error) (return . mkGFCC) . pGrammar . myLexer
+file2gfcc f = do
+  f <- readFileIf f 
+  case pGrammar (myLexer f) of
+    Ok g -> return (mkGFCC g) 
+    Bad s -> error s
 
+targetName opts abs = case getOptVal opts (aOpt "target") of
+  Just n -> n
+  _ -> abs
 
 ---- TODO: nicer and richer print options
 
@@ -66,4 +73,4 @@ printOptions = [
   ]
 
 usageMsg = 
-  "usage: gfc (-h | --make (-noopt) (-js | -jsref | -haskell | -haskell_gadt)) (-src) FILES"
+  "usage: gfc (-h | --make (-noopt) (-target=PREFIX) (-js | -jsref | -haskell | -haskell_gadt)) (-src) FILES"
diff --git a/src/GF/Devel/GrammarToGFCC.hs b/src/GF/Devel/GrammarToGFCC.hs
index e83e7ebe9..7f346619d 100644
--- a/src/GF/Devel/GrammarToGFCC.hs
+++ b/src/GF/Devel/GrammarToGFCC.hs
@@ -380,7 +380,6 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
   P  t l   -> r2r tr
   PI t l i -> EInt $ toInteger i
 
-  T _ [_] -> error $ "single" +++ prt tr
   T (TWild _) _ -> error $ "wild" +++ prt tr
   T (TComp  ty) cs  -> t2t $ V ty $ map snd cs ---- should be elim'ed in tc
   T (TTyped ty) cs  -> t2t $ V ty $ map snd cs ---- should be elim'ed in tc
diff --git a/src/GF/Devel/PrintGFCC.hs b/src/GF/Devel/PrintGFCC.hs
index 18c174cd7..864fc07c0 100644
--- a/src/GF/Devel/PrintGFCC.hs
+++ b/src/GF/Devel/PrintGFCC.hs
@@ -13,3 +13,4 @@ prGFCC printer gr = case printer of
   "js" -> gfcc2js gr
   "jsref" -> gfcc2grammarRef gr
   _ -> printGFCC gr
+