From d133e0353ca614b36357dadb782aea43de895e09 Mon Sep 17 00:00:00 2001
From: aarne <aarne@cs.chalmers.se>
Date: Sat, 7 Jan 2006 14:39:40 +0000
Subject: regular expression patterns

---
 src/GF/Compile/CheckGrammar.hs | 7 +++++++
 src/GF/Compile/Rename.hs       | 4 ++++
 2 files changed, 11 insertions(+)

(limited to 'src/GF/Compile')

diff --git a/src/GF/Compile/CheckGrammar.hs b/src/GF/Compile/CheckGrammar.hs
index 33db87e37..c55873409 100644
--- a/src/GF/Compile/CheckGrammar.hs
+++ b/src/GF/Compile/CheckGrammar.hs
@@ -515,11 +515,17 @@ inferLType gr trm = case trm of
      PSeq p q -> isConstPatt p && isConstPatt q
      PAlt p q -> isConstPatt p && isConstPatt q
      PRep p -> isConstPatt p
+     PNeg p -> isConstPatt p
      PAs _ p -> isConstPatt p
      _ -> False
 
    inferPatt p = case p of
      PP q c ps | q /= cPredef -> checkErr $ lookupResType gr q c >>= valTypeCnc
+     PAs _ p  -> inferPatt p
+     PNeg p   -> inferPatt p
+     PAlt p q -> checks [inferPatt p, inferPatt q]
+     PSeq _ _ -> return $ typeTok
+     PRep _   -> return $ typeTok
      _ -> infer (patt2term p) >>= return . snd
 
 checkLType :: SourceGrammar -> Term -> Type -> Check (Term, Type)
@@ -700,6 +706,7 @@ pattContext env typ p = case p of
     g2 <- pattContext env typ q
     return $ g1 ++ g2
   PRep p -> pattContext env typeStr p
+  PNeg p -> pattContext env typeStr p
 
   _ -> return [] ---- check types!
  where 
diff --git a/src/GF/Compile/Rename.hs b/src/GF/Compile/Rename.hs
index 61f26b89e..ecabf03b1 100644
--- a/src/GF/Compile/Rename.hs
+++ b/src/GF/Compile/Rename.hs
@@ -255,6 +255,10 @@ renamePattern env patt = case patt of
     (p',vs) <- renp p
     return (PRep p', vs)
 
+  PNeg p -> do
+    (p',vs) <- renp p
+    return (PNeg p', vs)
+
   PAs x p -> do
     (p',vs) <- renp p
     return (PAs x p', x:vs)
-- 
cgit v1.2.3