some adjustments in GFCC generation (old)

2 files changed, 14 insertions, 5 deletions

diff --git a/src/GF/Canon/CanonToGrammar.hs b/src/GF/Canon/CanonToGrammar.hs
index da40425f0..078c3cc03 100644
--- a/src/GF/Canon/CanonToGrammar.hs
+++ b/src/GF/Canon/CanonToGrammar.hs
@@ -73,6 +73,11 @@ redInfo (c,info) = errIn ("decompiling abstract" +++ show c) $ do
       par' <- mapM redParam par
       return $ G.ResParam (Yes (par',Nothing)) ---- list of values
 
+    ResOper pty ptr -> do
+      ty'  <- redCType pty
+      trm' <- redCTerm ptr
+      return $ G.ResOper (Yes ty') (Yes trm')
+
     CncCat pty ptr ppr -> do
       ty'  <- redCType pty
       trm' <- redCTerm ptr
@@ -145,13 +150,13 @@ redCTerm x = case x of
   P term label  -> liftM2 G.P (redCTerm term) (return $ redLabel label)
   T ctype cases  -> do
     ctype' <- redCType ctype
-    let (ps,ts) = unzip [(ps,t) | Cas ps t <- cases]
-    ps' <- mapM (mapM redPatt) ps
+    let (ps,ts) = unzip [(p,t) | Cas [p] t <- cases]
+    ps' <- mapM redPatt ps
     ts' <- mapM redCTerm ts
     let tinfo = case ps' of
-                  [[G.PV _]] -> G.TTyped ctype'
+                  [G.PV _] -> G.TTyped ctype'
                   _ -> G.TComp ctype'
-    return $ G.TSh tinfo $ zip ps' ts'
+    return $ G.T tinfo $ zip ps' ts'
   V ctype ts  -> do
     ctype' <- redCType ctype
     ts' <- mapM redCTerm ts
diff --git a/src/GF/Devel/GrammarToGFCC.hs b/src/GF/Devel/GrammarToGFCC.hs
index 8d7bd4960..887e689e4 100644
--- a/src/GF/Devel/GrammarToGFCC.hs
+++ b/src/GF/Devel/GrammarToGFCC.hs
@@ -129,6 +129,7 @@ mkTerm tr = case tr of
   EInt i      -> C.C $ fromInteger i
   R rs     -> C.R [mkTerm t | (_, (_,t)) <- rs]
   P t l    -> C.P (mkTerm t) (C.C (mkLab l))
+  TSh _ _    -> error $ show tr
   T _ cs   -> C.R [mkTerm t | (_,t) <- cs] ------
   V _ cs   -> C.R [mkTerm t | t <- cs]
   S t p    -> C.P (mkTerm t) (mkTerm p)
@@ -378,6 +379,9 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
                  (i,(l,(_,t))) <- zip [0..] (sort (unlock rs))]
   P  t l   -> r2r tr
   PI t l i -> EInt $ toInteger i
+
+  T _ [_] -> error $ "single" +++ prt tr
+  T (TWild _) _ -> error $ "wild" +++ prt tr
   T (TComp  ty) cs  -> t2t $ V ty $ map snd cs ---- should be elim'ed in tc
   T (TTyped ty) cs  -> t2t $ V ty $ map snd cs ---- should be elim'ed in tc
   V ty ts  -> mkCurry $ V ty [t2t t | t <- ts]
@@ -457,7 +461,7 @@ term2term cgr env@(labels,untyps,typs) tr = case tr of
         (FV ts,_) -> ts
         _ -> [tr]
       valNumFV ts = case ts of
-        [tr] -> trace (unwords (map prt (Map.keys typs))) $ 
+        [tr] -> trace (unwords (map prt (Map.keys untyps))) $ 
                   prtTrace tr $ K "66667"
         _ -> FV $ map valNum ts