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

started translating parameters to numbers in GFCC

Browse Source
This commit is contained in:
aarne
2006-09-05 17:11:40 +00:00
parent 8ece9156a2
commit e1d4def1b1
1 changed files with 35 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -16,6 +16,7 @@ module GF.Canon.CanonToGFCC (prCanon2gfcc) where
import GF.Canon.AbsGFC import GF.Canon.AbsGFC
import qualified GF.Canon.GFC as GFC import qualified GF.Canon.GFC as GFC
import qualified GF.Canon.Look as Look
import qualified GF.Canon.GFCC.AbsGFCC as C import qualified GF.Canon.GFCC.AbsGFCC as C
import qualified GF.Canon.GFCC.PrintGFCC as Pr import qualified GF.Canon.GFCC.PrintGFCC as Pr
import GF.Canon.GFC import GF.Canon.GFC
@@ -71,7 +72,8 @@ mkTerm tr = case tr of
K (KS s) -> C.K (C.KS s) K (KS s) -> C.K (C.KS s)
K (KP ss _) -> C.K (C.KP ss []) ---- TODO: prefix variants K (KP ss _) -> C.K (C.KP ss []) ---- TODO: prefix variants
E -> C.S [] E -> C.S []
Par _ _ -> C.C 456 ---- just for debugging Par _ _ -> C.C 444 ---- just for debugging
---- _ -> C.S [C.K (C.KS (show tr))] ---- just for debugging
_ -> C.S [C.K (C.KS (A.prt tr))] ---- just for debugging _ -> C.S [C.K (C.KS (A.prt tr))] ---- just for debugging
where where
mkLab (L (IC l)) = case l of mkLab (L (IC l)) = case l of
@@ -108,27 +110,49 @@ canon2canon cgr = M.MGrammar $ reorder $ map c2c $ M.modules cgr where
j2j c (f,j) = case j of j2j c (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 c tr) z)
_ -> (f,j) _ -> (f,j)
t2t = term2term cgr t2t = term2term cgr (paramValues cgr)
term2term :: CanonGrammar -> Ident -> Term -> Term type ParamEnv =
term2term cgr c tr = case tr of (Map.Map Term Integer, -- untyped terms to values
Par (CIQ _ c) ps | any isVar ps -> mkCase c ps Map.Map CIdent (Map.Map Term Integer)) -- types to their terms to values
Par (CIQ _ c) _ -> EInt $ valNum tr
R rs | any isStrField rs -> R [Ass (r2r l) (t2t t) | Ass l t <- rs] paramValues :: CanonGrammar -> ParamEnv
paramValues cgr = (untyps,typs) where
params = [(mty, errVal [] $ Look.lookupParamValues cgr mty) |
(m,mo) <- M.allModMod cgr,
(ty,ResPar _) <- tree2list $ M.jments mo,
let mty = CIQ m ty
]
typs = Map.fromList [(ci,Map.fromList (zip vs [0..])) | (ci,vs) <- params]
untyps = Map.fromList $ concatMap Map.toList [typ | (_,typ) <- Map.toList typs]
term2term :: CanonGrammar -> ParamEnv -> Ident -> Term -> Term
term2term cgr env@(untyps,typs) c tr = case tr of
Par c ps | any isVar ps -> mkCase c ps
Par _ _ -> EInt $ valNum tr
R rs | any (isStr . trmAss) rs -> R [Ass (r2r l) (t2t t) | Ass l t <- rs]
R rs -> EInt $ valNum tr R rs -> EInt $ valNum tr
P t l -> P (t2t t) (r2r l) P t l -> P (t2t t) (r2r l)
T ty cs -> V ty [t2t t | Cas _ t <- cs] T ty cs -> V ty [t2t t | Cas _ t <- cs]
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 c t2t = term2term cgr env c
r2r l = L (IC "_111") ---- TODO: number of label r2r l = L (IC "_111") ---- TODO: number of label
valNum tr = 456 ---- TODO: number of param value valNum tr = maybe 456 id $ Map.lookup tr untyps
isStrField a = True ---- TODO: check if record has strings isStr tr = case tr of
mkCase c ps = EInt 666 ---- TODO: expand param constr with var Par _ _ -> False
EInt _ -> False
R rs -> any (isStr . trmAss) rs
FV ts -> any isStr ts
P t r -> True ---- TODO
_ -> True
trmAss (Ass _ t) = t
isVar p = case p of isVar p = case p of
Arg _ -> True Arg _ -> True
P q _ -> isVar q
_ -> False _ -> False
mkCase c ps = EInt 666 ---- TODO: expand param constr with var
optConcrete :: [C.CncDef] -> [C.CncDef] optConcrete :: [C.CncDef] -> [C.CncDef]