Added view patterns (Trac #2399)
authorReiner Pope <reiner.pope@gmail.com>
Sun, 10 Oct 2010 12:39:05 +0000 (12:39 +0000)
committerReiner Pope <reiner.pope@gmail.com>
Sun, 10 Oct 2010 12:39:05 +0000 (12:39 +0000)
libraries/template-haskell/Language/Haskell/TH.hs
libraries/template-haskell/Language/Haskell/TH/Lib.hs
libraries/template-haskell/Language/Haskell/TH/Ppr.hs
libraries/template-haskell/Language/Haskell/TH/Syntax.hs

index 725bd69..8f25d72 100644 (file)
@@ -47,7 +47,7 @@ module Language.Haskell.TH(
        charL, stringL, stringPrimL,
     -- *** Patterns
        litP, varP, tupP, conP, infixP, tildeP, bangP, asP, wildP, recP,
-       listP, sigP, 
+       listP, sigP, viewP,
        fieldPat,
 
     -- *** Pattern Guards
index 5eec055..d6a1688 100644 (file)
@@ -92,6 +92,10 @@ sigP :: PatQ -> TypeQ -> PatQ
 sigP p t = do p' <- p
               t' <- t
               return (SigP p' t')
+viewP :: ExpQ -> PatQ -> PatQ
+viewP e p = do e' <- e
+               p' <- p
+               return (ViewP e' p')
 
 fieldPat :: Name -> PatQ -> FieldPatQ
 fieldPat n p = do p' <- p
@@ -540,6 +544,7 @@ rename (RecP nm fs) = do { pairs <- mapM rename ps; g(combine pairs) }
 rename (ListP pats) = do { pairs <- mapM rename pats; g(combine pairs) }
    where g (es,ps) = return (es,ListP ps)
 rename (SigP {}) = fail "rename: Don't know how to do SigP yet"
+rename (ViewP {}) = fail "rename: Don't know how to do ViewP yet"
 
 genpat :: Pat -> Q ((Name -> ExpQ), Pat)
 genpat p = do { (env,p2) <- rename p; return (alpha env,p2) }
index 4eb31c1..ac1bbf5 100644 (file)
@@ -201,6 +201,7 @@ pprPat _ (RecP nm fs)
                         map (\(s,p) -> ppr s <+> equals <+> ppr p) fs)
 pprPat _ (ListP ps) = brackets $ sep $ punctuate comma $ map ppr ps
 pprPat i (SigP p t) = parensIf (i > noPrec) $ ppr p <+> text "::" <+> ppr t
+pprPat _ (ViewP e p) = parens $ pprExp noPrec e <+> text "->" <+> pprPat noPrec p
 
 ------------------------------
 instance Ppr Dec where
index 4a6fe8f..364ae53 100644 (file)
@@ -700,6 +700,7 @@ data Pat
   | RecP Name [FieldPat]          -- ^ @f (Pt { pointx = x }) = g x@
   | ListP [ Pat ]                 -- ^ @{ [1,2,3] }@
   | SigP Pat Type                 -- ^ @{ p :: t }@
+  | ViewP Exp Pat                 -- ^ @{ e -> p }@
   deriving( Show, Eq, Data, Typeable )
 
 type FieldPat = (Name,Pat)