mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-22 19:22:50 -06:00
made .cf grammars take their startcat from the first rule
This commit is contained in:
@@ -9,7 +9,7 @@
|
|||||||
-- > CVS $Author: aarne $
|
-- > CVS $Author: aarne $
|
||||||
-- > CVS $Revision: 1.13 $
|
-- > 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
|
module GF.Source.CF (getCF) where
|
||||||
@@ -18,6 +18,7 @@ import GF.Grammar.Grammar
|
|||||||
import GF.Grammar.Macros
|
import GF.Grammar.Macros
|
||||||
import GF.Infra.Ident
|
import GF.Infra.Ident
|
||||||
import GF.Infra.Modules
|
import GF.Infra.Modules
|
||||||
|
import GF.Infra.Option
|
||||||
|
|
||||||
import GF.Data.Operations
|
import GF.Data.Operations
|
||||||
|
|
||||||
@@ -81,19 +82,23 @@ type CFFun = String
|
|||||||
|
|
||||||
cf2gf :: String -> CF -> SourceGrammar
|
cf2gf :: String -> CF -> SourceGrammar
|
||||||
cf2gf name cf = MGrammar [
|
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})
|
(cname, emptyModInfo{mtype = MTConcrete aname, jments = cnc})
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
(abs,cnc) = cf2grammar cf
|
(abs,cnc,cat) = cf2grammar cf
|
||||||
aname = identS $ name ++ "Abs"
|
aname = identS $ name ++ "Abs"
|
||||||
cname = identS name
|
cname = identS name
|
||||||
|
|
||||||
|
|
||||||
cf2grammar :: CF -> (BinTree Ident Info, BinTree Ident Info)
|
cf2grammar :: CF -> (BinTree Ident Info, BinTree Ident Info, String)
|
||||||
cf2grammar rules = (buildTree abs, buildTree conc) where
|
cf2grammar rules = (buildTree abs, buildTree conc, cat) where
|
||||||
abs = cats ++ funs
|
abs = cats ++ funs
|
||||||
conc = lincats ++ lins
|
conc = lincats ++ lins
|
||||||
|
cat = case rules of
|
||||||
|
(_,(c,_)):_ -> c -- the value category of the first rule
|
||||||
|
_ -> error "empty CF"
|
||||||
cats = [(cat, AbsCat (Just []) (Just [])) |
|
cats = [(cat, AbsCat (Just []) (Just [])) |
|
||||||
cat <- nub (concat (map cf2cat rules))] ----notPredef cat
|
cat <- nub (concat (map cf2cat rules))] ----notPredef cat
|
||||||
lincats = [(cat, CncCat (Just defLinType) Nothing Nothing) | (cat,AbsCat _ _) <- cats]
|
lincats = [(cat, CncCat (Just defLinType) Nothing Nothing) | (cat,AbsCat _ _) <- cats]
|
||||||
|
|||||||
Reference in New Issue
Block a user