unionGFCC, to put together GFCC grs with same abstract

3 files changed, 25 insertions, 2 deletions

diff --git a/src/GF/Devel/GFC.hs b/src/GF/Devel/GFC.hs
index 206d54206..b8c4277f3 100644
--- a/src/GF/Devel/GFC.hs
+++ b/src/GF/Devel/GFC.hs
@@ -6,6 +6,7 @@ import GF.Devel.GFCCtoJS
 import GF.GFCC.OptimizeGFCC
 import GF.GFCC.CheckGFCC
 import GF.GFCC.DataGFCC
+import GF.GFCC.ParGFCC
 import GF.Devel.UseIO
 import GF.Infra.Option
 
@@ -31,6 +32,14 @@ main = do
           writeFile js (gfcc2js gc)
           putStrLn $ "wrote file " ++ js
         else return ()
+
+    -- 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
+      let gfcc = foldl1 unionGFCC gfccs
+      writeFile target (printGFCC gfcc)
+      
     _ -> do
       mapM_ (batchCompile opts) (map return fs)
       putStrLn "Done."
@@ -40,3 +49,5 @@ check gfcc = do
   putStrLn $ if b then "OK" else "Corrupted GFCC"
   return gc
 
+file2gfcc f =
+  readFileIf f >>= err (error) (return . mkGFCC) . pGrammar . myLexer
diff --git a/src/GF/GFCC/API.hs b/src/GF/GFCC/API.hs
index 39f44e2a3..a35faacb5 100644
--- a/src/GF/GFCC/API.hs
+++ b/src/GF/GFCC/API.hs
@@ -77,7 +77,8 @@ startCat   :: MultiGrammar -> Category
 file2grammar f = do
   gfcc <- file2gfcc f
   let fcfgs = convertGrammar gfcc
-  return (MultiGrammar gfcc [(lang, buildFCFPInfo fcfg) | (CId lang,fcfg) <- fcfgs])
+  return (MultiGrammar gfcc 
+            [(lang, buildFCFPInfo fcfg) | (CId lang,fcfg) <- fcfgs])
 
 file2gfcc f =
   readFileIf f >>= err (error) (return . mkGFCC) . pGrammar . myLexer
diff --git a/src/GF/GFCC/DataGFCC.hs b/src/GF/GFCC/DataGFCC.hs
index 3d6cca3cc..ab2710e4c 100644
--- a/src/GF/GFCC/DataGFCC.hs
+++ b/src/GF/GFCC/DataGFCC.hs
@@ -21,7 +21,7 @@ data Abstr = Abstr {
   aflags  :: Map CId String,     -- value of a flag
   funs    :: Map CId (Type,Exp), -- type and def of a fun
   cats    :: Map CId [Hypo],     -- context of a cat
-  catfuns :: Map CId [CId]       -- funs yielding a cat (redundant, for fast lookup)
+  catfuns :: Map CId [CId]       -- funs to a cat (redundant, for fast lookup)
   }
 
 data Concr = Concr {
@@ -92,6 +92,17 @@ printGFCC gfcc0 = compactPrintGFCC $ printTree $ Grm
      [Lin f v | (f,v) <- assocs (printnames cnc)]
    gfcc = utf8GFCC gfcc0
 
+
+-- merge two GFCCs; fails is differens absnames; priority to second arg
+
+unionGFCC :: GFCC -> GFCC -> GFCC
+unionGFCC one two = 
+  if absname one == absname two
+    then one {
+      concretes = Data.Map.union (concretes two) (concretes one),
+      cncnames  = Data.List.union (cncnames two) (cncnames one)}
+    else one
+
 -- default map and filter are for Map here
 lmap = Prelude.map
 lfilter = Prelude.filter