[commit: template-haskell] master: Added lambda-case support. (46bda11)

[Simon Marlow]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/template-haskell

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/46bda11634c19cbd7435a28fed099aad8bb90bdc

>---------------------------------------------------------------

commit 46bda11634c19cbd7435a28fed099aad8bb90bdc
Author: Mikhail Vorozhtsov <mikhail.vorozhtsov at gmail.com>
Date:   Sat Jul 14 00:09:31 2012 +0700

    Added lambda-case support.

>---------------------------------------------------------------

 Language/Haskell/TH.hs        |    2 +-
 Language/Haskell/TH/Lib.hs    |    3 +++
 Language/Haskell/TH/Ppr.hs    |    2 ++
 Language/Haskell/TH/Syntax.hs |    1 +
 4 files changed, 7 insertions(+), 1 deletions(-)

diff --git a/Language/Haskell/TH.hs b/Language/Haskell/TH.hs
index 8d4128c..fc4722f 100644
--- a/Language/Haskell/TH.hs
+++ b/Language/Haskell/TH.hs
@@ -56,7 +56,7 @@ module Language.Haskell.TH(
     -- *** Expressions
 	dyn, global, varE, conE, litE, appE, uInfixE, parensE,
 	infixE, infixApp, sectionL, sectionR,
-	lamE, lam1E, tupE, condE, letE, caseE, appsE,
+	lamE, lam1E, lamCaseE, tupE, condE, letE, caseE, appsE,
 	listE, sigE, recConE, recUpdE, stringE, fieldExp,
     -- **** Ranges
     fromE, fromThenE, fromToE, fromThenToE,
diff --git a/Language/Haskell/TH/Lib.hs b/Language/Haskell/TH/Lib.hs
index dabad62..1edeb0b 100644
--- a/Language/Haskell/TH/Lib.hs
+++ b/Language/Haskell/TH/Lib.hs
@@ -242,6 +242,9 @@ lamE ps e = do ps' <- sequence ps
 lam1E :: PatQ -> ExpQ -> ExpQ
 lam1E p e = lamE [p] e
 
+lamCaseE :: [MatchQ] -> ExpQ
+lamCaseE ms = sequence ms >>= return . LamCaseE
+
 tupE :: [ExpQ] -> ExpQ
 tupE es = do { es1 <- sequence es; return (TupE es1)}
 
diff --git a/Language/Haskell/TH/Ppr.hs b/Language/Haskell/TH/Ppr.hs
index 0e443ef..a53fffe 100644
--- a/Language/Haskell/TH/Ppr.hs
+++ b/Language/Haskell/TH/Ppr.hs
@@ -106,6 +106,8 @@ pprExp _ (InfixE me1 op me2) = parens $ pprMaybeExp noPrec me1
                                     <+> pprMaybeExp noPrec me2
 pprExp i (LamE ps e) = parensIf (i > noPrec) $ char '\\' <> hsep (map (pprPat appPrec) ps)
                                            <+> text "->" <+> ppr e
+pprExp i (LamCaseE ms) = parensIf (i > noPrec)
+                       $ text "\\case" $$ nest nestDepth (ppr ms)
 pprExp _ (TupE es) = parens $ sep $ punctuate comma $ map ppr es
 pprExp _ (UnboxedTupE es) = hashParens $ sep $ punctuate comma $ map ppr es
 -- Nesting in Cond is to avoid potential problems in do statments
diff --git a/Language/Haskell/TH/Syntax.hs b/Language/Haskell/TH/Syntax.hs
index 5cf9c07..65aff77 100644
--- a/Language/Haskell/TH/Syntax.hs
+++ b/Language/Haskell/TH/Syntax.hs
@@ -862,6 +862,7 @@ data Exp
                                        --
                                        -- See Note [Unresolved infix] at "Language.Haskell.TH.Syntax#infix"
   | LamE [Pat] Exp                     -- ^ @{ \ p1 p2 -> e }@
+  | LamCaseE [Match]                   -- ^ @{ \case m1; m2 }@
   | TupE [Exp]                         -- ^ @{ (e1,e2) }  @
   | UnboxedTupE [Exp]                  -- ^ @{ (# e1,e2 #) }  @
   | CondE Exp Exp Exp                  -- ^ @{ if e1 then e2 else e3 }@