data structures for param values with number, preparing optimized pattern matching in grammar compilation

4 files changed, 15 insertions, 9 deletions

diff --git a/src/GF/Grammar/Grammar.hs b/src/GF/Grammar/Grammar.hs
index 5259e5618..a3735c32f 100644
--- a/src/GF/Grammar/Grammar.hs
+++ b/src/GF/Grammar/Grammar.hs
@@ -156,7 +156,7 @@ data Term =
  | TSh TInfo [Cases]    -- ^ table with disjunctive patters (only back end opt)
  | V Type [Term]        -- ^ table given as course of values: @table T [c1 ; ... ; cn]@
  | S Term Term          -- ^ selection:   @t ! p@
- | Val Type Int         -- ^ parameter value number: @T # i#
+ | Val Term Type Int    -- ^ parameter value number: @T # i#
 
  | Let LocalDef Term    -- ^ local definition: @let {t : T = a} in b@
 
@@ -194,7 +194,7 @@ data Patt =
  | PFloat Double          -- ^ float literal pattern: @1.2@    -- only abstract
  | PT Type Patt           -- ^ type-annotated pattern
 
- | PVal Type Int          -- ^ parameter value number: @T # i#
+ | PVal Patt Type Int     -- ^ parameter value number: @T # i#
 
  | PAs Ident Patt         -- ^ as-pattern: x@p
 
diff --git a/src/GF/Grammar/Lookup.hs b/src/GF/Grammar/Lookup.hs
index b8c6a2a19..4a11a0d3f 100644
--- a/src/GF/Grammar/Lookup.hs
+++ b/src/GF/Grammar/Lookup.hs
@@ -178,7 +178,7 @@ lookupValueIndex :: SourceGrammar -> Type -> Term -> Err Term
 lookupValueIndex gr ty tr = do
   ts <- allParamValues gr ty
   case lookup tr $ zip ts [0..] of
-    Just i -> return $ Val ty i
+    Just i -> return $ Val tr ty i
     _ -> Bad $ "no index for" +++ prt tr +++ "in" +++ prt ty
 
 lookupIndexValue :: SourceGrammar -> Type -> Int -> Err Term
diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs
index be03c02a7..065dcef60 100644
--- a/src/GF/Grammar/Macros.hs
+++ b/src/GF/Grammar/Macros.hs
@@ -437,7 +437,9 @@ linAsStr s = mkRecord linLabel [K s] -- default linearization {s = s}
 term2patt :: Term -> Err Patt
 term2patt trm = case termForm trm of
   Ok ([], Vr x, []) -> return (PV x)
-  Ok ([], Val ty x, []) -> return (PVal ty x)
+  Ok ([], Val te ty x, []) -> do
+    te' <- term2patt te
+    return (PVal te' ty x)
   Ok ([], Con c, aa) -> do
     aa' <- mapM term2patt aa
     return (PC c aa')
@@ -488,7 +490,7 @@ patt2term :: Patt -> Term
 patt2term pt = case pt of
   PV x      -> Vr x
   PW        -> Vr identW             --- not parsable, should not occur
-  PVal t i  -> Val t i
+  PVal v t i -> Val (patt2term v) t i
   PMacro c  -> Cn c
   PM p c    -> Q p c
 
@@ -623,9 +625,10 @@ composOp co trm =
         vs' <- mapM co vs
         return (V ty' vs')
 
-   Val ty i ->
-     do ty' <- co ty
-        return (Val ty' i)
+   Val te ty i ->
+     do te' <- co te
+        ty' <- co ty
+        return (Val te' ty' i)
 
    Let (x,(mt,a)) b -> 
      do a'  <- co a
diff --git a/src/GF/Grammar/PatternMatch.hs b/src/GF/Grammar/PatternMatch.hs
index 92d75f2d3..e576dc12e 100644
--- a/src/GF/Grammar/PatternMatch.hs
+++ b/src/GF/Grammar/PatternMatch.hs
@@ -75,9 +75,11 @@ tryMatch (p,t) = do
   isInConstantFormt = True -- tested already in matchPattern
   trym p t' =
     case (p,t') of
-      (PVal _ i, (_,Val _ j,_)) 
+      (PVal _ _ i, (_,Val _ _ j,_)) 
           | i == j -> return []
           | otherwise -> Bad $ "no match of values"
+      (PVal pa _ _,_) -> trym pa t'
+      (_, (_,Val te _ _,_)) -> tryMatch (p, te)
       (_,(x,Empty,y)) -> trym p (x,K [],y)   -- because "" = [""] = []
       (PV IW, _) | isInConstantFormt -> return [] -- optimization with wildcard
       (PV x,  _) | isInConstantFormt -> return [(x,t)]
@@ -151,6 +153,7 @@ isInConstantForm trm = case trm of
     Empty    -> True
     Alias _ _ t -> isInConstantForm t
     EInt _   -> True
+    Val _ _ _ -> True
     _       -> False ---- isInArgVarForm trm
 
 varsOfPatt :: Patt -> [Ident]