putting pattern macros in place (not properly tested yet)

src/GF/Source/GF.cf

@@ -192,8 +192,8 @@ EPre.      Exp4 ::= "pre" "{" Exp ";" [Altern] "}" ;
 EStrs.     Exp4 ::= "strs" "{" [Exp] "}" ;
 EConAt.    Exp4 ::= PIdent "@" Exp6 ; --%
 
-EPatt.     Exp4 ::= "pattern" Patt2 ;
-EPattType. Exp4 ::= "pattern" "type" Exp5 ;
+EPatt.     Exp4 ::= "#" Patt2 ;
+EPattType. Exp4 ::= "pattern" Exp5 ;
 
 ESelect.   Exp3 ::= Exp3 "!" Exp4 ;
 ETupTyp.   Exp3 ::= Exp3 "*" Exp4 ;

src/GF/Source/GrammarToSource.hs

@@ -191,6 +191,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
@@ -221,6 +224,7 @@ trp p = case p of
     PNeg p   -> P.PNeg (trp p)
     PChar    -> P.PChar
     PChars s -> P.PChars s
+    PM m c   -> P.PM (tri m) (tri c)
 
 
 trAssign (lab, (mty, t)) = maybe (P.LDDef x t') (\ty -> P.LDFull x (trt ty) t') mty

src/GF/Source/LexGF.hs

@@ -88,7 +88,7 @@ eitherResIdent tv s = treeFind resWords
                               | s > a  = treeFind right
                               | s == a = t
 
-resWords = b "lincat" (b "def" (b "Type" (b "Str" (b "PType" (b "Lin" N N) N) (b "Tok" (b "Strs" N N) N)) (b "cat" (b "case" (b "abstract" N N) N) (b "data" (b "concrete" N N) N))) (b "include" (b "fun" (b "fn" (b "flags" N N) N) (b "in" (b "grammar" N N) N)) (b "interface" (b "instance" (b "incomplete" N N) N) (b "lin" (b "let" N N) N)))) (b "resource" (b "out" (b "of" (b "lintype" (b "lindef" N N) N) (b "oper" (b "open" N N) N)) (b "pattern" (b "param" (b "package" N N) N) (b "printname" (b "pre" N N) N))) (b "type" (b "table" (b "strs" (b "reuse" N N) N) (b "transfer" (b "tokenizer" N N) N)) (b "variants" (b "var" (b "union" N N) N) (b "with" (b "where" N N) N))))
+resWords = b "lincat" (b "def" (b "Type" (b "Str" (b "PType" (b "Lin" N N) N) (b "Tok" (b "Strs" N N) N)) (b "cat" (b "case" (b "abstract" N N) N) (b "data" (b "concrete" N N) N))) (b "include" (b "fun" (b "fn" (b "flags" N N) N) (b "in" (b "grammar" N N) N)) (b "interface" (b "instance" (b "incomplete" N N) N) (b "lin" (b "let" N N) N)))) (b "resource" (b "out" (b "of" (b "lintype" (b "lindef" N N) N) (b "oper" (b "open" N N) N)) (b "pattern" (b "param" (b "package" N N) N) (b "printname" (b "pre" N N) N))) (b "union" (b "table" (b "strs" (b "reuse" N N) N) (b "transfer" (b "tokenizer" N N) N)) (b "where" (b "variants" (b "var" N N) N) (b "with" N N))))
    where b s = B s (TS s)
 
 unescapeInitTail :: String -> String

src/GF/Source/PrintGF.hs

@@ -355,8 +355,8 @@ instance Print Exp where
    EPre exp alterns -> prPrec i 4 (concatD [doc (showString "pre") , doc (showString "{") , prt 0 exp , doc (showString ";") , prt 0 alterns , doc (showString "}")])
    EStrs exps -> prPrec i 4 (concatD [doc (showString "strs") , doc (showString "{") , prt 0 exps , doc (showString "}")])
    EConAt pident exp -> prPrec i 4 (concatD [prt 0 pident , doc (showString "@") , prt 6 exp])
-   EPatt patt -> prPrec i 4 (concatD [doc (showString "pattern") , prt 2 patt])
-   EPattType exp -> prPrec i 4 (concatD [doc (showString "pattern") , doc (showString "type") , prt 5 exp])
+   EPatt patt -> prPrec i 4 (concatD [doc (showString "#") , prt 2 patt])
+   EPattType exp -> prPrec i 4 (concatD [doc (showString "pattern") , prt 5 exp])
    ESelect exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "!") , prt 4 exp])
    ETupTyp exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "*") , prt 4 exp])
    EExtend exp0 exp -> prPrec i 3 (concatD [prt 3 exp0 , doc (showString "**") , prt 4 exp])

src/GF/Source/SourceToGrammar.hs

@@ -496,6 +496,9 @@ transExp x = case x of
   ELetb defs exp -> transExp $ ELet defs exp
   EWhere exp defs -> transExp $ ELet defs exp
 
+  EPattType typ -> liftM G.EPattType (transExp typ)
+  EPatt patt -> liftM G.EPatt (transPatt patt)
+
   ELString (LString str) -> return $ G.K str 
   ELin id -> liftM G.LiT $ transIdent id
 
@@ -608,6 +611,8 @@ transPatt x = case x of
   PAs x p     -> liftM2 G.PAs  (transIdent x) (transPatt p)
   PChar -> return G.PChar
   PChars s -> return $ G.PChars s
+  PMacro c -> liftM G.PMacro $ transIdent c
+  PM m c   -> liftM2 G.PM (transIdent m) (transIdent c)
 
 transBind :: Bind -> Err Ident
 transBind x = case x of