From be2f1ac5c8272837a553dfe484a678813c73fd5b Mon Sep 17 00:00:00 2001 From: aarne Date: Mon, 25 Sep 2006 17:18:40 +0000 Subject: [PATCH] another fix towards gfcc compilation --- src/GF/Canon/CanonToGFCC.hs | 51 +++++++++++++++++++---------------- src/GF/Canon/GFCC/DataGFCC.hs | 2 ++ src/GF/Canon/GFCC/Test.gf | 23 +++++++--------- 3 files changed, 40 insertions(+), 36 deletions(-) diff --git a/src/GF/Canon/CanonToGFCC.hs b/src/GF/Canon/CanonToGFCC.hs index f49908db9..7735c5db1 100644 --- a/src/GF/Canon/CanonToGFCC.hs +++ b/src/GF/Canon/CanonToGFCC.hs @@ -197,8 +197,12 @@ paramValues cgr = (labels,untyps,typs) where term2term :: CanonGrammar -> ParamEnv -> Term -> Term term2term cgr env@(labels,untyps,typs) tr = case tr of Par _ _ -> mkValCase tr - R rs -> ---- | any (isStr . trmAss) rs -> - R [Ass (mkLab i) (t2t t) | (i,Ass l t) <- zip [0..] rs, not (isLock l t)] + R rs -> + let + rs' = [Ass (mkLab i) (t2t t) | (i,Ass l t) <- zip [0..] rs, not (isLock l t)] + in if (any (isStr . trmAss) rs) + then R rs' + else R [Ass (mkLab 0) (valNum tr), Ass (mkLab 1) (R rs')] R rs -> valNum tr P t l -> r2r tr T i [Cas p t] -> T i [Cas p (t2t t)] @@ -223,25 +227,6 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of S p _ -> getLab p _ -> Bad "getLab" - mkLab k = L (IC ("_" ++ show k)) - valNum tr = maybe (K (KS (A.prt tr +++ prtTrace tr "66667"))) EInt $ - Map.lookup tr untyps - isStr tr = case tr of - Par _ _ -> False - EInt _ -> False - R rs -> any (isStr . trmAss) rs - FV ts -> any isStr ts - P t r -> True ---- TODO - _ -> True - isLock l t = case t of --- need not look at l - R [] -> True - _ -> False - trmAss (Ass _ t) = t - - mkValCase tr = case appSTM (doVar tr) [] of - Ok (tr', st@(_:_)) -> t2t $ comp $ foldr mkCase tr' st - _ -> valNum tr - doVar :: Term -> STM [((CType,[Term]),(Term,Term))] Term doVar tr = case getLab tr of Ok (cat, lab) -> do @@ -257,8 +242,9 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of return tr' _ -> composOp doVar tr - --- this is mainly needed for parameter record projections - comp t = errVal t $ Look.ccompute cgr [] t + mkValCase tr = case appSTM (doVar tr) [] of + Ok (tr', st@(_:_)) -> t2t $ comp $ foldr mkCase tr' st + _ -> valNum tr mkCase ((ty,vs),(x,p)) tr = S (V ty [mkBranch x v tr | v <- vs]) p @@ -266,6 +252,25 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of _ | tr == x -> t _ -> composSafeOp (mkBranch x t) tr + mkLab k = L (IC ("_" ++ show k)) + valNum tr = maybe (K (KS (A.prt tr +++ prtTrace tr "66667"))) EInt $ + Map.lookup tr untyps + isStr tr = case tr of + Par _ _ -> False + EInt _ -> False + R rs -> any (isStr . trmAss) rs + FV ts -> any isStr ts + P t r -> True ---- TODO + _ -> True + isLock l t = case t of --- need not look at l + R [] -> True + _ -> False + trmAss (Ass _ t) = t + + --- this is mainly needed for parameter record projections + comp t = errVal t $ Look.ccompute cgr [] t + + prtTrace tr n = n ----trace ("-- ERROR" +++ A.prt tr +++ show n +++ show tr) n prTrace tr n = trace ("-- OBSERVE" +++ A.prt tr +++ show n +++ show tr) n diff --git a/src/GF/Canon/GFCC/DataGFCC.hs b/src/GF/Canon/GFCC/DataGFCC.hs index 9571d7c23..32b61b9c8 100644 --- a/src/GF/Canon/GFCC/DataGFCC.hs +++ b/src/GF/Canon/GFCC/DataGFCC.hs @@ -82,6 +82,8 @@ compute mcfg lang args = compg [] where R ss -> case comp $ idx ss (fromInteger i) of K (KS u) -> kks (s ++ u) -- the only case where W occurs + (R [C _ , R rs], C i) -> comp $ idx rs (fromInteger i) + (R rs, R (C i : _)) -> comp $ idx rs (fromInteger i) (R rs, C i) -> comp $ idx rs (fromInteger i) (r',p') -> P r' p' W s t -> W s (comp t) diff --git a/src/GF/Canon/GFCC/Test.gf b/src/GF/Canon/GFCC/Test.gf index efb77eff6..6700d90f3 100644 --- a/src/GF/Canon/GFCC/Test.gf +++ b/src/GF/Canon/GFCC/Test.gf @@ -5,12 +5,10 @@ cat S ; NP ; N ; VP ; fun Pred : NP -> VP -> S ; fun Pred2 : NP -> VP -> NP -> S ; fun Det, Dets : N -> NP ; - fun Mina, Te : NP ; fun Raha, Paska, Pallo : N ; fun Puhua, Munia, Sanoa : VP ; - param Person = P1 | P2 | P3 ; param Number = Sg | Pl ; param Case = Nom | Part ; @@ -24,7 +22,6 @@ lincat VP = Verb ; oper Noun = {s : NForm => Str} ; oper Verb = {s : VForm => Str} ; --- {- lincat NP = {s : Case => Str ; n : Number ; p : Person} ; lin Pred np vp = {s = np.s ! Nom ++ vp.s ! VF np.n np.p} ; lin Pred2 np vp ob = {s = np.s ! Nom ++ vp.s ! VF np.n np.p ++ ob.s ! Part} ; @@ -32,17 +29,17 @@ lin Det no = {s = \\c => no.s ! NF Sg c ; n = Sg ; p = P3} ; lin Dets no = {s = \\c => no.s ! NF Pl c ; n = Pl ; p = P3} ; lin Mina = {s = table Case ["minä" ; "minua"] ; n = Sg ; p = P1} ; lin Te = {s = table Case ["te" ; "teitä"] ; n = Pl ; p = P2} ; --- -} -{- -lincat NP = {s : Case => Str ; a : {n : Number ; p : Person}} ; -lin Pred np vp = {s = np.s ! Nom ++ vp.s ! VF np.a.n np.a.p} ; -lin Pred2 np vp ob = {s = np.s ! Nom ++ vp.s ! VF np.a.n np.a.p ++ ob.s ! Part} ; -lin Det no = {s = \\c => no.s ! NF Sg c ; a = {n = Sg ; p = P3}} ; -lin Dets no = {s = \\c => no.s ! NF Pl c ; a = {n = Pl ; p = P3}} ; -lin Mina = {s = table Case ["minä" ; "minua"] ; a = {n = Sg ; p = P1}} ; -lin Te = {s = table Case ["te" ; "teitä"] ; a = {n = Pl ; p = P2}} ; --} + +-- for test +cat NPR ; +fun PredR : NPR -> VP -> S ; +fun Sina, Me : NPR ; +lincat NPR = {s : Case => Str ; a : {n : Number ; p : Person}} ; +lin PredR np vp = {s = np.s ! Nom ++ vp.s ! VF np.a.n np.a.p} ; +lin Sina = {s = table Case ["sinä" ; "sinua"] ; a = {n = Sg ; p = P2}} ; +lin Me = {s = table Case ["me" ; "meitä"] ; a = {n = Pl ; p = P1}} ; +-- end test lin Raha = mkN "raha" ; lin Paska = mkN "paska" ;