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

src/GF/Compile/CheckGrammar.hs

@@ -455,7 +455,7 @@ inferLType gr trm = case trm of
        prtFail "cannot infer type of canonical constant" trm
        ]
 
-   Val ty i -> termWith trm $ return ty
+   Val _ ty i -> termWith trm $ return ty
 
    Vr ident -> termWith trm $ checkLookup ident
 

src/GF/Compile/Compute.hs

@@ -309,14 +309,21 @@ computeTermOpt rec gr = comput True where
          T _ [(PT _ (PV z),c)] -> comp (ext z v' g) c
 
          -- course-of-values table: look up by index, no pattern matching needed
-         V ptyp ts -> do
-           vs <- allParamValues gr ptyp
-           case lookupR v' (zip vs [0 .. length vs - 1]) of
-             Just i -> comp g $ ts !! i
-             _ -> return $ S t' v' -- if v' is not canonical
-         T _ cc -> case matchPattern cc v' of
+
+         V ptyp ts -> case v' of
+           Val _ _ i -> comp g $ ts !! i
+           _ -> do
+             vs <- allParamValues gr ptyp
+             case lookupR v' (zip vs [0 .. length vs - 1]) of
+               Just i -> comp g $ ts !! i
+               _ -> return $ S t' v' -- if v' is not canonical
+         T _ cc -> do
+           let v2 = case v' of
+                 Val te _ _ -> te
+                 _ -> v'
+           case matchPattern cc v2 of
              Ok (c,g') -> comp (g' ++ g) c
-             _ | isCan v' -> prtBad ("missing case" +++ prt v' +++ "in") t 
+             _ | isCan v2 -> prtBad ("missing case" +++ prt v2 +++ "in") t 
              _ -> return $ S t' v' -- if v' is not canonical
 
          S (T i cs) e -> prawitz g i (flip S v') cs e
@@ -348,8 +355,8 @@ computeTermOpt rec gr = comput True where
            pty0 <- getTableType i
            ptyp <- comp g pty0
            case allParamValues gr ptyp of
-             Ok vs -> do
-
+             Ok vs0 -> do
+               let vs = [Val v ptyp i | (v,i) <- zip vs0 [0..]]
                ps0  <- mapM (compPatternMacro . fst) cs
                cs'  <- mapM (compBranchOpt g) (zip ps0 (map snd cs))
                sts  <- mapM (matchPattern cs') vs 

src/GF/Compile/GrammarToGFCC.hs

@@ -445,25 +445,6 @@ term2term fun cgr env@(labels,untyps,typs) tr = case tr of
    --- this is mainly needed for parameter record projections
    ---- was: 
    comp t = errVal t $ Compute.computeConcreteRec cgr t
-   compt t = case t of
-     T (TComp typ) ts  -> comp $ V typ (map (comp . snd) ts)  ---- should...
-     T (TTyped typ) ts -> comp $ V typ (map (comp . snd) ts)  ---- should
-     V typ ts -> V typ (map comp ts)
-     S tb (FV ts) -> FV $ map (comp . S tb) ts
-     S tb@(V typ ts) v0 -> err error id $ do
-       let v = comp v0 
-       let mv1 = Map.lookup v untyps
-       case mv1 of 
-         Just v0 -> 
-           let v1 = fromInteger v0
-               v2 = v1 --if length ts > v1 then v1 
-                       --else trace ("DEBUG" +++ show v1 +++ "of" +++ show ts) 0
-           in return $ (comp . (ts !!)) v2 
-         _ -> return (S (comp tb) v) 
-                  
-     R r -> R [(l,(ty,comp t)) | (l,(ty,t)) <- r]
-     P (R r) l -> maybe t (comp . snd) $ lookup l r
-     _ -> GM.composSafeOp comp t
 
    doVar :: Term -> STM [((Type,[Term]),(Term,Term))] Term
    doVar tr = case getLab tr of
@@ -511,6 +492,7 @@ term2term fun cgr env@(labels,untyps,typs) tr = case tr of
      _ | tr == x -> t
      _ -> GM.composSafeOp (mkBranch x t) tr     
 
+   valNum (Val _ _ i) = EInt $ toInteger i
    valNum tr = maybe (valNumFV $ tryFV tr) EInt $ Map.lookup tr untyps
     where
       tryFV tr = case GM.appForm tr of