added some new pattern forms, incl. pattern macros, to testgf3

5 files changed, 23 insertions, 0 deletions

diff --git a/src/GF/Devel/Grammar/GFtoSource.hs b/src/GF/Devel/Grammar/GFtoSource.hs
index 6618eaa20..9cd491e3d 100644
--- a/src/GF/Devel/Grammar/GFtoSource.hs
+++ b/src/GF/Devel/Grammar/GFtoSource.hs
@@ -162,6 +162,9 @@ trt trm = case trm of
     EInt i -> P.EInt i
     EFloat i -> P.EFloat i
 
+    EPatt p -> P.EPatt (trp p)
+    EPattType t -> P.EPattType (trt t)
+
     Glue a b -> P.EGlue (trt a) (trt b)
     Alts (t, tt) -> P.EPre (trt t) [P.Alt (trt v) (trt c) | (v,c) <- tt]
     FV ts -> P.EVariants $ map trt ts
@@ -170,6 +173,9 @@ trt trm = case trm of
 
 trp :: Patt -> P.Patt
 trp p = case p of
+    PChar -> P.PChar
+    PChars s -> P.PChars s
+    PM m c -> P.PM (tri m) (tri c)
     PW -> P.PW
     PV s | isWildIdent s -> P.PW
     PV s -> P.PV $ tri s
diff --git a/src/GF/Devel/Grammar/Grammar.hs b/src/GF/Devel/Grammar/Grammar.hs
index eb6d2218a..09bcfb2ae 100644
--- a/src/GF/Devel/Grammar/Grammar.hs
+++ b/src/GF/Devel/Grammar/Grammar.hs
@@ -105,6 +105,9 @@ data Term =
  | C Term Term          -- ^ concatenation: @s ++ t@
  | Glue Term Term       -- ^ agglutination: @s + t@
 
+ | EPatt Patt
+ | EPattType Term
+
  | FV [Term]            -- ^ free variation: @variants { s ; ... }@
 
  | Alts (Term, [(Term, Term)]) -- ^ prefix-dependent: @pre {t ; s\/c ; ...}@
@@ -130,6 +133,11 @@ data Patt =
  | PAlt Patt Patt         -- ^ disjunctive pattern: p1 | p2
  | PSeq Patt Patt         -- ^ sequence of token parts: p + q
  | PRep Patt              -- ^ repetition of token part: p*
+ | PChar                  -- ^ string of length one
+ | PChars String          -- ^ list of characters
+
+ | PMacro Ident           -- 
+ | PM Ident Ident
 
   deriving (Read, Show, Eq, Ord)
 
diff --git a/src/GF/Devel/Grammar/Lookup.hs b/src/GF/Devel/Grammar/Lookup.hs
index 94021cb7d..876d60d26 100644
--- a/src/GF/Devel/Grammar/Lookup.hs
+++ b/src/GF/Devel/Grammar/Lookup.hs
@@ -91,6 +91,7 @@ allParamValues cnc ptyp = case ptyp of
        return [EInt i | i <- [0..n]]
      QC p c -> lookupParamValues cnc p c
      Q  p c -> lookupParamValues cnc p c ----
+
      RecType r -> do
        let (ls,tys) = unzip $ sortByFst r
        tss <- mapM allPV tys
diff --git a/src/GF/Devel/Grammar/Macros.hs b/src/GF/Devel/Grammar/Macros.hs
index 71e7fdde5..e28859416 100644
--- a/src/GF/Devel/Grammar/Macros.hs
+++ b/src/GF/Devel/Grammar/Macros.hs
@@ -287,6 +287,10 @@ composOp co trm = case trm of
      tts' <- mapM (pairM co) tts
      return $ Overload tts'
 
+   EPattType ty -> 
+     do ty' <- co ty
+        return (EPattType ty')
+
    _ -> return trm -- covers K, Vr, Cn, Sort
 
 
diff --git a/src/GF/Devel/Grammar/PatternMatch.hs b/src/GF/Devel/Grammar/PatternMatch.hs
index 076aaa25a..ec64d7802 100644
--- a/src/GF/Devel/Grammar/PatternMatch.hs
+++ b/src/GF/Devel/Grammar/PatternMatch.hs
@@ -114,6 +114,10 @@ tryMatch (p,t) = do
            [1..n]) t' | n <- [0 .. length s]
         ] >>
         return []
+
+      (PChar,  ([],K [_], [])) -> return []
+      (PChars cs, ([],K [c], [])) | elem c cs -> return []
+
       _ -> prtBad "no match in case expr for" t
 
 eqStrIdent = (==) ----