GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-22 19:22:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

move GF.Formalism.FCFG types to GF.GFCC.DataGFCC

Browse Source
This commit is contained in:
krasimir
2008-05-29 12:08:45 +00:00
parent 363ddd7b91
commit 9a759a66dc
11 changed files with 176 additions and 269 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
src-3.0/GF/Compile/GenerateFCFG.hs
View File

@@ -20,7 +20,6 @@ import GF.Infra.PrintClass
import Control.Monad
import GF.Formalism.Utilities
import GF.Formalism.FCFG
import GF.GFCC.Macros --hiding (prt)
import GF.GFCC.DataGFCC
@@ -76,7 +75,7 @@ expandHOAS funs lins lincats = (funs' ++ hoFuns ++ varFuns,
-- lincat for the _Var category
varLincat = Map.singleton varCat (R [S []])
lincatOf c = fromMaybe (error $ "No lincat for " ++ prt c) $ Map.lookup c lincats
lincatOf c = fromMaybe (error $ "No lincat for " ++ prCId c) $ Map.lookup c lincats
modifyRec :: ([Term] -> [Term]) -> Term -> Term
modifyRec f (R xs) = R (f xs)
@@ -86,13 +85,13 @@ expandHOAS funs lins lincats = (funs' ++ hoFuns ++ varFuns,
catName :: (Int,CId) -> CId
catName (0,c) = c
catName (n,c) = mkCId ("_" ++ show n ++ prt c)
catName (n,c) = mkCId ("_" ++ show n ++ prCId c)
funName :: (Int,CId) -> CId
funName (n,c) = mkCId ("__" ++ show n ++ prt c)
funName (n,c) = mkCId ("__" ++ show n ++ prCId c)
varFunName :: CId -> CId
varFunName c = mkCId ("_Var_" ++ prt c)
varFunName c = mkCId ("_Var_" ++ prCId c)
-- replaces __NCat with _B and _Var_Cat with _.
-- the temporary names are just there to avoid name collisions.
@@ -176,6 +175,7 @@ translateLin idxArgs lbl' ((lbl,syms) : lins)
type CnvMonad a = BacktrackM Env a
type FPath = [FIndex]
type Env = (ProtoFCat, [(ProtoFCat,[FPath])], Term, [Term])
type LinRec = [(FPath, [Either (FPath, FIndex, Int) FToken])]
@@ -369,7 +369,7 @@ genFCatArg cnc_defs ctype env@(FRulesEnv last_id fcatSet rules) (PFCat cat rcs t
addConstraint path0 index0 cs = (path0,index0) : cs
gen_tcs (F id) path acc = case Map.lookup id cnc_defs of
Just term -> gen_tcs term path acc
Nothing -> error ("unknown identifier: "++prt id)
Nothing -> error ("unknown identifier: "++prCId id)
@@ -427,7 +427,7 @@ mkSingletonSelectors cnc_defs term = sels0
loop path (sels,tcss) (S _) = (mkSelector [path] tcss0 : sels, tcss)
loop path (sels,tcss) (F id) = case Map.lookup id cnc_defs of
Just term -> loop path (sels,tcss) term
Nothing -> error ("unknown identifier: "++prt id)
Nothing -> error ("unknown identifier: "++prCId id)
mkSelector :: [FPath] -> [[(FPath,FIndex)]] -> TermSelector
mkSelector rcs tcss =