Added multi-way if-expressions support.
authorMikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com>
Sat, 14 Jul 2012 17:56:17 +0000 (00:56 +0700)
committerSimon Marlow <marlowsd@gmail.com>
Mon, 16 Jul 2012 10:09:56 +0000 (11:09 +0100)
Language/Haskell/TH.hs
Language/Haskell/TH/Lib.hs
Language/Haskell/TH/Ppr.hs
Language/Haskell/TH/PprLib.hs
Language/Haskell/TH/Syntax.hs

index fc4722f..8e36af7 100644 (file)
@@ -56,7 +56,7 @@ module Language.Haskell.TH(
     -- *** Expressions
        dyn, global, varE, conE, litE, appE, uInfixE, parensE,
        infixE, infixApp, sectionL, sectionR,
-       lamE, lam1E, lamCaseE, tupE, condE, letE, caseE, appsE,
+       lamE, lam1E, lamCaseE, tupE, condE, multiIfE, letE, caseE, appsE,
        listE, sigE, recConE, recUpdE, stringE, fieldExp,
     -- **** Ranges
     fromE, fromThenE, fromToE, fromThenToE,
index 1edeb0b..52865ad 100644 (file)
@@ -254,6 +254,9 @@ unboxedTupE es = do { es1 <- sequence es; return (UnboxedTupE es1)}
 condE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
 condE x y z =  do { a <- x; b <- y; c <- z; return (CondE a b c)}
 
+multiIfE :: [Q (Guard, Exp)] -> ExpQ
+multiIfE alts = sequence alts >>= return . MultiIfE
+
 letE :: [DecQ] -> ExpQ -> ExpQ
 letE ds e = do { ds2 <- sequence ds; e2 <- e; return (LetE ds2 e2) }
 
index a53fffe..a1d08e2 100644 (file)
@@ -115,6 +115,12 @@ pprExp i (CondE guard true false)
  = parensIf (i > noPrec) $ sep [text "if"   <+> ppr guard,
                        nest 1 $ text "then" <+> ppr true,
                        nest 1 $ text "else" <+> ppr false]
+pprExp i (MultiIfE alts)
+  = parensIf (i > noPrec) $ vcat $
+      case alts of
+        []            -> [text "if {}"]
+        (alt : alts') -> text "if" <+> pprGuarded arrow alt
+                         : map (nest 3 . pprGuarded arrow) alts'
 pprExp i (LetE ds e) = parensIf (i > noPrec) $ text "let" <+> ppr ds
                                             $$ text " in" <+> ppr e
 pprExp i (CaseE e ms)
@@ -156,13 +162,19 @@ instance Ppr Match where
                         $$ where_clause ds
 
 ------------------------------
+pprGuarded :: Doc -> (Guard, Exp) -> Doc
+pprGuarded eqDoc (guard, expr) = case guard of
+  NormalG guardExpr -> char '|' <+> ppr guardExpr <+> eqDoc <+> ppr expr
+  PatG    stmts     -> char '|' <+> vcat (punctuate comma $ map ppr stmts) $$ 
+                         nest nestDepth (eqDoc <+> ppr expr)
+
+------------------------------
 pprBody :: Bool -> Body -> Doc
-pprBody eq (GuardedB xs) = nest nestDepth $ vcat $ map do_guard xs
-  where eqd = if eq then text "=" else text "->"
-        do_guard (NormalG g, e) = text "|" <+> ppr g <+> eqd <+> ppr e
-        do_guard (PatG ss, e) = text "|" <+> vcat (map ppr ss)
-                             $$ nest nestDepth (eqd <+> ppr e)
-pprBody eq (NormalB e) = (if eq then text "=" else text "->") <+> ppr e
+pprBody eq body = case body of
+    GuardedB xs -> nest nestDepth $ vcat $ map (pprGuarded eqDoc) xs
+    NormalB  e  -> eqDoc <+> ppr e
+  where eqDoc | eq        = equals
+              | otherwise = arrow
 
 ------------------------------
 pprLit :: Precedence -> Lit -> Doc
index e42c986..42856bb 100644 (file)
@@ -10,7 +10,7 @@ module Language.Haskell.TH.PprLib (
 
        -- * Primitive Documents
         empty,
-        semi, comma, colon, space, equals,
+        semi, comma, colon, space, equals, arrow,
         lparen, rparen, lbrack, rbrack, lbrace, rbrace,
 
        -- * Converting values into documents
@@ -63,6 +63,7 @@ comma :: Doc;                 -- ^ A ',' character
 colon  :: Doc;                 -- ^ A ':' character
 space  :: Doc;                 -- ^ A space character
 equals :: Doc;                 -- ^ A '=' character
+arrow  :: Doc;                 -- ^ A "->" string
 lparen :: Doc;                 -- ^ A '(' character
 rparen :: Doc;                 -- ^ A ')' character
 lbrack :: Doc;                 -- ^ A '[' character
@@ -163,6 +164,7 @@ comma = return HPJ.comma
 colon = return HPJ.colon
 space = return HPJ.space
 equals = return HPJ.equals
+arrow = return $ HPJ.text "->"
 lparen = return HPJ.lparen
 rparen = return HPJ.rparen
 lbrack = return HPJ.lbrack
index 65aff77..d9c1dcc 100644 (file)
@@ -866,6 +866,7 @@ data Exp
   | TupE [Exp]                         -- ^ @{ (e1,e2) }  @
   | UnboxedTupE [Exp]                  -- ^ @{ (# e1,e2 #) }  @
   | CondE Exp Exp Exp                  -- ^ @{ if e1 then e2 else e3 }@
+  | MultiIfE [(Guard, Exp)]            -- ^ @{ if | g1 -> e1 | g2 -> e2 }@
   | LetE [Dec] Exp                     -- ^ @{ let x=e1;   y=e2 in e3 }@
   | CaseE Exp [Match]                  -- ^ @{ case e of m1; m2 }@
   | DoE [Stmt]                         -- ^ @{ do { p <- e1; e2 }  }@