regular expression patterns

lib/prelude/Predef.gf

@@ -10,7 +10,6 @@ resource Predef = {
   oper Int  : Type = variants {} ;                     -- the type of integers
   oper Ints : Int -> Type = variants {} ;              -- the type of integers from 0 to n
 
-  oper CC     : Tok -> Tok -> Tok      = variants {} ; -- concatenation; used in patterns
   oper length : Tok ->        Int      = variants {} ; -- length of string
   oper drop   : Int -> Tok -> Tok      = variants {} ; -- drop prefix of length
   oper take   : Int -> Tok -> Tok      = variants {} ; -- take prefix of length

lib/resource/finnish/MorphoFin.gf

@@ -1355,7 +1355,9 @@ caseTable : Number -> CommonNoun -> Case => Str = \n,cn ->
     in
     {s = table {
       Imper Sg => "älä" ;
-      Impf n p | Cond n p => ei.s ! Pres n p ;
+--      Impf n p | Cond n p => ei.s ! Pres n p ;
+      Impf n p => ei.s ! Pres n p ;
+      Cond n p => ei.s ! Pres n p ;
       v => ei.s ! v
       }
     } ;

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 

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)

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)

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
 
        _ -> []
 

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)
 

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

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]

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
 

src/GF/Source/AbsGF.hs

@@ -224,6 +224,7 @@ data Patt =
  | PSeq Patt Patt
  | PRep Patt
  | PAs Ident Patt
+ | PNeg Patt
   deriving (Eq,Ord,Show)
 
 data PattAss =

src/GF/Source/GF.cf

@@ -225,6 +225,7 @@ PDisj.  Patt   ::= Patt "|" Patt1 ;
 PSeq.   Patt   ::= Patt "+" Patt1 ;
 PRep.   Patt1  ::= Patt2 "*" ;
 PAs.    Patt1  ::= Ident "@" Patt2 ;
+PNeg.   Patt1  ::= "-" Patt2 ;
 
 coercions Patt 2 ;
 

src/GF/Source/GrammarToSource.hs

@@ -202,6 +202,7 @@ trp p = case p of
     PAlt p q -> P.PDisj (trp p) (trp q)
     PSeq p q -> P.PSeq (trp p) (trp q)
     PRep p   -> P.PRep (trp p)
+    PNeg p   -> P.PNeg (trp p)
 
 
 trAssign (lab, (mty, t)) = maybe (P.LDDef x t') (\ty -> P.LDFull x (trt ty) t') mty

src/GF/Source/ParGF.y

@@ -456,6 +456,7 @@ Patt1 : Ident ListPatt { PC $1 $2 }
   | Ident '.' Ident ListPatt { PQC $1 $3 $4 }
   | Patt2 '*' { PRep $1 }
   | Ident '@' Patt2 { PAs $1 $3 }
+  | '-' Patt2 { PNeg $2 }
   | Patt2 { $1 }
 
 

src/GF/Source/PrintGF.hs

@@ -402,6 +402,7 @@ instance Print Patt where
    PSeq patt0 patt -> prPrec i 0 (concatD [prt 0 patt0 , doc (showString "+") , prt 1 patt])
    PRep patt -> prPrec i 1 (concatD [prt 2 patt , doc (showString "*")])
    PAs id patt -> prPrec i 1 (concatD [prt 0 id , doc (showString "@") , prt 2 patt])
+   PNeg patt -> prPrec i 1 (concatD [doc (showString "-") , prt 2 patt])
 
   prtList es = case es of
    [x] -> (concatD [prt 2 x])

src/GF/Source/SourceToGrammar.hs

@@ -559,7 +559,8 @@ transPatt x = case x of
   PDisj p1 p2 -> liftM2 G.PAlt (transPatt p1) (transPatt p2)
   PSeq p1 p2  -> liftM2 G.PSeq (transPatt p1) (transPatt p2)
   PRep p      -> liftM  G.PRep (transPatt p)
-  PAs x p     -> liftM2 G.PAs (transIdent x) (transPatt p)
+  PNeg p      -> liftM  G.PNeg (transPatt p)
+  PAs x p     -> liftM2 G.PAs  (transIdent x) (transPatt p)