cleand up Structural

3 files changed, 15 insertions, 3 deletions

diff --git a/src/GF/Grammar/Compute.hs b/src/GF/Grammar/Compute.hs
index 71bed6d49..2ddce3a6c 100644
--- a/src/GF/Grammar/Compute.hs
+++ b/src/GF/Grammar/Compute.hs
@@ -9,7 +9,7 @@
 -- > CVS $Author $
 -- > CVS $Revision $
 --
--- (Description of the module)
+-- Computation of source terms. Used in compilation and in 'cc' command.
 -----------------------------------------------------------------------------
 
 module Compute where
@@ -218,6 +218,9 @@ computeTerm gr = comp where
        cs' <- if (null g) then return cs else mapPairsM (comp g) cs
        return $ T i cs'
 
+     --- this means some extra work; should implement TSh directly
+     TSh i cs -> comp g $ T i [(p,v) | (ps,v) <- cs, p <- ps]
+
      T i cs -> do
        pty0 <- getTableType i
        ptyp <- comp g pty0
diff --git a/src/GF/Grammar/Grammar.hs b/src/GF/Grammar/Grammar.hs
index d5d59aec3..8ab2356d2 100644
--- a/src/GF/Grammar/Grammar.hs
+++ b/src/GF/Grammar/Grammar.hs
@@ -9,7 +9,7 @@
 -- > CVS $Author $
 -- > CVS $Revision $
 --
--- (Description of the module)
+-- GF source abstract syntax used internally in compilation.
 -----------------------------------------------------------------------------
 
 module Grammar where
@@ -91,6 +91,7 @@ data Term =
  
  | Table Term Term      -- table type:  P => A
  | T TInfo [Case]       -- table:       table {p => c ; ...}
+ | TSh TInfo [Cases]    -- table with discjunctive patters (only back end opt)
  | V Type [Term]        -- table given as course of values: table T [c1 ; ... ; cn]
  | S Term Term          -- selection:   t ! p
 
@@ -149,6 +150,7 @@ type Equation = ([Patt],Term)
 type Labelling = (Label, Term) 
 type Assign = (Label, (Maybe Type, Term)) 
 type Case = (Patt, Term) 
+type Cases = ([Patt], Term) 
 type LocalDef = (Ident, (Maybe Type, Term))
 
 type Param = (Ident, Context) 
diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs
index 8c1ac36d7..cfc71b1a5 100644
--- a/src/GF/Grammar/Macros.hs
+++ b/src/GF/Grammar/Macros.hs
@@ -9,7 +9,7 @@
 -- > CVS $Author $
 -- > CVS $Revision $
 --
--- (Description of the module)
+-- Macros for constructing and analysing source code terms.
 -----------------------------------------------------------------------------
 
 module Macros where
@@ -603,6 +603,11 @@ composOp co trm =
         i'  <- changeTableType co i
         return (T i' cc')
 
+   TSh i cc -> 
+     do cc' <- mapPairListM (co . snd) cc
+        i'  <- changeTableType co i
+        return (TSh i' cc')
+
    V ty vs ->
      do ty' <- co ty
         vs' <- mapM co vs
@@ -661,6 +666,8 @@ collectOp co trm = case trm of
   RecType r  -> concatMap (co . snd) r 
   P t i      -> co t
   T _ cc     -> concatMap (co . snd) cc -- not from patterns --- nor from type annot
+  TSh _ cc   -> concatMap (co . snd) cc -- not from patterns --- nor from type annot
+  V _ cc     -> concatMap co         cc --- nor from type annot
   Let (x,(mt,a)) b -> maybe [] co mt ++ co a ++ co b
   C s1 s2    -> co s1 ++ co s2 
   Glue s1 s2 -> co s1 ++ co s2