made .cf grammars take their startcat from the first rule

1 files changed, 10 insertions, 5 deletions

diff --git a/src/GF/Source/CF.hs b/src/GF/Source/CF.hs
index a25baddc1..7f0dcd5da 100644
--- a/src/GF/Source/CF.hs
+++ b/src/GF/Source/CF.hs
@@ -9,7 +9,7 @@
 -- > CVS $Author: aarne $
 -- > CVS $Revision: 1.13 $
 --
--- parsing CF grammars and conversing them to GF
+-- parsing CF grammars and converting them to GF
 -----------------------------------------------------------------------------
 
 module GF.Source.CF (getCF) where
@@ -18,6 +18,7 @@ import GF.Grammar.Grammar
 import GF.Grammar.Macros
 import GF.Infra.Ident
 import GF.Infra.Modules
+import GF.Infra.Option
 
 import GF.Data.Operations
 
@@ -81,19 +82,23 @@ type CFFun = String
 
 cf2gf :: String -> CF -> SourceGrammar
 cf2gf name cf = MGrammar [
-  (aname, emptyModInfo{mtype = MTAbstract,       jments = abs}),
+  (aname, addFlag (modifyFlags (\fs -> fs{optStartCat = Just cat}))
+          (emptyModInfo{mtype = MTAbstract,       jments = abs})),
   (cname, emptyModInfo{mtype = MTConcrete aname, jments = cnc})
   ]
  where
-   (abs,cnc) = cf2grammar cf
+   (abs,cnc,cat) = cf2grammar cf
    aname = identS $ name ++ "Abs"
    cname = identS name
 
 
-cf2grammar :: CF -> (BinTree Ident Info, BinTree Ident Info)
-cf2grammar rules = (buildTree abs, buildTree conc) where
+cf2grammar :: CF -> (BinTree Ident Info, BinTree Ident Info, String)
+cf2grammar rules = (buildTree abs, buildTree conc, cat) where
   abs   = cats ++ funs
   conc  = lincats ++ lins
+  cat   = case rules of
+            (_,(c,_)):_ -> c  -- the value category of the first rule
+            _ -> error "empty CF" 
   cats  = [(cat, AbsCat (Just []) (Just [])) | 
              cat <- nub (concat (map cf2cat rules))] ----notPredef cat
   lincats = [(cat, CncCat (Just defLinType) Nothing Nothing) | (cat,AbsCat _ _) <- cats]