Ticket #4430: templatehaskell.patch
File templatehaskell.patch, 8.6 KB (added by , 6 years ago) 


Language/Haskell/TH.hs
From 77f478a0ab1eff87c113697794764e16ffaddfdb Mon Sep 17 00:00:00 2001 From: Reiner Pope <reiner.pope@gmail.com> Date: Tue, 19 Jul 2011 23:28:00 +1000 Subject: [PATCH] Add unresolved infix patterns and expressions  Language/Haskell/TH.hs  66 +++++++++++++++++++++++++++++++++++++++ Language/Haskell/TH/Lib.hs  15 +++++++++ Language/Haskell/TH/Ppr.hs  17 +++++++++ Language/Haskell/TH/Syntax.hs  12 +++++++ 4 files changed, 105 insertions(+), 5 deletions() diff git a/Language/Haskell/TH.hs b/Language/Haskell/TH.hs index c2bc267..a7e2382 100644
a b module Language.Haskell.TH( 27 27   The lowercase versions (/syntax operators/) of these constructors are 28 28  preferred to these constructors, since they compose better with 29 29  quotations (@[ ]@) and splices (@$( ... )@) 30 31  $infix 30 32 Dec(..), Exp(..), Con(..), Type(..), TyVarBndr(..), Kind(..), Cxt, 31 33 Pred(..), Match(..), Clause(..), Body(..), Guard(..), Stmt(..), 32 34 Range(..), Lit(..), Pat(..), FieldExp, FieldPat, … … module Language.Haskell.TH( 46 48 intPrimL, wordPrimL, floatPrimL, doublePrimL, integerL, rationalL, 47 49 charL, stringL, stringPrimL, 48 50  *** Patterns 49 litP, varP, tupP, conP, infixP, tildeP, bangP, asP, wildP, recP, 51 litP, varP, tupP, conP, unresolvedInfixP, parensP, infixP, 52 tildeP, bangP, asP, wildP, recP, 50 53 listP, sigP, viewP, 51 54 fieldPat, 52 55 … … module Language.Haskell.TH( 54 57 normalB, guardedB, normalG, normalGE, patG, patGE, match, clause, 55 58 56 59  *** Expressions 57 dyn, global, varE, conE, litE, appE, infixE, infixApp, sectionL, sectionR, 60 dyn, global, varE, conE, litE, appE, unresolvedInfixE, parensE, 61 infixE, infixApp, sectionL, sectionR, 58 62 lamE, lam1E, tupE, condE, letE, caseE, appsE, 59 63 listE, sigE, recConE, recUpdE, stringE, fieldExp, 60 64  **** Ranges … … import Language.Haskell.TH.Syntax 99 103 import Language.Haskell.TH.Lib 100 104 import Language.Haskell.TH.Ppr 101 105 106  107  108  Note about infix expressions/patterns 109  110  111 112 { $infix #infix# 113 Note [Unresolved infix] 114 115 When implementing antiquotation for quasiquoters, one often wants 116 to parse strings into expressions: 117 118 > parse :: String > Maybe 'Exp' 119 120 But how should we parse @a + b * c@? If we don't know the fixities 121 of @+@ and @*@, we don't know whether to parse it as @a + (b * c)@ or @(a + b) * c@. 122 123 In cases like this, use 'UnresolvedInfixE' or 'UnresolvedInfixP'. When the compiler 124 is given a splice containing a tree of @UnresolvedInfixE@ applications such as 125 126 > UnresolvedInfixE 127 > (UnresolvedInfixE e1 op1 e2) 128 > op2 129 > (UnresolvedInfixE e3 op3 e4) 130 131 it will look up and the fixities of the relevant operators and 132 reassociate the tree as necessary. 133 134 * trees will not be reassociated across 'ParensE' or 'ParensP', 135 which are of use for parsing expressions like 136 137 > (a + b * c) + d * e 138 139 * 'InfixE' and 'InfixP' expressions are never reassociated, with 140 one exception described in the following point. 141 142 * The 'UnresolvedInfixE' constructor doesn't support sections. Sections 143 such as @(a *)@ have no ambiguity, so 'InfixE' suffices. For longer 144 sections such as @(a + b * c )@, use an 'InfixE' constructor for the 145 outermost section, and use 'UnresolvedInfixE' constructors for all 146 other operators: 147 148 > InfixE 149 > Just (UnresolvedInfixE ...a + b * c...) 150 > op 151 > Nothing 152 153 This special handling for sections is the exception to the previous point. 154 155 * Quoted expressions such as 156 157 > [ a * b + c ] :: Q Exp 158 > [p a : b : c ] :: Q Pat 159 160 will never contain 'UnresolvedInfixE', 'UnresolvedInfixP', 'ParensE', or 'ParensP' 161 constructors. 162 163 } 
Language/Haskell/TH/Lib.hs
diff git a/Language/Haskell/TH/Lib.hs b/Language/Haskell/TH/Lib.hs index 894bb33..5bbe9c0 100644
a b infixP :: PatQ > Name > PatQ > PatQ 73 73 infixP p1 n p2 = do p1' < p1 74 74 p2' < p2 75 75 return (InfixP p1' n p2') 76 unresolvedInfixP :: PatQ > Name > PatQ > PatQ 77 unresolvedInfixP p1 n p2 = do p1' < p1 78 p2' < p2 79 return (UnresolvedInfixP p1' n p2') 80 parensP :: PatQ > PatQ 81 parensP p = do p' < p 82 return (ParensP p') 83 76 84 tildeP :: PatQ > PatQ 77 85 tildeP p = do p' < p 78 86 return (TildeP p') … … litE c = return (LitE c) 200 208 appE :: ExpQ > ExpQ > ExpQ 201 209 appE x y = do { a < x; b < y; return (AppE a b)} 202 210 211 parensE :: ExpQ > ExpQ 212 parensE x = do { x' < x; return (ParensE x') } 213 214 unresolvedInfixE :: ExpQ > ExpQ > ExpQ > ExpQ 215 unresolvedInfixE x s y = do { x' < x; s' < s; y' < y; 216 return (UnresolvedInfixE x' s' y') } 217 203 218 infixE :: Maybe ExpQ > ExpQ > Maybe ExpQ > ExpQ 204 219 infixE (Just x) s (Just y) = do { a < x; s' < s; b < y; 205 220 return (InfixE (Just a) s' (Just b))} 
Language/Haskell/TH/Ppr.hs
diff git a/Language/Haskell/TH/Ppr.hs b/Language/Haskell/TH/Ppr.hs index 6c324f0..a0fb6be 100644
a b nestDepth :: Int 16 16 nestDepth = 4 17 17 18 18 type Precedence = Int 19 appPrec, opPrec, noPrec :: Precedence 20 appPrec = 2  Argument of a function application 21 opPrec = 1  Argument of an infix operator 19 appPrec, unopPrec, opPrec, noPrec :: Precedence 20 appPrec = 3  Argument of a function application 21 opPrec = 2  Argument of an infix operator 22 unopPrec = 1  Argument of an unresolved infix operator 22 23 noPrec = 0  Others 23 24 24 25 parensIf :: Bool > Doc > Doc … … pprExp _ (ConE c) = pprName' Applied c 98 99 pprExp i (LitE l) = pprLit i l 99 100 pprExp i (AppE e1 e2) = parensIf (i >= appPrec) $ pprExp opPrec e1 100 101 <+> pprExp appPrec e2 102 pprExp _ (ParensE e) = parens (pprExp noPrec e) 103 pprExp i (UnresolvedInfixE e1 op e2) 104 = parensIf (i > unopPrec) $ pprExp unopPrec e1 105 <+> pprInfixExp op 106 <+> pprExp unopPrec e2 101 107 pprExp i (InfixE (Just e1) op (Just e2)) 102 108 = parensIf (i >= opPrec) $ pprExp opPrec e1 103 109 <+> pprInfixExp op … … pprPat _ (TupP ps) = parens $ sep $ punctuate comma $ map ppr ps 194 200 pprPat _ (UnboxedTupP ps) = hashParens $ sep $ punctuate comma $ map ppr ps 195 201 pprPat i (ConP s ps) = parensIf (i >= appPrec) $ pprName' Applied s 196 202 <+> sep (map (pprPat appPrec) ps) 203 pprPat _ (ParensP p) = parens $ pprPat noPrec p 204 pprPat i (UnresolvedInfixP p1 n p2) 205 = parensIf (i > unopPrec) (pprPat unopPrec p1 <+> 206 pprName' Infix n <+> 207 pprPat unopPrec p2) 197 208 pprPat i (InfixP p1 n p2) 198 209 = parensIf (i >= opPrec) (pprPat opPrec p1 <+> 199 210 pprName' Infix n <+> 
Language/Haskell/TH/Syntax.hs
diff git a/Language/Haskell/TH/Syntax.hs b/Language/Haskell/TH/Syntax.hs index 2360f55..ec56c7c 100644
a b data Pat 715 715  UnboxedTupP [Pat]  ^ @{ (# p1,p2 #) }@ 716 716  ConP Name [Pat]  ^ @data T1 = C1 t1 t2; {C1 p1 p1} = e@ 717 717  InfixP Pat Name Pat  ^ @foo ({x :+ y}) = e@ 718  UnresolvedInfixP Pat Name Pat  ^ @foo ({x :+ y}) = e@ 719  720  See "Language.Haskell.TH#infix" 721  ParensP Pat  ^ @{(p)}@ 722  723  See "Language.Haskell.TH#infix" 718 724  TildeP Pat  ^ @{ ~p }@ 719 725  BangP Pat  ^ @{ !p }@ 720 726  AsP Name Pat  ^ @{ x \@ p }@ … … data Exp 756 762  Maybe there should be a varorcon type? 757 763  Or maybe we should leave it to the String itself? 758 764 765  UnresolvedInfixE Exp Exp Exp  ^ @{x + y}@ 766  767  See "Language.Haskell.TH#infix" 768  ParensE Exp  ^ @{ (e) }@ 769  770  See "Language.Haskell.TH#infix" 759 771  LamE [Pat] Exp  ^ @{ \ p1 p2 > e }@ 760 772  TupE [Exp]  ^ @{ (e1,e2) } @ 761 773  UnboxedTupE [Exp]  ^ @{ (# e1,e2 #) } @