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

arranging c2c

Browse Source
This commit is contained in:
aarne
2006-09-05 20:18:35 +00:00
parent f1fc34daaf
commit 117a1547b7
1 changed files with 14 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
src/GF/Canon/CanonToGFCC.hs
View File

@@ -82,21 +82,20 @@ mkTerm tr = case tr of
-- translate tables and records to arrays, return just one module per language -- translate tables and records to arrays, return just one module per language
canon2canon :: CanonGrammar -> CanonGrammar canon2canon :: CanonGrammar -> CanonGrammar
canon2canon cgr = M.MGrammar $ reorder $ map c2c $ M.modules cgr where canon2canon cgr = reorder $ M.MGrammar $ map c2c $ M.modules cgr where
reorder cgr = reorder cg = M.MGrammar $
(abs, M.ModMod $ (abs, M.ModMod $
M.Module M.MTAbstract M.MSComplete [] [] [] (sorted2tree adefs)): M.Module M.MTAbstract M.MSComplete [] [] [] (sorted2tree adefs)):
[(c, M.ModMod $ [(c, M.ModMod $
M.Module (M.MTConcrete abs) M.MSComplete [] [] [] (sorted2tree js)) M.Module (M.MTConcrete abs) M.MSComplete [] [] [] (sorted2tree js))
| (c,js) <- cncs] | (c,js) <- cncs cg]
abs = maybe (error "no abstract") id $ M.greatestAbstract cgr abs = maybe (error "no abstract") id $ M.greatestAbstract cgr
cns = M.allConcretes cgr abs
adefs = sortBy (\ (f,_) (g,_) -> compare f g) adefs = sortBy (\ (f,_) (g,_) -> compare f g)
[finfo | [finfo |
(i,mo) <- mos, M.isModAbs mo, (i,mo) <- mos, M.isModAbs mo,
finfo <- tree2list (M.jments mo)] finfo <- tree2list (M.jments mo)]
cncs = sortBy (\ (x,_) (y,_) -> compare x y) cncs cg = sortBy (\ (x,_) (y,_) -> compare x y)
[(lang, concr lang) | lang <- cns] [(lang, concr lang) | lang <- M.allConcretes cg abs]
mos = M.allModMod cgr mos = M.allModMod cgr
concr la = sortBy (\ (f,_) (g,_) -> compare f g) concr la = sortBy (\ (f,_) (g,_) -> compare f g)
[finfo | [finfo |
@@ -104,11 +103,11 @@ canon2canon cgr = M.MGrammar $ reorder $ map c2c $ M.modules cgr where
finfo <- tree2list (M.jments mo)] finfo <- tree2list (M.jments mo)]
c2c (c,m) = case m of c2c (c,m) = case m of
M.ModMod mo@(M.Module (M.MTConcrete _) M.MSComplete _ _ _ js) -> M.ModMod mo@(M.Module _ _ _ _ _ js) ->
(c, M.ModMod $ M.replaceJudgements mo $ mapTree (j2j c) js) (c, M.ModMod $ M.replaceJudgements mo $ mapTree j2j js)
_ -> (c,m) _ -> (c,m)
j2j c (f,j) = case j of j2j (f,j) = case j of
GFC.CncFun x y tr z -> (f,GFC.CncFun x y (t2t c tr) z) GFC.CncFun x y tr z -> (f,GFC.CncFun x y (t2t tr) z)
_ -> (f,j) _ -> (f,j)
t2t = term2term cgr (paramValues cgr) t2t = term2term cgr (paramValues cgr)
@@ -126,8 +125,8 @@ paramValues cgr = (untyps,typs) where
typs = Map.fromList [(ci,Map.fromList (zip vs [0..])) | (ci,vs) <- params] typs = Map.fromList [(ci,Map.fromList (zip vs [0..])) | (ci,vs) <- params]
untyps = Map.fromList $ concatMap Map.toList [typ | (_,typ) <- Map.toList typs] untyps = Map.fromList $ concatMap Map.toList [typ | (_,typ) <- Map.toList typs]
term2term :: CanonGrammar -> ParamEnv -> Ident -> Term -> Term term2term :: CanonGrammar -> ParamEnv -> Term -> Term
term2term cgr env@(untyps,typs) c tr = case tr of term2term cgr env@(untyps,typs) tr = case tr of
Par c ps | any isVar ps -> mkCase c ps Par c ps | any isVar ps -> mkCase c ps
Par _ _ -> EInt $ valNum tr Par _ _ -> EInt $ valNum tr
R rs | any (isStr . trmAss) rs -> R [Ass (r2r l) (t2t t) | Ass l t <- rs] R rs | any (isStr . trmAss) rs -> R [Ass (r2r l) (t2t t) | Ass l t <- rs]
@@ -137,7 +136,7 @@ term2term cgr env@(untyps,typs) c tr = case tr of
S t p -> S (t2t t) (t2t p) S t p -> S (t2t t) (t2t p)
_ -> composSafeOp t2t tr _ -> composSafeOp t2t tr
where where
t2t = term2term cgr env c t2t = term2term cgr env
r2r l = L (IC "_111") ---- TODO: number of label r2r l = L (IC "_111") ---- TODO: number of label
valNum tr = maybe 456 id $ Map.lookup tr untyps valNum tr = maybe 456 id $ Map.lookup tr untyps
isStr tr = case tr of isStr tr = case tr of