template-haskell 2.6.0.0 → 2.7.0.0
raw patch · 7 files changed
+210/−79 lines, 7 filesdep ~base
Dependency ranges changed: base
Files
- Language/Haskell/TH.hs +8/−7
- Language/Haskell/TH/Lib.hs +17/−1
- Language/Haskell/TH/Ppr.hs +19/−15
- Language/Haskell/TH/PprLib.hs +3/−3
- Language/Haskell/TH/Quote.hs +18/−11
- Language/Haskell/TH/Syntax.hs +144/−41
- template-haskell.cabal +1/−1
Language/Haskell/TH.hs view
@@ -12,11 +12,11 @@ reify, -- :: Name -> Q Info location, -- :: Q Location runIO, -- :: IO a -> Q a- isClassInstance,- classInstances,+ lookupTypeName, lookupValueName,+ isInstance, reifyInstances, -- * Names- Name, + Name, NameSpace, -- Abstract mkName, -- :: String -> Name newName, -- :: String -> Q Name nameBase, -- :: Name -> String@@ -31,8 +31,7 @@ Pred(..), Match(..), Clause(..), Body(..), Guard(..), Stmt(..), Range(..), Lit(..), Pat(..), FieldExp, FieldPat, Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..),- InlineSpec(..), FunDep(..), FamFlavour(..), Info(..),- ClassInstance(..), Loc(..),+ InlineSpec(..), FunDep(..), FamFlavour(..), Info(..), Loc(..), Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence, -- * Library functions@@ -46,7 +45,8 @@ 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 +54,8 @@ 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
Language/Haskell/TH/Lib.hs view
@@ -73,6 +73,14 @@ 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 @@ 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))}@@ -457,9 +472,10 @@ t' <- t return $ SigT t' k -isStrict, notStrict :: Q Strict+isStrict, notStrict, unpacked :: Q Strict isStrict = return $ IsStrict notStrict = return $ NotStrict+unpacked = return Unpacked strictType :: Q Strict -> TypeQ -> StrictTypeQ strictType = liftM2 (,)
Language/Haskell/TH/Ppr.hs view
@@ -6,7 +6,7 @@ -- be "public" functions. The main module TH -- re-exports them all. -import Text.PrettyPrint.HughesPJ (render)+import Text.PrettyPrint (render) import Language.Haskell.TH.PprLib import Language.Haskell.TH.Syntax import Data.Char ( toLower )@@ -16,9 +16,10 @@ 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@@ -44,8 +45,9 @@ ------------------------------ instance Ppr Info where- ppr (ClassI d is) = ppr d $$ vcat (map ppr is)- ppr (TyConI d) = ppr d+ ppr (TyConI d) = ppr d+ ppr (ClassI d is) = ppr d $$ vcat (map ppr is)+ ppr (FamilyI d is) = ppr d $$ vcat (map ppr is) ppr (PrimTyConI name arity is_unlifted) = text "Primitive" <+> (if is_unlifted then text "unlifted" else empty)@@ -63,15 +65,6 @@ = vcat [ppr_sig v ty, pprFixity v fix, case mb_d of { Nothing -> empty; Just d -> ppr d }] -instance Ppr ClassInstance where- ppr (ClassInstance { ci_dfun = _dfun,- ci_tvs = _tvs,- ci_cxt = cxt,- ci_cls = cls,- ci_tys = tys })- = text "instance" <+> pprCxt cxt - <+> ppr cls <+> sep (map pprParendType tys)- ppr_sig :: Name -> Type -> Doc ppr_sig v ty = ppr v <+> text "::" <+> ppr ty @@ -98,6 +91,11 @@ 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 +192,11 @@ 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 <+>@@ -374,6 +377,7 @@ -- Prints with parens if not already atomic pprStrictType (IsStrict, t) = char '!' <> pprParendType t pprStrictType (NotStrict, t) = pprParendType t+pprStrictType (Unpacked, t) = text "{-# UNPACK #-} !" <> pprParendType t ------------------------------ pprParendType :: Type -> Doc
Language/Haskell/TH/PprLib.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} --- | Monadic front-end to Text.PrettyPrint.HughesPJ+-- | Monadic front-end to Text.PrettyPrint module Language.Haskell.TH.PprLib ( @@ -37,7 +37,7 @@ import Language.Haskell.TH.Syntax (Name(..), showName', NameFlavour(..), NameIs(..))-import qualified Text.PrettyPrint.HughesPJ as HPJ+import qualified Text.PrettyPrint as HPJ import Control.Monad (liftM, liftM2) import Data.Map ( Map ) import qualified Data.Map as Map ( lookup, insert, empty )@@ -208,7 +208,7 @@ d2' <- d2 return (HPJ.hang d1' n d2') --- punctuate uses the same definition as Text.PrettyPrint.HughesPJ+-- punctuate uses the same definition as Text.PrettyPrint punctuate _ [] = [] punctuate p (d:ds) = go d ds where
Language/Haskell/TH/Quote.hs view
@@ -25,8 +25,24 @@ case antiQ t of Nothing -> case constrRep constr of- AlgConstr _ ->- appCon con conArgs+ AlgConstr _ ->+ appCon (mkCon conName) conArgs+ where+ conName :: Name+ conName =+ case showConstr constr of+ "(:)" -> Name (mkOccName ":") NameS+ con@"[]" -> Name (mkOccName con) NameS+ con@('(':_) -> Name (mkOccName con) NameS+ con -> mkNameG_d (tyConPackage tycon)+ (tyConModule tycon)+ con+ where+ tycon :: TyCon+ tycon = (typeRepTyCon . typeOf) t++ conArgs :: [Q q]+ conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t IntConstr n -> mkLit $ integerL n FloatConstr n ->@@ -36,15 +52,6 @@ where constr :: Constr constr = toConstr t- constrName :: Constr -> String- constrName k =- case showConstr k of- "(:)" -> ":"- name -> name- con :: k- con = mkCon (mkName (constrName constr))- conArgs :: [Q q]- conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t Just y -> y
Language/Haskell/TH/Syntax.hs view
@@ -24,18 +24,20 @@ Quasi(..), Lift(..), liftString, Q, runQ, - report, recover, reify,- location, runIO,- isClassInstance, classInstances,+ report, recover, reify, + lookupTypeName, lookupValueName,+ location, runIO, addDependentFile,+ isInstance, reifyInstances, -- * Names Name(..), mkName, newName, nameBase, nameModule, 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(..),+ Range(..), Lit(..), Pat(..), FieldExp, FieldPat, Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..), InlineSpec(..), StrictType, VarStrictType, FunDep(..), FamFlavour(..), Info(..), Loc(..), CharPos,@@ -57,6 +59,7 @@ import Language.Haskell.TH.Syntax.Internals import Data.Data (Data(..), Typeable, mkConstr, mkDataType, constrIndex) import qualified Data.Data as Data+import Control.Applicative( Applicative(..) ) import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) import Control.Monad (liftM)@@ -69,7 +72,7 @@ -- ----------------------------------------------------- -class (Monad m, Functor m) => Quasi m where+class (Monad m, Applicative m) => Quasi m where qNewName :: String -> m Name -- ^ Fresh names @@ -81,16 +84,21 @@ -> m a -- ^ Recover from the monadic 'fail' -- Inspect the type-checker's environment- qReify :: Name -> m Info- qClassInstances :: Name -> [Type] -> m [ClassInstance]- -- Is (cls tys) an instance?- -- Returns list of matching witnesses+ qLookupName :: Bool -> String -> m (Maybe Name)+ -- True <=> type namespace, False <=> value namespace+ qReify :: Name -> m Info+ qReifyInstances :: Name -> [Type] -> m [Dec]+ -- Is (n tys) an instance?+ -- Returns list of matching instance Decs + -- (with empty sub-Decs)+ -- Works for classes and type functions qLocation :: m Loc qRunIO :: IO a -> m a -- ^ Input/output (dangerous) + qAddDependentFile :: FilePath -> m () ----------------------------------------------------- -- The IO instance of Quasi@@ -111,10 +119,12 @@ qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg) qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg) + qLookupName _ _ = badIO "lookupName" qReify _ = badIO "reify"- qClassInstances _ _ = badIO "classInstances"+ qReifyInstances _ _ = badIO "classInstances" qLocation = badIO "currentLocation" qRecover _ _ = badIO "recover" -- Maybe we could fix this?+ qAddDependentFile _ = badIO "addDependentFile" qRunIO m = m @@ -148,6 +158,10 @@ instance Functor Q where fmap f (Q x) = Q (fmap f x) +instance Applicative Q where + pure x = Q (pure x) + Q f <*> Q x = Q (f <*> x) + ---------------------------------------------------- -- Packaged versions for the programmer, hiding the Quasi-ness newName :: String -> Q Name@@ -161,17 +175,26 @@ -> Q a recover (Q r) (Q m) = Q (qRecover r m) +-- We don't export lookupName; the Bool isn't a great API+-- Instead we export lookupTypeName, lookupValueName+lookupName :: Bool -> String -> Q (Maybe Name)+lookupName ns s = Q (qLookupName ns s)++lookupTypeName, lookupValueName :: String -> Q (Maybe Name)+lookupTypeName s = Q (qLookupName True s)+lookupValueName s = Q (qLookupName False s)+ -- | 'reify' looks up information about the 'Name' reify :: Name -> Q Info reify v = Q (qReify v) -- | 'classInstances' looks up instaces of a class-classInstances :: Name -> [Type] -> Q [ClassInstance]-classInstances cls tys = Q (qClassInstances cls tys)+reifyInstances :: Name -> [Type] -> Q [Dec]+reifyInstances cls tys = Q (qReifyInstances cls tys) -isClassInstance :: Name -> [Type] -> Q Bool-isClassInstance cls tys = do { dfuns <- classInstances cls tys- ; return (not (null dfuns)) }+isInstance :: Name -> [Type] -> Q Bool+isInstance nm tys = do { decs <- reifyInstances nm tys+ ; return (not (null decs)) } -- | 'location' gives you the 'Location' at which this -- computation is spliced.@@ -188,14 +211,23 @@ runIO :: IO a -> Q a runIO m = Q (qRunIO m) +-- | Record external files that runIO is using (dependent upon).+-- The compiler can then recognize that it should re-compile the file using this TH when the external file changes.+-- Note that ghc -M will still not know about these dependencies - it does not execute TH.+-- Expects an absolute file path.+addDependentFile :: FilePath -> Q ()+addDependentFile fp = Q (qAddDependentFile fp)+ instance Quasi Q where- qNewName = newName- qReport = report- qRecover = recover - qReify = reify- qClassInstances = classInstances- qLocation = location- qRunIO = runIO+ qNewName = newName+ qReport = report+ qRecover = recover + qReify = reify+ qReifyInstances = reifyInstances+ qLookupName = lookupName+ qLocation = location+ qRunIO = runIO+ qAddDependentFile = addDependentFile ----------------------------------------------------@@ -360,16 +392,12 @@ data NameFlavour = NameS -- ^ An unqualified name; dynamically bound | NameQ ModName -- ^ A qualified name; dynamically bound- | NameU Int# -- ^ A unique local name-- | NameL Int# -- ^ Local name bound outside of the TH AST | NameG NameSpace PkgName ModName -- ^ Global name bound outside of the TH AST: -- An original name (occurrences only, not binders)- --- -- Need the namespace too to be sure which - -- thing we are naming+ -- Need the namespace too to be sure which + -- thing we are naming deriving ( Typeable ) -- |@@ -576,7 +604,6 @@ = Name occ (NameG space (mkPkgName "ghc-prim") tup_mod) where occ = mkOccName ('(' : replicate n_commas ',' ++ ")")- -- XXX Should it be GHC.Unit for 0 commas? tup_mod = mkModName "GHC.Tuple" -- Unboxed tuple data and type constructors@@ -626,7 +653,7 @@ -- and a list of its instances ClassI Dec -- Declaration of the class- [ClassInstance] -- The instances of that class+ [InstanceDec] -- The instances of that class | ClassOpI Name -- The class op itself@@ -634,8 +661,13 @@ Name -- Name of the parent class Fixity - | TyConI Dec+ | TyConI + Dec + | FamilyI -- Type/data families+ Dec+ [InstanceDec]+ | PrimTyConI -- Ones that can't be expressed with a data type -- decl, such as (->), Int# Name @@ -661,15 +693,12 @@ Type -- What it is bound to deriving( Show, Data, Typeable ) --- | 'ClassInstance' desribes a single instance of a class-data ClassInstance - = ClassInstance {- ci_dfun :: Name, -- The witness- ci_tvs :: [TyVarBndr], - ci_cxt :: Cxt,- ci_cls :: Name, - ci_tys :: [Type]- } deriving( Show, Data, Typeable )+-- | 'InstanceDec' desribes a single instance of a class or type function+-- It is just a 'Dec', but guaranteed to be one of the following:+-- InstanceD (with empty [Dec])+-- DataInstD or NewtypeInstD (with empty derived [Name])+-- TySynInstD+type InstanceDec = Dec data Fixity = Fixity Int FixityDirection deriving( Eq, Show, Data, Typeable )@@ -689,6 +718,68 @@ -- ----------------------------------------------------- +{- $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 +806,12 @@ | 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 +853,12 @@ -- 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 #) } @@@ -862,7 +965,7 @@ | EqualP Type Type -- ^ @F a ~ Bool@ deriving( Show, Eq, Data, Typeable ) -data Strict = IsStrict | NotStrict+data Strict = IsStrict | NotStrict | Unpacked deriving( Show, Eq, Data, Typeable ) data Con = NormalC Name [StrictType] -- ^ @C Int a@
template-haskell.cabal view
@@ -1,5 +1,5 @@ name: template-haskell-version: 2.6.0.0+version: 2.7.0.0 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org