fixed some bugs in GFCC compilation; use optimize=values to import GF!

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
+normalize = share . unoptimizeCanon . Sub.unSubelimCanon where
-  share = M.MGrammar . map (shareModule allOpt) . M.modules --- valOpt
+  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
+  pv@(labels,untyps,_) = paramValues cg
-  tr = trace 
+  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)
+    pref cand ss = case ss of
-    longestPref w u = if isPrefixOf w u then w else longestPref (init w) u
+      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

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"
+    } 
+  } ;
+