improving gfcc generation

lib/resource-1.0/german/RelativeGer.gf

@@ -30,7 +30,7 @@ concrete RelativeGer of Relative = CatGer ** open ResGer in {
 
     FunRP p np rp = {
       s = \\gn,c => np.s ! c ++ appPrep p (rp.s ! gn) ;
-      a = RAg np.a
+      a = RAg {n = np.a.n ; p = np.a.p}
       } ;
 
     IdRP = {s = relPron ; a = RNoAg} ;

src/GF/Canon/CanonToGFCC.hs

@@ -28,7 +28,7 @@ import GF.Canon.MkGFC
 import GF.Canon.CMacros
 import qualified GF.Infra.Modules as M
 import qualified GF.Infra.Option as O
-import GF.UseGrammar.Linear (unoptimizeCanon)
+import GF.UseGrammar.Linear (expandLinTables, unoptimizeCanon)
 
 import GF.Infra.Ident
 import GF.Data.Operations
@@ -203,10 +203,11 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
     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)]
-  T ty cs  -> V ty [t2t t | Cas _ t <- cs]
+  T _ _    -> case expandLinTables cgr tr of  -- to normalize the order of cases
+    Ok (T ty cs) -> V ty [t2t t | Cas _ t <- cs]
+    _ -> K (KS (A.prt tr +++ prtTrace tr "66668"))
   V ty ts  -> V ty [t2t t | t <- ts]
   S t p    -> S (t2t t) (t2t p)
   _ -> composSafeOp t2t tr
@@ -253,8 +254,18 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
      _ -> composSafeOp (mkBranch x t) tr     
 
    mkLab k = L (IC ("_" ++ show k))
-   valNum tr = maybe (K (KS (A.prt tr +++ prtTrace tr "66667"))) EInt $ 
+   valNum tr = maybe (tryPerm tr) EInt $ Map.lookup tr untyps
-     Map.lookup tr untyps
+    --- a hack needed because GFCC does not guarantee canonical order of param records
+    where
+      tryPerm tr = case tr of
+        R rs -> case [v | Just v <- [Map.lookup (R rs') untyps | rs' <- permutations rs]] of
+	  v:_ -> EInt v
+          _ -> report
+        _ -> report
+      report = K (KS (A.prt tr +++ prtTrace tr "66667"))
+      permutations xx = case xx of
+        [] -> [[]]
+        _  -> [x:xs | x <- xx, xs <- permutations (xx \\ [x])]
    isStr tr = case tr of
      Par _ _ -> False
      EInt _  -> False

src/GF/Canon/GFCC/DataGFCC.hs

@@ -78,6 +78,8 @@ compute mcfg lang args = compg [] where
     P r p -> case (comp r, comp p) of 
 
     -- for the suffix optimization
+      (W s t, R (C i : _)) -> comp $ P (W s t) (C i)
+
       (W s t, C i) -> case comp t of
         R ss -> case comp $ idx ss (fromInteger i) of
           K (KS u) -> kks (s ++ u)      -- the only case where W occurs

src/GF/Canon/GFCC/Test.gf

@@ -1,11 +1,13 @@
 -- to test GFCC compilation
 
+flags coding=utf8 ;
+
 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 Mina, Sina, Me, Te : NP ;
 fun Raha, Paska, Pallo : N ;
 fun Puhua, Munia, Sanoa : VP ;
 
@@ -22,24 +24,16 @@ lincat VP = Verb ;
 oper Noun = {s : NForm => Str} ;
 oper Verb = {s : VForm => Str} ;
 
-lincat NP = {s : Case => Str ; n : Number ; p : Person} ;
+lincat NP = {s : Case => Str ; a : {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} ;
-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} ;
 
-
+lin Pred np vp = {s = np.s ! Nom ++ vp.s ! VF np.a.n np.a.p} ;
--- for test
+lin Pred2 np vp ob = {s = np.s ! Nom ++ vp.s ! VF np.a.n np.a.p ++ ob.s ! Part} ;
-cat NPR ;
+lin Det  no = {s = \\c => no.s ! NF Sg c ; a = {n = Sg ; p = P3}} ;
-fun PredR : NPR -> VP -> S ;
+lin Dets no = {s = \\c => no.s ! NF Pl c ; a = {n = Pl ; p = P3}} ;
-fun Sina, Me : NPR ;
+lin Mina = {s = table Case ["minä" ; "minua"] ; a = {n = Sg ; p = P1}} ;
-lincat NPR = {s : Case => Str ; a : {n : Number ; p : Person}} ;
+lin Te   = {s = table Case ["te" ; "teitä"] ; a = {n = Pl ; p = P2}} ;
-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" ;