cleand up Structural

2 files changed, 7 insertions, 6 deletions

diff --git a/src/GF/Canon/CMacros.hs b/src/GF/Canon/CMacros.hs
index d2c128454..8c655179a 100644
--- a/src/GF/Canon/CMacros.hs
+++ b/src/GF/Canon/CMacros.hs
@@ -9,7 +9,7 @@
 -- > CVS $Author $
 -- > CVS $Revision $
 --
--- (Description of the module)
+-- Macros for building and analysing terms in GFC concrete syntax.
 -----------------------------------------------------------------------------
 
 module CMacros where
@@ -226,6 +226,7 @@ wordsInTerm trm = filter (not . null) $ case trm of
    S c _   -> wo c
    R rs    -> concat [wo t | Ass _ t <- rs]
    T _ cs  -> concat [wo t | Cas _ t <- cs]
+   V _ cs  -> concat [wo t | t <- cs]
    C s t   -> wo s ++ wo t
    FV ts   -> concatMap wo ts
    K (KP ss vs) -> ss ++ concat [s | Var s _ <- vs]
diff --git a/src/GF/Canon/CanonToGrammar.hs b/src/GF/Canon/CanonToGrammar.hs
index cd4863442..16c2ae1f0 100644
--- a/src/GF/Canon/CanonToGrammar.hs
+++ b/src/GF/Canon/CanonToGrammar.hs
@@ -143,13 +143,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 [(p,t) | Cas ps t <- cases, p <- ps] --- destroys sharing
-    ps' <- mapM redPatt ps
-    ts' <- mapM redCTerm ts                   --- duplicates work for shared rhss
+    let (ps,ts) = unzip [(ps,t) | Cas ps t <- cases]
+    ps' <- mapM (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.T tinfo $ zip ps' ts'
+    return $ G.TSh tinfo $ zip ps' ts'
   V ctype ts  -> do
     ctype' <- redCType ctype
     ts' <- mapM redCTerm ts