msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

more tc of gfcc

Browse Source
This commit is contained in:
aarne
2007-10-01 13:18:43 +00:00
parent 3b4ee92cbe
commit 82754178db
3 changed files with 72 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
src/GF/Devel/GrammarToGFCC.hs
View File

@@ -65,7 +65,7 @@ mkCType :: Type -> C.Term
mkCType t = case t of
EInt i -> C.C $ fromInteger i
-- record parameter alias - created in gfc preprocessing
RecType [(LIdent "_", i)] -> mkCType i
----RecType [(LIdent "_", i)] -> mkCType i
--- RecType [(LIdent "_", i), (LIdent "__", t)] -> C.RP (mkCType i) (mkCType t)
RecType rs -> C.R [mkCType t | (_, t) <- rs]
Table pt vt -> C.R $ replicate (getI (mkCType pt)) $ mkCType vt
@@ -83,7 +83,7 @@ mkTerm tr = case tr of
C.V (read (reverse (takeWhile (/='_') (reverse s)))) ---- from gf parser of gfc
EInt i -> C.C $ fromInteger i
-- record parameter alias - created in gfc preprocessing
R [(LIdent "_", (_,i))] -> mkTerm i
----R [(LIdent "_", (_,i))] -> mkTerm i
--- R [(LIdent "_", (_,i)), (LIdent "__", (_,t))] -> C.RP (mkTerm i) (mkTerm t)
-- ordinary record
R rs -> C.R [mkTerm t | (_, (_,t)) <- rs]
@@ -273,10 +273,12 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
(l,(_,t)) <- unlock rs]
rs' = [(mkLab i, (Nothing, t2t t)) |
(i,(l,(_,t))) <- zip [0..] (unlock rs)]
in if (any (isStr . trmAss) rs)
then R rs'
in
----if (any (isStr . trmAss) rs)
----then
R rs'
--- else mkValCase tr
else R [(LIdent "_", (Nothing, mkValCase tr'))]
----else R [(LIdent "_", (Nothing, mkValCase tr'))]
--- else R [(LIdent "_", (Nothing, mkValCase tr)), (LIdent "__",(Nothing,R rs'))]
P t l -> r2r tr
PI t l i -> EInt $ toInteger i