GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-23 09:52:55 -06:00
Code Issues Packages Projects Releases Wiki Activity

eliminated the rest of projections with record in GFCC

Browse Source
This commit is contained in:
aarne
2007-10-04 08:23:56 +00:00
parent db12154e76
commit ed6062f50d
2 changed files with 14 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/GF/Canon/GFCC/CheckGFCC.hs
View File

@@ -66,11 +66,11 @@ inferTerm args trm = case trm of
C i -> do C i -> do
testErr (i < length tys) testErr (i < length tys)
("required more than " ++ show i ++ " fields in " ++ prt (R tys)) ("required more than " ++ show i ++ " fields in " ++ prt (R tys))
(returnt $ tys !! i) -- record: index must be known return (P t' u', tys !! i) -- record: index must be known
_ -> do _ -> do
let typ = head tys let typ = head tys
testErr (all (==typ) tys) ("different types in table " ++ prt trm) testErr (all (==typ) tys) ("different types in table " ++ prt trm)
returnt typ -- table: must be same return (P t' u', typ) -- table: types must be same
_ -> Bad $ "projection from " ++ prt t ++ " : " ++ prt tt _ -> Bad $ "projection from " ++ prt t ++ " : " ++ prt tt
FV [] -> returnt str ---- FV [] -> returnt str ----
FV (t:ts) -> do FV (t:ts) -> do

2
src/GF/Canon/GFCC/DataGFCC.hs
View File

@@ -102,7 +102,7 @@ compute mcfg lang args = comp where
(_, FV ts) -> FV $ Prelude.map (proj r) ts (_, FV ts) -> FV $ Prelude.map (proj r) ts
(FV ts, _ ) -> FV $ Prelude.map (\t -> proj t r) ts (FV ts, _ ) -> FV $ Prelude.map (\t -> proj t r) ts
(W s t, _) -> kks (s ++ getString (proj t p)) (W s t, _) -> kks (s ++ getString (proj t p))
(_,R is) -> comp $ foldl P r is (_,R is) -> trace ("projection " ++ show p ++ "\n") $ comp $ foldl P r is
_ -> comp $ getField r (getIndex p) _ -> comp $ getField r (getIndex p)
getString t = case t of getString t = case t of