diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/GF/Canon/CanonToGFCC.hs | 28 | ||||
| -rw-r--r-- | src/GF/Canon/GFCC/Test.gf | 59 |
2 files changed, 78 insertions, 9 deletions
diff --git a/src/GF/Canon/CanonToGFCC.hs b/src/GF/Canon/CanonToGFCC.hs index 8627c469d..a48a89fc5 100644 --- a/src/GF/Canon/CanonToGFCC.hs +++ b/src/GF/Canon/CanonToGFCC.hs @@ -17,6 +17,7 @@ module GF.Canon.CanonToGFCC (prCanon2gfcc) where import GF.Canon.AbsGFC import qualified GF.Canon.GFC as GFC import qualified GF.Canon.Look as Look +import qualified GF.Canon.Subexpressions as Sub import qualified GF.Canon.GFCC.AbsGFCC as C import qualified GF.Canon.GFCC.PrintGFCC as Pr import GF.Canon.GFC @@ -45,8 +46,8 @@ prCanon2gfcc = -- This is needed to reorganize the grammar. GFCC has its own back-end optimization. -- But we need to have the canonical order in tables, created by valOpt normalize :: CanonGrammar -> CanonGrammar -normalize = share . unoptimizeCanon where - share = M.MGrammar . map (shareModule allOpt) . M.modules --- valOpt +normalize = share . unoptimizeCanon . Sub.unSubelimCanon where + share = M.MGrammar . map (shareModule valOpt) . M.modules --- allOpt -- Generate GFCC from GFCM. -- this assumes a grammar translated by canon2canon @@ -128,10 +129,12 @@ canon2canon cg = tr $ M.MGrammar $ map c2c $ M.modules cg where GFC.CncFun x y tr z -> (f,GFC.CncFun x y (t2t tr) z) _ -> (f,j) t2t = term2term cg pv - pv@(labels,_,_) = paramValues cg - tr = trace + pv@(labels,untyps,_) = paramValues cg + tr = trace $ (unlines [A.prt c ++ "." ++ unwords (map A.prt l) +++ "=" +++ show i | - ((c,l),i) <- Map.toList labels]) + ((c,l),i) <- Map.toList labels]) ++ + (unlines [A.prt t +++ "=" +++ show i | + (t,i) <- Map.toList untyps]) type ParamEnv = (Map.Map (Ident,[Label]) Integer, -- numbered labels @@ -144,11 +147,16 @@ paramValues cgr = (labels,untyps,typs) where params = [(ty, errVal [] $ Look.allParamValues cgr ty) | ty <- partyps] partyps = nub $ [ty | (_,(_,CncCat (RecType ls) _ _)) <- jments, - ty <- [ty | Lbg _ ty <- ls] + ty0 <- [ty | Lbg _ ty <- ls], + ty <- typsFrom ty0 ] ++ [ Cn (CIQ m ty) | (m,(ty,ResPar _)) <- jments ] + typsFrom ty = case ty of + Table p t -> p : typsFrom t + RecType ls -> concat [typsFrom t | Lbg _ t <- ls] + _ -> [ty] jments = [(m,j) | (m,mo) <- M.allModMod cgr, j <- tree2list $ M.jments mo] typs = Map.fromList [(ci,Map.fromList (zip vs [0..])) | (ci,vs) <- params] untyps = Map.fromList $ concatMap Map.toList [typ | (_,typ) <- Map.toList typs] @@ -177,6 +185,7 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of P t l -> r2r tr T i [Cas p t] -> T i [Cas p (t2t t)] T ty cs -> V ty [t2t t | Cas _ t <- cs] + V ty ts -> V ty [t2t t | t <- ts] S t p -> S (t2t t) (t2t p) _ -> composSafeOp t2t tr where @@ -238,10 +247,11 @@ optTerm tr = case tr of _ -> tr where optToks ss = prf : suffs where - prf = pref (sort ss) + prf = pref (head ss) (tail ss) suffs = map (drop (length prf)) ss - pref ss = longestPref (head ss) (last ss) - longestPref w u = if isPrefixOf w u then w else longestPref (init w) u + pref cand ss = case ss of + s1:ss2 -> if isPrefixOf cand s1 then pref cand ss2 else pref (init cand) ss + _ -> cand isK t = case t of C.K (C.KS _) -> True _ -> False diff --git a/src/GF/Canon/GFCC/Test.gf b/src/GF/Canon/GFCC/Test.gf new file mode 100644 index 000000000..cd52a6291 --- /dev/null +++ b/src/GF/Canon/GFCC/Test.gf @@ -0,0 +1,59 @@ +-- to test GFCC compilation + +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 ; + +lincat NP = {s : Case => Str ; a : {n : Number ; p : Person}} ; +lincat N = Noun ; +lincat VP = Verb ; + +oper Noun = {s : {n : Number ; c : Case} => Str} ; +oper Verb = {s : {n : Number ; p : Person} => Str} ; + +lin Pred np vp = {s = np.s ! Nom ++ vp.s ! np.a} ; +lin Pred2 np vp ob = {s = np.s ! Nom ++ vp.s ! np.a ++ ob.s ! Part} ; +lin Det no = {s = \\c => no.s ! {n = Sg ; c = c} ; a = {n = Sg ; p = P3}} ; +lin Dets no = {s = \\c => no.s ! {n = Pl ; c = 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}} ; + +lin Raha = mkN "raha" ; +lin Paska = mkN "paska" ; +lin Pallo = mkN "pallo" ; +lin Puhua = mkV "puhu" ; +lin Munia = mkV "muni" ; +lin Sanoa = mkV "sano" ; + +oper mkN : Str -> Noun = \raha -> { + s = table { + {n = Sg ; c = Nom} => raha ; + {n = Sg ; c = Part} => raha + "a" ; + {n = Pl ; c = Nom} => raha + "t" ; + {n = Pl ; c = Part} => Predef.tk 1 raha + "oja" + } + } ; + +oper mkV : Str -> Verb = \puhu -> { + s = table { + {n = Sg ; p = P1} => puhu + "n" ; + {n = Sg ; p = P2} => puhu + "t" ; + {n = Sg ; p = P3} => puhu + Predef.dp 1 puhu ; + {n = Pl ; p = P1} => puhu + "mme" ; + {n = Pl ; p = P2} => puhu + "tte" ; + {n = Pl ; p = P3} => puhu + "vat" + } + } ; + |