regular expression patterns

6 files changed, 13 insertions, 4 deletions

diff --git a/src/GF/Grammar/AppPredefined.hs b/src/GF/Grammar/AppPredefined.hs
index 442328eb4..c8710f32d 100644
--- a/src/GF/Grammar/AppPredefined.hs
+++ b/src/GF/Grammar/AppPredefined.hs
@@ -35,7 +35,6 @@ typPredefined c@(IC f) = case f of
   "PBool"  -> return typePType
   "PFalse" -> return $ cnPredef "PBool"
   "PTrue"  -> return $ cnPredef "PBool"
-  "CC"     -> return $ mkFunType [typeTok,typeTok] typeTok
   "dp"     -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
   "drop"   -> return $ mkFunType [cnPredef "Int",typeTok] typeTok
   "eqInt"  -> return $ mkFunType [cnPredef "Int",cnPredef "Int"] (cnPredef "PBool")
@@ -74,7 +73,6 @@ appPredefined t = case t of
     App (Q (IC "Predef") (IC f)) z0 -> do
      (z,_) <- appPredefined z0
      case (f, norm z, norm x) of
-      ("CC",   K r,    K s) -> retb $ K (r ++ s)
       ("drop", EInt i, K s) -> retb $ K (drop (fi i) s)
       ("take", EInt i, K s) -> retb $ K (take (fi i) s)
       ("tk",   EInt i, K s) -> retb $ K (take (max 0 (length s - fi i)) s)
diff --git a/src/GF/Grammar/Compute.hs b/src/GF/Grammar/Compute.hs
index a25f6f98f..4adc38ce6 100644
--- a/src/GF/Grammar/Compute.hs
+++ b/src/GF/Grammar/Compute.hs
@@ -310,6 +310,7 @@ computeTermOpt rec gr = comp where
        PSeq p q -> concatMap contP [p,q]
        PAlt p q -> concatMap contP [p,q]
        PRep p   -> contP p
+       PNeg p   -> contP p
 
        _ -> []
 
diff --git a/src/GF/Grammar/Grammar.hs b/src/GF/Grammar/Grammar.hs
index 7be13a0d9..47970c882 100644
--- a/src/GF/Grammar/Grammar.hs
+++ b/src/GF/Grammar/Grammar.hs
@@ -175,9 +175,10 @@ data Patt =
  | PAs Ident Patt         -- ^ as-pattern: x@p
 
  -- regular expression patterns
+ | PNeg Patt              -- ^ negated pattern: -p
  | PAlt Patt Patt         -- ^ disjunctive pattern: p1 | p2
- | PSeq Patt Patt         -- ^ sequence of token parts
- | PRep Patt              -- ^ repetition of token part
+ | PSeq Patt Patt         -- ^ sequence of token parts: p + q
+ | PRep Patt              -- ^ repetition of token part: p*
 
   deriving (Read, Show, Eq, Ord)
 
diff --git a/src/GF/Grammar/Macros.hs b/src/GF/Grammar/Macros.hs
index bc394b143..8261f7f36 100644
--- a/src/GF/Grammar/Macros.hs
+++ b/src/GF/Grammar/Macros.hs
@@ -509,6 +509,9 @@ term2patt trm = case termForm trm of
   Ok ([], Cn (IC "@"), [Vr a,b]) -> do
     b' <- term2patt b
     return (PAs a b')
+  Ok ([], Cn (IC "-"), [a]) -> do
+    a' <- term2patt a
+    return (PNeg a')
   Ok ([], Cn (IC "*"), [a]) -> do
     a' <- term2patt a
     return (PRep a')
@@ -540,6 +543,7 @@ patt2term pt = case pt of
   PSeq a b  -> appc "+" [(patt2term a), (patt2term b)] --- an encoding
   PAlt a b  -> appc "|" [(patt2term a), (patt2term b)] --- an encoding
   PRep a    -> appc "*" [(patt2term a)]                --- an encoding
+  PNeg a    -> appc "-" [(patt2term a)]                --- an encoding
 
 
 redirectTerm :: Ident -> Term -> Term
diff --git a/src/GF/Grammar/PatternMatch.hs b/src/GF/Grammar/PatternMatch.hs
index 4e3feb5dc..f850981f0 100644
--- a/src/GF/Grammar/PatternMatch.hs
+++ b/src/GF/Grammar/PatternMatch.hs
@@ -95,6 +95,10 @@ tryMatch (p,t) = do
 
       (PAlt p1 p2,_) -> checks [trym p1 t', trym p2 t']
 
+      (PNeg p',_) -> case tryMatch (p',t) of
+        Bad _ -> return []
+        _ -> prtBad "no match with negative pattern" p
+
       (PSeq p1 p2, ([],K s, [])) -> do
          let cuts = [splitAt n s | n <- [0 .. length s]] 
          matches <- checks [mapM tryMatch [(p1,K s1),(p2,K s2)] | (s1,s2) <- cuts]
diff --git a/src/GF/Grammar/Refresh.hs b/src/GF/Grammar/Refresh.hs
index 045fccfc0..8be951215 100644
--- a/src/GF/Grammar/Refresh.hs
+++ b/src/GF/Grammar/Refresh.hs
@@ -77,6 +77,7 @@ refreshPatt p = case p of
   PSeq p' q' -> liftM2 PSeq    (refreshPatt p') (refreshPatt q')
   PAlt p' q' -> liftM2 PAlt    (refreshPatt p') (refreshPatt q')
   PRep p'    -> liftM  PRep    (refreshPatt p')
+  PNeg p'    -> liftM  PNeg    (refreshPatt p')
 
   _ -> return p