mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-16 00:09:31 -06:00
eliminated the rest of projections with record in GFCC
This commit is contained in:
@@ -58,20 +58,20 @@ inferTerm args trm = case trm of
|
||||
(t',tt) <- infer t
|
||||
(u',tu) <- infer u
|
||||
case tt of
|
||||
R tys -> case tu of
|
||||
R vs -> infer $ foldl P t' [P u' (C i) | i <- [0 .. length vs - 1]]
|
||||
--- R [v] -> infer $ P t v
|
||||
--- R (v:vs) -> infer $ P (head tys) (R vs)
|
||||
R tys -> case tu of
|
||||
R vs -> infer $ foldl P t' [P u' (C i) | i <- [0 .. length vs - 1]]
|
||||
--- R [v] -> infer $ P t v
|
||||
--- R (v:vs) -> infer $ P (head tys) (R vs)
|
||||
|
||||
C i -> do
|
||||
testErr (i < length tys)
|
||||
("required more than " ++ show i ++ " fields in " ++ prt (R tys))
|
||||
(returnt $ tys !! i) -- record: index must be known
|
||||
_ -> do
|
||||
let typ = head tys
|
||||
testErr (all (==typ) tys) ("different types in table " ++ prt trm)
|
||||
returnt typ -- table: must be same
|
||||
_ -> Bad $ "projection from " ++ prt t ++ " : " ++ prt tt
|
||||
C i -> do
|
||||
testErr (i < length tys)
|
||||
("required more than " ++ show i ++ " fields in " ++ prt (R tys))
|
||||
return (P t' u', tys !! i) -- record: index must be known
|
||||
_ -> do
|
||||
let typ = head tys
|
||||
testErr (all (==typ) tys) ("different types in table " ++ prt trm)
|
||||
return (P t' u', typ) -- table: types must be same
|
||||
_ -> Bad $ "projection from " ++ prt t ++ " : " ++ prt tt
|
||||
FV [] -> returnt str ----
|
||||
FV (t:ts) -> do
|
||||
(t',ty) <- infer t
|
||||
|
||||
@@ -102,7 +102,7 @@ compute mcfg lang args = comp where
|
||||
(_, FV ts) -> FV $ Prelude.map (proj r) ts
|
||||
(FV ts, _ ) -> FV $ Prelude.map (\t -> proj t r) ts
|
||||
(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)
|
||||
|
||||
getString t = case t of
|
||||
|
||||
Reference in New Issue
Block a user