-val optimization

3 files changed, 20 insertions, 1 deletions

diff --git a/src/GF/Grammar/Compute.hs b/src/GF/Grammar/Compute.hs
index 5573e5e4e..b31c7a4a0 100644
--- a/src/GF/Grammar/Compute.hs
+++ b/src/GF/Grammar/Compute.hs
@@ -101,6 +101,17 @@ computeTerm gr = comp where
 
          FV ccs -> mapM (\c -> comp g (S c v')) ccs >>= returnC . FV
 
+         V ptyp ts -> do
+           vs <- allParamValues gr ptyp
+           ps <- mapM term2patt vs
+           let cc = zip ps ts
+           case v' of
+             FV vs -> mapM (\c -> comp g (S t' c)) vs >>= returnC . FV
+             _ -> case matchPattern cc v' of
+               Ok (c,g') -> comp (g' ++ g) c
+               _ | isCan v' -> prtBad ("missing case" +++ prt v' +++ "in") t 
+               _ -> return $ S t' v' -- if v' is not canonical
+
          T _ cc -> case v' of
 	   FV vs -> mapM (\c -> comp g (S t' c)) vs >>= returnC . FV
            _ -> case matchPattern cc v' of
@@ -204,7 +215,8 @@ computeTerm gr = comp where
            ts   <- mapM (\ (c,g') -> comp (g' ++ g) c) sts
            ps   <- mapM term2patt vs
            let ps' = ps --- PT ptyp (head ps) : tail ps
-           return $ T (TComp ptyp) (zip ps' ts)
+           return $ --- V ptyp ts -- to save space, just course of values
+                    T (TComp ptyp) (zip ps' ts)
          _ -> do
            cs' <- mapM (compBranch g) cs
            return $ T i cs'  -- happens with variable types
diff --git a/src/GF/Grammar/Grammar.hs b/src/GF/Grammar/Grammar.hs
index a2978d6b3..0f8e4256e 100644
--- a/src/GF/Grammar/Grammar.hs
+++ b/src/GF/Grammar/Grammar.hs
@@ -77,6 +77,7 @@ data Term =
  
  | Table Term Term      -- table type:  P => A
  | T TInfo [Case]       -- table:       table {p => c ; ...}
+ | V Type [Term]        -- table given as course of values: table T [c1 ; ... ; cn]
  | S Term Term          -- selection:   t ! p
 
  | Let LocalDef Term    -- local definition: let {t : T = a} in b
diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs
index 8b9f825b5..6769e44cf 100644
--- a/src/GF/Grammar/Macros.hs
+++ b/src/GF/Grammar/Macros.hs
@@ -588,6 +588,12 @@ composOp co trm =
      do cc' <- mapPairListM (co . snd) cc
         i'  <- changeTableType co i
         return (T i' cc')
+
+   V ty vs ->
+     do ty' <- co ty
+        vs' <- mapM co vs
+        return (V ty' vs')
+
    Let (x,(mt,a)) b -> 
      do a'  <- co a
         mt' <- case mt of