regex patterns for tokens

2 files changed, 38 insertions, 2 deletions

diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs
index 3b3e9eaa6..33db87e37 100644
--- a/src/GF/Compile/CheckGrammar.hs
+++ b/src/GF/Compile/CheckGrammar.hs
@@ -512,6 +512,10 @@ inferLType gr trm = case trm of
      PString _ -> True
      PInt _ -> True
      PFloat _ -> True
+     PSeq p q -> isConstPatt p && isConstPatt q
+     PAlt p q -> isConstPatt p && isConstPatt q
+     PRep p -> isConstPatt p
+     PAs _ p -> isConstPatt p
      _ -> False
 
    inferPatt p = case p of
@@ -664,7 +668,7 @@ checkLType env trm typ0 = do
 pattContext :: LTEnv -> Type -> Patt -> Check Context
 pattContext env typ p = case p of
   PV x -> return [(x,typ)]
-  PP q c ps | q /= cPredef || prt c == "CC" -> do ---- why this /=? AR 6/1/2006
+  PP q c ps | q /= cPredef -> do ---- why this /=? AR 6/1/2006
     t <- checkErr $ lookupResType cnc q c
     (cont,v) <- checkErr $ typeFormCnc t
     checkCond ("wrong number of arguments for constructor in" +++ prt p) 
@@ -683,7 +687,21 @@ pattContext env typ p = case p of
     checkEqLType env typ t (patt2term p')
     pattContext env typ p'
 
-  _ -> return [] ----
+  PAs x p -> do
+    g <- pattContext env typ p
+    return $ (x,typ):g
+
+  PAlt p q -> do
+    g1 <- pattContext env typ p
+    g2 <- pattContext env typ q
+    return $ filter (flip elem g1) g2 -- must be in both
+  PSeq p q -> do
+    g1 <- pattContext env typ p
+    g2 <- pattContext env typ q
+    return $ g1 ++ g2
+  PRep p -> pattContext env typeStr p
+
+  _ -> return [] ---- check types!
  where 
    cnc = env
 
diff --git a/src/GF/Compile/Rename.hs b/src/GF/Compile/Rename.hs
index c3369e9ef..61f26b89e 100644
--- a/src/GF/Compile/Rename.hs
+++ b/src/GF/Compile/Rename.hs
@@ -241,6 +241,24 @@ renamePattern env patt = case patt of
     let (ps',vs') = unzip psvss
     return (PR (zip ls ps'), concat vs') 
 
+  PAlt p q -> do
+    (p',vs) <- renp p
+    (q',ws) <- renp q
+    return (PAlt p' q', vs ++ ws)
+
+  PSeq p q -> do
+    (p',vs) <- renp p
+    (q',ws) <- renp q
+    return (PSeq p' q', vs ++ ws)
+
+  PRep p -> do
+    (p',vs) <- renp p
+    return (PRep p', vs)
+
+  PAs x p -> do
+    (p',vs) <- renp p
+    return (PAs x p', x:vs)
+
   _ -> return (patt,[])
 
  where