Add support for unresolved infix expressions and patterns.
authorReiner Pope <reiner.pope@gmail.com>
Sat, 23 Jul 2011 06:13:17 +0000 (16:13 +1000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Mon, 25 Jul 2011 13:18:26 +0000 (14:18 +0100)
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 c2bc267..1f4bc5e 100644 (file)
@@ -46,7 +46,8 @@ module Language.Haskell.TH(
        intPrimL, wordPrimL, floatPrimL, doublePrimL, integerL, rationalL,
        charL, stringL, stringPrimL,
     -- *** Patterns
-       litP, varP, tupP, conP, infixP, tildeP, bangP, asP, wildP, recP,
+       litP, varP, tupP, conP, uInfixP, parensP, infixP,
+       tildeP, bangP, asP, wildP, recP,
        listP, sigP, viewP,
        fieldPat,
 
@@ -54,7 +55,8 @@ module Language.Haskell.TH(
        normalB, guardedB, normalG, normalGE, patG, patGE, match, clause, 
 
     -- *** Expressions
-       dyn, global, varE, conE, litE, appE, infixE, infixApp, sectionL, sectionR, 
+       dyn, global, varE, conE, litE, appE, uInfixE, parensE,
+       infixE, infixApp, sectionL, sectionR, 
        lamE, lam1E, tupE, condE, letE, caseE, appsE,
        listE, sigE, recConE, recUpdE, stringE, fieldExp,
     -- **** Ranges
index 8bcf671..92f3dd4 100644 (file)
@@ -73,6 +73,14 @@ infixP :: PatQ -> Name -> PatQ -> PatQ
 infixP p1 n p2 = do p1' <- p1
                     p2' <- p2
                     return (InfixP p1' n p2')
+uInfixP :: PatQ -> Name -> PatQ -> PatQ
+uInfixP p1 n p2 = do p1' <- p1
+                     p2' <- p2
+                     return (UInfixP p1' n p2')
+parensP :: PatQ -> PatQ
+parensP p = do p' <- p
+               return (ParensP p')
+
 tildeP :: PatQ -> PatQ
 tildeP p = do p' <- p
               return (TildeP p')
@@ -200,6 +208,13 @@ litE c = return (LitE c)
 appE :: ExpQ -> ExpQ -> ExpQ
 appE x y = do { a <- x; b <- y; return (AppE a b)}
 
+parensE :: ExpQ -> ExpQ
+parensE x = do { x' <- x; return (ParensE x') }
+
+uInfixE :: ExpQ -> ExpQ -> ExpQ -> ExpQ
+uInfixE x s y = do { x' <- x; s' <- s; y' <- y;
+                     return (UInfixE x' s' y') }
+
 infixE :: Maybe ExpQ -> ExpQ -> Maybe ExpQ -> ExpQ
 infixE (Just x) s (Just y) = do { a <- x; s' <- s; b <- y;
                                   return (InfixE (Just a) s' (Just b))}
index dc43f4b..dccb53b 100644 (file)
@@ -16,9 +16,10 @@ nestDepth :: Int
 nestDepth = 4
 
 type Precedence = Int
-appPrec, opPrec, noPrec :: Precedence
-appPrec = 2    -- Argument of a function application
-opPrec  = 1    -- Argument of an infix operator
+appPrec, unopPrec, opPrec, noPrec :: Precedence
+appPrec = 3    -- Argument of a function application
+opPrec  = 2    -- Argument of an infix operator
+unopPrec = 1   -- Argument of an unresolved infix operator
 noPrec  = 0    -- Others
 
 parensIf :: Bool -> Doc -> Doc
@@ -98,6 +99,11 @@ pprExp _ (ConE c)     = pprName' Applied c
 pprExp i (LitE l)     = pprLit i l
 pprExp i (AppE e1 e2) = parensIf (i >= appPrec) $ pprExp opPrec e1
                                               <+> pprExp appPrec e2
+pprExp _ (ParensE e)  = parens (pprExp noPrec e)
+pprExp i (UInfixE e1 op e2)
+ = parensIf (i > unopPrec) $ pprExp unopPrec e1
+                         <+> pprInfixExp op
+                         <+> pprExp unopPrec e2
 pprExp i (InfixE (Just e1) op (Just e2))
  = parensIf (i >= opPrec) $ pprExp opPrec e1
                         <+> pprInfixExp op
@@ -194,6 +200,11 @@ pprPat _ (TupP ps)    = parens $ sep $ punctuate comma $ map ppr ps
 pprPat _ (UnboxedTupP ps) = hashParens $ sep $ punctuate comma $ map ppr ps
 pprPat i (ConP s ps)  = parensIf (i >= appPrec) $ pprName' Applied s
                                               <+> sep (map (pprPat appPrec) ps)
+pprPat _ (ParensP p)  = parens $ pprPat noPrec p
+pprPat i (UInfixP p1 n p2)
+                      = parensIf (i > unopPrec) (pprPat unopPrec p1 <+>
+                                                 pprName' Infix n   <+>
+                                                 pprPat unopPrec p2)
 pprPat i (InfixP p1 n p2)
                       = parensIf (i >= opPrec) (pprPat opPrec p1 <+>
                                                 pprName' Infix n <+>
index 5ee5cd1..c777b89 100644 (file)
@@ -33,6 +33,7 @@ module Language.Haskell.TH.Syntax(
         showName, showName', NameIs(..),
 
        -- * The algebraic data types
+       -- $infix
        Dec(..), Exp(..), Con(..), Type(..), TyVarBndr(..), Kind(..),Cxt,
        Pred(..), Match(..),  Clause(..), Body(..), Guard(..), Stmt(..),
        Range(..), Lit(..), Pat(..), FieldExp, FieldPat, ClassInstance(..),
@@ -689,6 +690,68 @@ defaultFixity = Fixity maxPrecedence InfixL
 --
 -----------------------------------------------------
 
+{- $infix #infix#
+Note [Unresolved infix]
+~~~~~~~~~~~~~~~~~~~~~~~
+
+When implementing antiquotation for quasiquoters, one often wants
+to parse strings into expressions:
+
+> parse :: String -> Maybe 'Exp'
+
+But how should we parse @a + b * c@? If we don't know the fixities of
+@+@ and @*@, we don't know whether to parse it as @a + (b * c)@ or @(a
++ b) * c@.
+
+In cases like this, use 'UInfixE' or 'UInfixP', which stand for
+\"unresolved infix expression\" and \"unresolved infix pattern\". When
+the compiler is given a splice containing a tree of @UInfixE@
+applications such as
+
+> UInfixE
+>   (UInfixE e1 op1 e2)
+>   op2
+>   (UInfixE e3 op3 e4)
+
+it will look up and the fixities of the relevant operators and
+reassociate the tree as necessary.
+
+  * trees will not be reassociated across 'ParensE' or 'ParensP',
+    which are of use for parsing expressions like
+
+    > (a + b * c) + d * e
+
+  * 'InfixE' and 'InfixP' expressions are never reassociated.
+
+  * The 'UInfixE' constructor doesn't support sections. Sections
+    such as @(a *)@ have no ambiguity, so 'InfixE' suffices. For longer
+    sections such as @(a + b * c -)@, use an 'InfixE' constructor for the
+    outer-most section, and use 'UInfixE' constructors for all
+    other operators:
+
+    > InfixE
+    >   Just (UInfixE ...a + b * c...)
+    >   op
+    >   Nothing
+
+    Sections such as @(a + b +)@ and @((a + b) +)@ should be rendered
+    into 'Exp's differently:
+
+    > (+ a + b)   ---> InfixE Nothing + (Just $ UInfixE a + b)
+    >                    -- will result in a fixity error if (+) is left-infix
+    > (+ (a + b)) ---> InfixE Nothing + (Just $ ParensE $ UInfixE a + b)
+    >                    -- no fixity errors
+
+  * Quoted expressions such as
+
+    > [| a * b + c |] :: Q Exp
+    > [p| a : b : c |] :: Q Pat
+
+    will never contain 'UInfixE', 'UInfixP', 'ParensE', or 'ParensP'
+    constructors.
+
+-}
+
 data Lit = CharL Char 
          | StringL String 
          | IntegerL Integer     -- ^ Used for overloaded and non-overloaded
@@ -715,6 +778,12 @@ data Pat
   | UnboxedTupP [Pat]             -- ^ @{ (# p1,p2 #) }@
   | ConP Name [Pat]               -- ^ @data T1 = C1 t1 t2; {C1 p1 p1} = e@
   | InfixP Pat Name Pat           -- ^ @foo ({x :+ y}) = e@
+  | UInfixP Pat Name Pat          -- ^ @foo ({x :+ y}) = e@
+                                  --
+                                  -- See Note [Unresolved infix] at "Language.Haskell.TH.Syntax#infix"
+  | ParensP Pat                   -- ^ @{(p)}@
+                                  --
+                                  -- See Note [Unresolved infix] at "Language.Haskell.TH.Syntax#infix"
   | TildeP Pat                    -- ^ @{ ~p }@
   | BangP Pat                     -- ^ @{ !p }@
   | AsP Name Pat                  -- ^ @{ x \@ p }@
@@ -756,6 +825,12 @@ data Exp
     -- Maybe there should be a var-or-con type?
     -- Or maybe we should leave it to the String itself?
 
+  | UInfixE Exp Exp Exp                -- ^ @{x + y}@
+                                       --
+                                       -- See Note [Unresolved infix] at "Language.Haskell.TH.Syntax#infix"
+  | ParensE Exp                        -- ^ @{ (e) }@
+                                       --
+                                       -- See Note [Unresolved infix] at "Language.Haskell.TH.Syntax#infix"
   | LamE [Pat] Exp                     -- ^ @{ \ p1 p2 -> e }@
   | TupE [Exp]                         -- ^ @{ (e1,e2) }  @
   | UnboxedTupE [Exp]                  -- ^ @{ (# e1,e2 #) }  @