putting pattern macros in place (not properly tested yet)

2 files changed, 38 insertions, 1 deletions

diff --git a/src/GF/Devel/CheckGrammar.hs b/src/GF/Devel/CheckGrammar.hs
index f0ec8318c..0910802d1 100644
--- a/src/GF/Devel/CheckGrammar.hs
+++ b/src/GF/Devel/CheckGrammar.hs
@@ -580,6 +580,13 @@ inferLType gr trm = case trm of
 ---     checkIfComplexVariantType trm ty
      check trm ty
 
+   EPattType ty -> do
+     ty' <- justCheck ty typeType
+     return (ty',typeType)
+   EPatt p -> do
+     ty <- inferPatt p
+     return (trm, EPattType ty)
+
    _ -> prtFail "cannot infer lintype of" trm
 
  where
@@ -616,6 +623,7 @@ inferLType gr trm = case trm of
      PInt _ -> True
      PFloat _ -> True
      PChar -> True
+     PChars _ -> True
      PSeq p q -> isConstPatt p && isConstPatt q
      PAlt p q -> isConstPatt p && isConstPatt q
      PRep p -> isConstPatt p
@@ -631,6 +639,7 @@ inferLType gr trm = case trm of
      PSeq _ _ -> return $ typeStr
      PRep _   -> return $ typeStr
      PChar    -> return $ typeStr
+     PChars _ -> return $ typeStr
      _ -> infer (patt2term p) >>= return . snd
 
 
diff --git a/src/GF/Devel/Compute.hs b/src/GF/Devel/Compute.hs
index c0a99f4fd..a9081c28a 100644
--- a/src/GF/Devel/Compute.hs
+++ b/src/GF/Devel/Compute.hs
@@ -306,7 +306,8 @@ computeTermOpt rec gr = comput True where
        case allParamValues gr ptyp of
          Ok vs -> do
 
-           cs'  <- mapM (compBranchOpt g) cs
+           ps0  <- mapM (compPatternMacro . fst) cs
+           cs'  <- mapM (compBranchOpt g) (zip ps0 (map snd cs))
            sts  <- mapM (matchPattern cs') vs 
            ts   <- mapM (\ (c,g') -> comp (g' ++ g) c) sts
            ps   <- mapM term2patt vs
@@ -382,6 +383,33 @@ computeTermOpt rec gr = comput True where
        R rs     -> all (isCan . snd . snd) rs
        _        -> False
 
+     compPatternMacro p = case p of
+       PM m c -> case look m c of
+         Ok (EPatt p') -> compPatternMacro p'
+         _ -> prtBad "pattern expected as value of" p ---- should be in CheckGr
+       PAs x p -> do
+         p' <- compPatternMacro p
+         return $ PAs x p'
+       PAlt p q -> do
+         p' <- compPatternMacro p
+         q' <- compPatternMacro q
+         return $ PAlt p' q'
+       PSeq p q -> do
+         p' <- compPatternMacro p
+         q' <- compPatternMacro q
+         return $ PSeq p' q'
+       PRep p -> do
+         p' <- compPatternMacro p
+         return $ PRep p'
+       PNeg p -> do
+         p' <- compPatternMacro p
+         return $ PNeg p'
+       PR rs -> do
+         rs' <- mapPairsM compPatternMacro rs
+         return $ PR rs'
+
+       _ -> return p
+
      compBranch g (p,v) = do
        let g' = contP p ++ g
        v' <- comp g' v