another fix towards gfcc compilation

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