template-haskell 2.7.0.0 → 2.8.0.0
raw patch · 8 files changed
+690/−264 lines, 8 filesdep ~basedep ~containers
Dependency ranges changed: base, containers
Files
- Language/Haskell/TH.hs +57/−25
- Language/Haskell/TH/Lib.hs +96/−27
- Language/Haskell/TH/Ppr.hs +100/−50
- Language/Haskell/TH/PprLib.hs +3/−1
- Language/Haskell/TH/Quote.hs +3/−3
- Language/Haskell/TH/Syntax.hs +430/−127
- Language/Haskell/TH/Syntax/Internals.hs +0/−29
- template-haskell.cabal +1/−2
Language/Haskell/TH.hs view
@@ -6,39 +6,66 @@ -} module Language.Haskell.TH( -- * The monad and its operations- Q, runQ, - report, -- :: Bool -> String -> Q ()+ Q,+ runQ,+ -- ** Administration: errors, locations and IO+ reportError, -- :: String -> Q ()+ reportWarning, -- :: String -> Q ()+ report, -- :: Bool -> String -> Q () recover, -- :: Q a -> Q a -> Q a- reify, -- :: Name -> Q Info- location, -- :: Q Location+ location, -- :: Q Loc+ Loc(..), runIO, -- :: IO a -> Q a- lookupTypeName, lookupValueName,- isInstance, reifyInstances,+ -- ** Querying the compiler+ -- *** Reify+ reify, -- :: Name -> Q Info+ Info(..),+ InstanceDec,+ ParentName,+ Arity,+ Unlifted,+ -- *** Name lookup+ lookupTypeName, -- :: String -> Q (Maybe Name)+ lookupValueName, -- :: String -> Q (Maybe Name)+ -- *** Instance lookup+ reifyInstances,+ isInstance, -- * Names Name, NameSpace, -- Abstract+ -- ** Constructing names mkName, -- :: String -> Name newName, -- :: String -> Q Name+ -- ** Deconstructing names nameBase, -- :: Name -> String nameModule, -- :: Name -> Maybe String+ -- ** Built-in names tupleTypeName, tupleDataName, -- Int -> Name- + unboxedTupleTypeName, unboxedTupleDataName, -- :: Int -> Name+ -- * The algebraic data types -- | The lowercase versions (/syntax operators/) of these constructors are -- preferred to these constructors, since they compose better with -- quotations (@[| |]@) and splices (@$( ... )@)- Dec(..), Exp(..), Con(..), Type(..), TyVarBndr(..), Kind(..), Cxt,- Pred(..), Match(..), Clause(..), Body(..), Guard(..), Stmt(..),- Range(..), Lit(..), Pat(..), FieldExp, FieldPat, ++ -- ** Declarations+ Dec(..), Con(..), Clause(..), Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..),- InlineSpec(..), FunDep(..), FamFlavour(..), Info(..), Loc(..),+ Inline(..), RuleMatch(..), Phases(..), RuleBndr(..),+ FunDep(..), FamFlavour(..), Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,+ -- ** Expressions+ Exp(..), Match(..), Body(..), Guard(..), Stmt(..), Range(..), Lit(..),+ -- ** Patterns+ Pat(..), FieldExp, FieldPat,+ -- ** Types+ Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred(..), -- * Library functions -- ** Abbreviations- InfoQ, ExpQ, DecQ, DecsQ, ConQ, TypeQ, CxtQ, PredQ, MatchQ, ClauseQ, BodyQ,- GuardQ, StmtQ, RangeQ, StrictTypeQ, VarStrictTypeQ, PatQ, FieldPatQ,- InlineSpecQ,+ InfoQ, ExpQ, DecQ, DecsQ, ConQ, TypeQ, TyLitQ, CxtQ, PredQ, MatchQ, ClauseQ,+ BodyQ, GuardQ, StmtQ, RangeQ, StrictTypeQ, VarStrictTypeQ, PatQ, FieldPatQ,+ RuleBndrQ, -- ** Constructors lifted to 'Q' -- *** Literals@@ -51,30 +78,36 @@ fieldPat, -- *** Pattern Guards- normalB, guardedB, normalG, normalGE, patG, patGE, match, clause, + normalB, guardedB, normalG, normalGE, patG, patGE, match, clause, -- *** Expressions dyn, global, varE, conE, litE, appE, uInfixE, parensE,- infixE, infixApp, sectionL, sectionR, - lamE, lam1E, tupE, condE, letE, caseE, appsE,+ infixE, infixApp, sectionL, sectionR,+ lamE, lam1E, lamCaseE, tupE, condE, multiIfE, letE, caseE, appsE, listE, sigE, recConE, recUpdE, stringE, fieldExp, -- **** Ranges fromE, fromThenE, fromToE, fromThenToE, -- ***** Ranges with more indirection arithSeqE,- fromR, fromThenR, fromToR, fromThenToR, + fromR, fromThenR, fromToR, fromThenToR, -- **** Statements doE, compE, bindS, letS, noBindS, parS, -- *** Types- forallT, varT, conT, appT, arrowT, listT, tupleT, sigT,+ forallT, varT, conT, appT, arrowT, listT, tupleT, sigT, litT,+ promotedT, promotedTupleT, promotedNilT, promotedConsT,+ -- **** Type literals+ numTyLit, strTyLit, -- **** Strictness isStrict, notStrict, strictType, varStrictType, -- **** Class Contexts- cxt, classP, equalP, normalC, recC, infixC,+ cxt, classP, equalP, normalC, recC, infixC, forallC, + -- *** Kinds+ varK, conK, tupleK, arrowK, listK, appK, starK, constraintK,+ -- *** Top Level Declarations -- **** Data valD, funD, tySynD, dataD, newtypeD,@@ -82,18 +115,17 @@ classD, instanceD, sigD, -- **** Type Family / Data Family familyNoKindD, familyKindD, dataInstD,- newtypeInstD, tySynInstD, + newtypeInstD, tySynInstD, typeFam, dataFam, -- **** Foreign Function Interface (FFI) cCall, stdCall, unsafe, safe, forImpD, -- **** Pragmas- -- | Just inline supported so far- inlineSpecNoPhase, inlineSpecPhase,- pragInlD, pragSpecD,+ ruleVar, typedRuleVar,+ pragInlD, pragSpecD, pragSpecInlD, pragSpecInstD, pragRuleD, -- * Pretty-printer Ppr(..), pprint, pprExp, pprLit, pprPat, pprParendType- + ) where import Language.Haskell.TH.Syntax
Language/Haskell/TH/Lib.hs view
@@ -9,6 +9,7 @@ import Language.Haskell.TH.Syntax import Control.Monad( liftM, liftM2 )+import Data.Word( Word8 ) ---------------------------------------------------------- -- * Type synonyms@@ -22,6 +23,7 @@ type DecsQ = Q [Dec] type ConQ = Q Con type TypeQ = Q Type+type TyLitQ = Q TyLit type CxtQ = Q Cxt type PredQ = Q Pred type MatchQ = Q Match@@ -33,7 +35,7 @@ type StrictTypeQ = Q StrictType type VarStrictTypeQ = Q VarStrictType type FieldExpQ = Q FieldExp-type InlineSpecQ = Q InlineSpec+type RuleBndrQ = Q RuleBndr ---------------------------------------------------------- -- * Lowercase pattern syntax functions@@ -53,7 +55,7 @@ charL = CharL stringL :: String -> Lit stringL = StringL-stringPrimL :: String -> Lit+stringPrimL :: [Word8] -> Lit stringPrimL = StringPrimL rationalL :: Rational -> Lit rationalL = RationalL@@ -240,6 +242,9 @@ 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)} @@ -249,6 +254,9 @@ 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) } @@ -354,25 +362,45 @@ = do ty' <- ty return $ ForeignD (ImportF cc s str n ty') -pragInlD :: Name -> InlineSpecQ -> DecQ-pragInlD n ispec +infixLD :: Int -> Name -> DecQ+infixLD prec nm = return (InfixD (Fixity prec InfixL) nm)++infixRD :: Int -> Name -> DecQ+infixRD prec nm = return (InfixD (Fixity prec InfixR) nm)++infixND :: Int -> Name -> DecQ+infixND prec nm = return (InfixD (Fixity prec InfixN) nm)++pragInlD :: Name -> Inline -> RuleMatch -> Phases -> DecQ+pragInlD name inline rm phases+ = return $ PragmaD $ InlineP name inline rm phases++pragSpecD :: Name -> TypeQ -> Phases -> DecQ+pragSpecD n ty phases = do- ispec1 <- ispec - return $ PragmaD (InlineP n ispec1)+ ty1 <- ty+ return $ PragmaD $ SpecialiseP n ty1 Nothing phases -pragSpecD :: Name -> TypeQ -> DecQ-pragSpecD n ty+pragSpecInlD :: Name -> TypeQ -> Inline -> Phases -> DecQ+pragSpecInlD n ty inline phases = do ty1 <- ty- return $ PragmaD (SpecialiseP n ty1 Nothing)+ return $ PragmaD $ SpecialiseP n ty1 (Just inline) phases -pragSpecInlD :: Name -> TypeQ -> InlineSpecQ -> DecQ-pragSpecInlD n ty ispec +pragSpecInstD :: TypeQ -> DecQ+pragSpecInstD ty = do ty1 <- ty- ispec1 <- ispec- return $ PragmaD (SpecialiseP n ty1 (Just ispec1))+ return $ PragmaD $ SpecialiseInstP ty1 +pragRuleD :: String -> [RuleBndrQ] -> ExpQ -> ExpQ -> Phases -> DecQ+pragRuleD n bndrs lhs rhs phases+ = do+ bndrs1 <- sequence bndrs+ lhs1 <- lhs+ rhs1 <- rhs+ return $ PragmaD $ RuleP n bndrs1 lhs1 rhs1 phases+ familyNoKindD :: FamFlavour -> Name -> [TyVarBndr] -> DecQ familyNoKindD flav tc tvs = return $ FamilyD flav tc tvs Nothing @@ -460,6 +488,9 @@ listT :: TypeQ listT = return ListT +litT :: TyLitQ -> TypeQ+litT l = fmap LitT l+ tupleT :: Int -> TypeQ tupleT i = return (TupleT i) @@ -472,6 +503,18 @@ t' <- t return $ SigT t' k +promotedT :: Name -> TypeQ+promotedT = return . PromotedT++promotedTupleT :: Int -> TypeQ+promotedTupleT i = return (PromotedTupleT i)++promotedNilT :: TypeQ+promotedNilT = return PromotedNilT++promotedConsT :: TypeQ+promotedConsT = return PromotedConsT+ isStrict, notStrict, unpacked :: Q Strict isStrict = return $ IsStrict notStrict = return $ NotStrict@@ -484,6 +527,17 @@ varStrictType v st = do (s, t) <- st return (v, s, t) +-- * Type Literals++numTyLit :: Integer -> TyLitQ+numTyLit n = if n >= 0 then return (NumTyLit n)+ else fail ("Negative type-level number: " ++ show n)++strTyLit :: String -> TyLitQ+strTyLit s = return (StrTyLit s)+++ ------------------------------------------------------------------------------- -- * Kind @@ -493,11 +547,29 @@ kindedTV :: Name -> Kind -> TyVarBndr kindedTV = KindedTV +varK :: Name -> Kind+varK = VarT++conK :: Name -> Kind+conK = ConT++tupleK :: Int -> Kind+tupleK = TupleT++arrowK :: Kind+arrowK = ArrowT++listK :: Kind+listK = ListT++appK :: Kind -> Kind -> Kind+appK = AppT+ starK :: Kind-starK = StarK+starK = StarT -arrowK :: Kind -> Kind -> Kind-arrowK = ArrowK+constraintK :: Kind+constraintK = ConstraintT ------------------------------------------------------------------------------- -- * Callconv@@ -515,17 +587,6 @@ interruptible = Interruptible ---------------------------------------------------------------------------------- * InlineSpec--inlineSpecNoPhase :: Bool -> Bool -> InlineSpecQ-inlineSpecNoPhase inline conlike- = return $ InlineSpec inline conlike Nothing--inlineSpecPhase :: Bool -> Bool -> Bool -> Int -> InlineSpecQ-inlineSpecPhase inline conlike beforeFrom phase- = return $ InlineSpec inline conlike (Just (beforeFrom, phase))--------------------------------------------------------------------------------- -- * FunDep funDep :: [Name] -> [Name] -> FunDep@@ -537,6 +598,14 @@ typeFam, dataFam :: FamFlavour typeFam = TypeFam dataFam = DataFam++-------------------------------------------------------------------------------+-- * RuleBndr+ruleVar :: Name -> RuleBndrQ+ruleVar = return . RuleVar++typedRuleVar :: Name -> TypeQ -> RuleBndrQ+typedRuleVar n ty = ty >>= return . TypedRuleVar n -------------------------------------------------------------- -- * Useful helper function
Language/Haskell/TH/Ppr.hs view
@@ -9,7 +9,8 @@ import Text.PrettyPrint (render) import Language.Haskell.TH.PprLib import Language.Haskell.TH.Syntax-import Data.Char ( toLower )+import Data.Word ( Word8 )+import Data.Char ( toLower, chr ) import GHC.Show ( showMultiLineString ) nestDepth :: Int@@ -105,6 +106,8 @@ <+> 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@@ -112,6 +115,12 @@ = 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)@@ -153,13 +162,19 @@ $$ 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@@ -173,9 +188,12 @@ pprLit i (IntegerL x) = parensIf (i > noPrec && x < 0) (integer x) pprLit _ (CharL c) = text (show c) pprLit _ (StringL s) = pprString s-pprLit _ (StringPrimL s) = pprString s <> char '#'+pprLit _ (StringPrimL s) = pprString (bytesToString s) <> char '#' pprLit i (RationalL rat) = parensIf (i > noPrec) $ rational rat +bytesToString :: [Word8] -> String+bytesToString = map (chr . fromIntegral)+ pprString :: String -> Doc -- Print newlines as newlines with Haskell string escape notation, -- not as '\n'. For other non-printables use regular escape notation.@@ -235,9 +253,10 @@ $$ where_clause ds ppr_dec _ (InstanceD ctxt i ds) = text "instance" <+> pprCxt ctxt <+> ppr i $$ where_clause ds-ppr_dec _ (SigD f t) = ppr f <+> text "::" <+> ppr t-ppr_dec _ (ForeignD f) = ppr f-ppr_dec _ (PragmaD p) = ppr p+ppr_dec _ (SigD f t) = ppr f <+> text "::" <+> ppr t+ppr_dec _ (ForeignD f) = ppr f+ppr_dec _ (InfixD fx n) = pprFixity n fx+ppr_dec _ (PragmaD p) = ppr p ppr_dec isTop (FamilyD flav tc tvs k) = ppr flav <+> maybeFamily <+> ppr tc <+> hsep (map ppr tvs) <+> maybeKind where@@ -323,35 +342,54 @@ ------------------------------ instance Ppr Pragma where- ppr (InlineP n (InlineSpec inline conlike activation))+ ppr (InlineP n inline rm phases) = text "{-#"- <+> (if inline then text "INLINE" else text "NOINLINE")- <+> (if conlike then text "CONLIKE" else empty)- <+> ppr_activation activation + <+> ppr inline+ <+> ppr rm+ <+> ppr phases <+> ppr n <+> text "#-}"- ppr (SpecialiseP n ty Nothing)- = sep [ text "{-# SPECIALISE" - , ppr n <+> text "::"- , ppr ty- , text "#-}"- ]- ppr (SpecialiseP n ty (Just (InlineSpec inline _conlike activation)))- = sep [ text "{-# SPECIALISE" <+> - (if inline then text "INLINE" else text "NOINLINE") <+>- ppr_activation activation- , ppr n <+> text "::"- , ppr ty- , text "#-}"- ]- where+ ppr (SpecialiseP n ty inline phases)+ = text "{-# SPECIALISE"+ <+> maybe empty ppr inline+ <+> ppr phases+ <+> sep [ ppr n <+> text "::"+ , nest 2 $ ppr ty ]+ <+> text "#-}"+ ppr (SpecialiseInstP inst)+ = text "{-# SPECIALISE instance" <+> ppr inst <+> text "#-}"+ ppr (RuleP n bndrs lhs rhs phases)+ = sep [ text "{-# RULES" <+> pprString n <+> ppr phases+ , nest 4 $ ppr_forall <+> ppr lhs+ , nest 4 $ char '=' <+> ppr rhs <+> text "#-}" ]+ where ppr_forall | null bndrs = empty+ | otherwise = text "forall"+ <+> fsep (map ppr bndrs)+ <+> char '.' -ppr_activation :: Maybe (Bool, Int) -> Doc-ppr_activation (Just (beforeFrom, i))- = brackets $ (if beforeFrom then empty else char '~') <+> int i-ppr_activation Nothing = empty+------------------------------+instance Ppr Inline where+ ppr NoInline = text "NOINLINE"+ ppr Inline = text "INLINE"+ ppr Inlinable = text "INLINABLE" ------------------------------+instance Ppr RuleMatch where+ ppr ConLike = text "CONLIKE"+ ppr FunLike = empty++------------------------------+instance Ppr Phases where+ ppr AllPhases = empty+ ppr (FromPhase i) = brackets $ int i+ ppr (BeforePhase i) = brackets $ char '~' <> int i++------------------------------+instance Ppr RuleBndr where+ ppr (RuleVar n) = ppr n+ ppr (TypedRuleVar n ty) = parens $ ppr n <+> text "::" <+> ppr ty++------------------------------ instance Ppr Clause where ppr (Clause ps rhs ds) = hsep (map (pprPat appPrec) ps) <+> pprBody True rhs $$ where_clause ds@@ -381,14 +419,22 @@ ------------------------------ pprParendType :: Type -> Doc-pprParendType (VarT v) = ppr v-pprParendType (ConT c) = ppr c-pprParendType (TupleT 0) = text "()"-pprParendType (TupleT n) = parens (hcat (replicate (n-1) comma))-pprParendType (UnboxedTupleT n) = hashParens $ hcat $ replicate (n-1) comma-pprParendType ArrowT = parens (text "->")-pprParendType ListT = text "[]"-pprParendType other = parens (ppr other)+pprParendType (VarT v) = ppr v+pprParendType (ConT c) = ppr c+pprParendType (TupleT 0) = text "()"+pprParendType (TupleT n) = parens (hcat (replicate (n-1) comma))+pprParendType (UnboxedTupleT n) = hashParens $ hcat $ replicate (n-1) comma+pprParendType ArrowT = parens (text "->")+pprParendType ListT = text "[]"+pprParendType (LitT l) = pprTyLit l+pprParendType (PromotedT c) = text "'" <> ppr c+pprParendType (PromotedTupleT 0) = text "'()"+pprParendType (PromotedTupleT n) = quoteParens (hcat (replicate (n-1) comma))+pprParendType PromotedNilT = text "'[]"+pprParendType PromotedConsT = text "(':)"+pprParendType StarT = char '*'+pprParendType ConstraintT = text "Constraint"+pprParendType other = parens (ppr other) instance Ppr Type where ppr (ForallT tvars ctxt ty)@@ -402,6 +448,8 @@ pprTyApp (ListT, [arg]) = brackets (ppr arg) pprTyApp (TupleT n, args) | length args == n = parens (sep (punctuate comma (map ppr args)))+pprTyApp (PromotedTupleT n, args)+ | length args == n = quoteParens (sep (punctuate comma (map ppr args))) pprTyApp (fun, args) = pprParendType fun <+> sep (map pprParendType args) pprFunArgType :: Type -> Doc -- Should really use a precedence argument@@ -416,19 +464,18 @@ where go (AppT t1 t2) args = go t1 (t2:args) go ty args = (ty, args) +pprTyLit :: TyLit -> Doc+pprTyLit (NumTyLit n) = integer n+pprTyLit (StrTyLit s) = text (show s)++instance Ppr TyLit where+ ppr = pprTyLit+ ------------------------------ instance Ppr TyVarBndr where ppr (PlainTV nm) = ppr nm ppr (KindedTV nm k) = parens (ppr nm <+> text "::" <+> ppr k) -instance Ppr Kind where- ppr StarK = char '*'- ppr (ArrowK k1 k2) = pprArrowArgKind k1 <+> text "->" <+> ppr k2--pprArrowArgKind :: Kind -> Doc-pprArrowArgKind k@(ArrowK _ _) = parens (ppr k)-pprArrowArgKind k = ppr k- ------------------------------ pprCxt :: Cxt -> Doc pprCxt [] = empty@@ -462,4 +509,7 @@ hashParens :: Doc -> Doc hashParens d = text "(# " <> d <> text " #)"++quoteParens :: Doc -> Doc+quoteParens d = text "'(" <> d <> text ")"
Language/Haskell/TH/PprLib.hs view
@@ -10,7 +10,7 @@ -- * 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 @@ 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 @@ 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
Language/Haskell/TH/Quote.hs view
@@ -31,9 +31,9 @@ conName :: Name conName = case showConstr constr of- "(:)" -> Name (mkOccName ":") NameS- con@"[]" -> Name (mkOccName con) NameS- con@('(':_) -> Name (mkOccName con) NameS+ "(:)" -> Name (mkOccName ":") (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))+ con@"[]" -> Name (mkOccName con) (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))+ con@('(':_) -> Name (mkOccName con) (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Tuple")) con -> mkNameG_d (tyConPackage tycon) (tyConModule tycon) con
Language/Haskell/TH/Syntax.hs view
@@ -20,43 +20,10 @@ -- ----------------------------------------------------------------------------- -module Language.Haskell.TH.Syntax(- Quasi(..), Lift(..), liftString,-- Q, runQ, - 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, - Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..),- InlineSpec(..), StrictType, VarStrictType, FunDep(..), FamFlavour(..),- Info(..), Loc(..), CharPos,- Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,-- -- * Internal functions- returnQ, bindQ, sequenceQ,- NameFlavour(..), NameSpace (..), - mkNameG_v, mkNameG_d, mkNameG_tc, Uniq, mkNameL, mkNameU,- tupleTypeName, tupleDataName,- unboxedTupleTypeName, unboxedTupleDataName,- OccName, mkOccName, occString,- ModName, mkModName, modString,- PkgName, mkPkgName, pkgString- ) where+module Language.Haskell.TH.Syntax where import GHC.Base ( Int(..), Int#, (<#), (==#) ) -import Language.Haskell.TH.Syntax.Internals import Data.Data (Data(..), Typeable, mkConstr, mkDataType, constrIndex) import qualified Data.Data as Data import Control.Applicative( Applicative(..) )@@ -65,6 +32,7 @@ import Control.Monad (liftM) import System.IO ( hPutStrLn, stderr ) import Data.Char ( isAlpha )+import Data.Word ( Word8 ) ----------------------------------------------------- --@@ -146,6 +114,17 @@ newtype Q a = Q { unQ :: forall m. Quasi m => m a } +-- \"Runs\" the 'Q' monad. Normal users of Template Haskell+-- should not need this function, as the splice brackets @$( ... )@+-- are the usual way of running a 'Q' computation.+--+-- This function is primarily used in GHC internals, and for debugging+-- splices by running them in 'IO'. +--+-- Note that many functions in 'Q', such as 'reify' and other compiler+-- queries, are not supported when running 'Q' in 'IO'; these operations+-- simply fail at runtime. Indeed, the only operations guaranteed to succeed+-- are 'newName', 'runIO', 'reportError' and 'reportWarning'. runQ :: Quasi m => Q a -> m a runQ (Q m) = m @@ -164,14 +143,61 @@ ---------------------------------------------------- -- Packaged versions for the programmer, hiding the Quasi-ness++{- | +Generate a fresh name, which cannot be captured. ++For example, this:++@f = $(do+ nm1 <- newName \"x\"+ let nm2 = 'mkName' \"x\"+ return ('LamE' ['VarP' nm1] (LamE [VarP nm2] ('VarE' nm1)))+ )@++will produce the splice++>f = \x0 -> \x -> x0++In particular, the occurrence @VarE nm1@ refers to the binding @VarP nm1@,+and is not captured by the binding @VarP nm2@.++Although names generated by @newName@ cannot /be captured/, they can+/capture/ other names. For example, this:++>g = $(do+> nm1 <- newName "x"+> let nm2 = mkName "x"+> return (LamE [VarP nm2] (LamE [VarP nm1] (VarE nm2)))+> )++will produce the splice++>g = \x -> \x0 -> x0++since the occurrence @VarE nm2@ is captured by the innermost binding+of @x@, namely @VarP nm1@.+-} newName :: String -> Q Name newName s = Q (qNewName s) +-- | Report an error (True) or warning (False), +-- but carry on; use 'fail' to stop. report :: Bool -> String -> Q () report b s = Q (qReport b s)+{-# DEPRECATED report "Use reportError or reportWarning instead" #-} -recover :: Q a -- ^ recover with this one- -> Q a -- ^ failing action+-- | Report an error to the user, but allow the current splice's computation to carry on. To abort the computation, use 'fail'.+reportError :: String -> Q ()+reportError = report True++-- | Report a warning to the user, and carry on.+reportWarning :: String -> Q ()+reportWarning = report False++-- | Recover from errors raised by 'reportError' or 'fail'.+recover :: Q a -- ^ handler to invoke on failure+ -> Q a -- ^ computation to run -> Q a recover (Q r) (Q m) = Q (qRecover r m) @@ -180,24 +206,100 @@ lookupName :: Bool -> String -> Q (Maybe Name) lookupName ns s = Q (qLookupName ns s) -lookupTypeName, lookupValueName :: String -> Q (Maybe Name)+-- | Look up the given name in the (type namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.+lookupTypeName :: String -> Q (Maybe Name) lookupTypeName s = Q (qLookupName True s)++-- | Look up the given name in the (value namespace of the) current splice's scope. See "Language.Haskell.TH.Syntax#namelookup" for more details.+lookupValueName :: String -> Q (Maybe Name) lookupValueName s = Q (qLookupName False s) --- | 'reify' looks up information about the 'Name'+{-+Note [Name lookup]+~~~~~~~~~~~~~~~~~~+-}+{- $namelookup #namelookup#+The functions 'lookupTypeName' and 'lookupValueName' provide+a way to query the current splice's context for what names+are in scope. The function 'lookupTypeName' queries the type+namespace, whereas 'lookupValueName' queries the value namespace,+but the functions are otherwise identical.++A call @lookupValueName s@ will check if there is a value+with name @s@ in scope at the current splice's location. If+there is, the @Name@ of this value is returned;+if not, then @Nothing@ is returned.++The returned name cannot be \"captured\". +For example:++> f = "global"+> g = $( do+> Just nm <- lookupValueName "f"+> [| let f = "local" in $( varE nm ) |]++In this case, @g = \"global\"@; the call to @lookupValueName@+returned the global @f@, and this name was /not/ captured by+the local definition of @f@.++The lookup is performed in the context of the /top-level/ splice+being run. For example:++> f = "global"+> g = $( [| let f = "local" in +> $(do+> Just nm <- lookupValueName "f"+> varE nm+> ) |] )++Again in this example, @g = \"global\"@, because the call to+@lookupValueName@ queries the context of the outer-most @$(...)@.++Operators should be queried without any surrounding parentheses, like so:++> lookupValueName "+"++Qualified names are also supported, like so:++> lookupValueName "Prelude.+"+> lookupValueName "Prelude.map"++-}+++{- | 'reify' looks up information about the 'Name'.++It is sometimes useful to construct the argument name using 'lookupTypeName' or 'lookupValueName'+to ensure that we are reifying from the right namespace. For instance, in this context:++> data D = D++which @D@ does @reify (mkName \"D\")@ return information about? (Answer: @D@-the-type, but don't rely on it.)+To ensure we get information about @D@-the-value, use 'lookupValueName':++> do+> Just nm <- lookupValueName "D"+> reify nm++and to get information about @D@-the-type, use 'lookupTypeName'.+-} reify :: Name -> Q Info reify v = Q (qReify v) --- | 'classInstances' looks up instaces of a class-reifyInstances :: Name -> [Type] -> Q [Dec]+{- | @reifyInstances nm tys@ returns a list of visible instances of @nm tys@. That is, +if @nm@ is the name of a type class, then all instances of this class at the types @tys@+are returned. Alternatively, if @nm@ is the name of a data family or type family,+all instances of this family at the types @tys@ are returned.+-}+reifyInstances :: Name -> [Type] -> Q [InstanceDec] reifyInstances cls tys = Q (qReifyInstances cls tys) +-- | Is the list of instances returned by 'reifyInstances' nonempty? 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.+-- | The location at which this computation is spliced. location :: Q Loc location = Q qLocation @@ -334,6 +436,15 @@ -- Names and uniques ----------------------------------------------------- +newtype ModName = ModName String -- Module name+ deriving (Eq,Ord,Typeable,Data)++newtype PkgName = PkgName String -- package name+ deriving (Eq,Ord,Typeable,Data)++newtype OccName = OccName String+ deriving (Eq,Ord,Typeable,Data)+ mkModName :: String -> ModName mkModName s = ModName s @@ -362,8 +473,7 @@ ----------------------------------------------------- -- Names --------------------------------------------------------- |+-- -- For "global" names ('NameG') we need a totally unique name, -- so we must include the name-space of the thing --@@ -387,6 +497,63 @@ -- The 'map' will be a NameG, and 'x' wil be a NameL -- -- These Names should never appear in a binding position in a TH syntax tree++{- $namecapture #namecapture#+Much of 'Name' API is concerned with the problem of /name capture/, which+can be seen in the following example.++> f expr = [| let x = 0 in $expr |]+> ...+> g x = $( f [| x |] )+> h y = $( f [| y |] )++A naive desugaring of this would yield:++> g x = let x = 0 in x+> h y = let x = 0 in y++All of a sudden, @g@ and @h@ have different meanings! In this case,+we say that the @x@ in the RHS of @g@ has been /captured/+by the binding of @x@ in @f@.++What we actually want is for the @x@ in @f@ to be distinct from the+@x@ in @g@, so we get the following desugaring:++> g x = let x' = 0 in x+> h y = let x' = 0 in y++which avoids name capture as desired. ++In the general case, we say that a @Name@ can be captured if+the thing it refers to can be changed by adding new declarations.+-}++{- |+An abstract type representing names in the syntax tree.++'Name's can be constructed in several ways, which come with different+name-capture guarantees (see "Language.Haskell.TH.Syntax#namecapture" for+an explanation of name capture):++ * the built-in syntax @'f@ and @''T@ can be used to construct names, + The expression @'f@ gives a @Name@ which refers to the value @f@ + currently in scope, and @''T@ gives a @Name@ which refers to the+ type @T@ currently in scope. These names can never be captured.+ + * 'lookupValueName' and 'lookupTypeName' are similar to @'f@ and + @''T@ respectively, but the @Name@s are looked up at the point+ where the current splice is being run. These names can never be+ captured.++ * 'newName' monadically generates a new name, which can never+ be captured.+ + * 'mkName' generates a capturable name.++Names constructed using @newName@ and @mkName@ may be used in bindings+(such as @let x = ...@ or @\x -> ...@), but names constructed using+@lookupValueName@, @lookupTypeName@, @'f@, @''T@ may not.+-} data Name = Name OccName NameFlavour deriving (Typeable, Data) data NameFlavour@@ -451,17 +618,42 @@ type Uniq = Int --- | Base, unqualified name.+-- | The name without its module prefix nameBase :: Name -> String nameBase (Name occ _) = occString occ +-- | Module prefix of a name, if it exists nameModule :: Name -> Maybe String nameModule (Name _ (NameQ m)) = Just (modString m) nameModule (Name _ (NameG _ _ m)) = Just (modString m) nameModule _ = Nothing +{- | +Generate a capturable name. Occurrences of such names will be+resolved according to the Haskell scoping rules at the occurrence+site.++For example:++> f = [| pi + $(varE (mkName "pi")) |]+> ...+> g = let pi = 3 in $f++In this case, @g@ is desugared to++> g = Prelude.pi + 3++Note that @mkName@ may be used with qualified names:++> mkName "Prelude.pi"++See also 'Language.Haskell.TH.Lib.dyn' for a useful combinator. The above example could+be rewritten using 'dyn' as++> f = [| pi + $(dyn "pi") |]+-} mkName :: String -> Name--- ^ The string can have a '.', thus "Foo.baz",+-- The string can have a '.', thus "Foo.baz", -- giving a dynamically-bound qualified name, -- in which case we want to generate a NameQ --@@ -588,8 +780,10 @@ show = showName -- Tuple data and type constructors-tupleDataName :: Int -> Name -- ^ Data constructor-tupleTypeName :: Int -> Name -- ^ Type constructor+-- | Tuple data constructor+tupleDataName :: Int -> Name+-- | Tuple type constructor+tupleTypeName :: Int -> Name tupleDataName 0 = mk_tup_name 0 DataName tupleDataName 1 = error "tupleDataName 1"@@ -607,8 +801,10 @@ tup_mod = mkModName "GHC.Tuple" -- Unboxed tuple data and type constructors-unboxedTupleDataName :: Int -> Name -- ^ Data constructor-unboxedTupleTypeName :: Int -> Name -- ^ Type constructor+-- | Unboxed tuple data constructor+unboxedTupleDataName :: Int -> Name+-- | Unboxed tuple type constructor+unboxedTupleTypeName :: Int -> Name unboxedTupleDataName 0 = error "unboxedTupleDataName 0" unboxedTupleDataName 1 = error "unboxedTupleDataName 1"@@ -638,7 +834,7 @@ , loc_start :: CharPos , loc_end :: CharPos } -type CharPos = (Int, Int) -- Line and character position+type CharPos = (Int, Int) -- ^ Line and character position -----------------------------------------------------@@ -649,55 +845,88 @@ -- | Obtained from 'reify' in the 'Q' Monad. data Info- = -- | A class is reified to its declaration - -- and a list of its instances- ClassI - Dec -- Declaration of the class- [InstanceDec] -- The instances of that class-+ = + -- | A class, with a list of its visible instances+ ClassI + Dec+ [InstanceDec]+ + -- | A class method | ClassOpI- Name -- The class op itself- Type -- Type of the class-op (fully polymoprhic)- Name -- Name of the parent class- Fixity-+ Name+ Type+ ParentName+ Fixity+ + -- | A \"plain\" type constructor. \"Fancier\" type constructors are returned using 'PrimTyConI' or 'FamilyI' as appropriate | TyConI Dec - | FamilyI -- Type/data families+ -- | A type or data family, with a list of its visible instances+ | FamilyI Dec [InstanceDec]-- | PrimTyConI -- Ones that can't be expressed with a data type - -- decl, such as (->), Int#- Name - Int -- Arity- Bool -- False => lifted type; True => unlifted-+ + -- | A \"primitive\" type constructor, which can't be expressed with a 'Dec'. Examples: @(->)@, @Int#@.+ | PrimTyConI + Name+ Arity+ Unlifted+ + -- | A data constructor | DataConI - Name -- The data con itself- Type -- Type of the constructor (fully polymorphic)- Name -- Name of the parent TyCon- Fixity+ Name+ Type+ ParentName+ Fixity + {- | + A \"value\" variable (as opposed to a type variable, see 'TyVarI').+ + The @Maybe Dec@ field contains @Just@ the declaration which + defined the variable -- including the RHS of the declaration -- + or else @Nothing@, in the case where the RHS is unavailable to+ the compiler. At present, this value is _always_ @Nothing@:+ returning the RHS has not yet been implemented because of+ lack of interest.+ -} | VarI - Name -- The variable itself- Type - (Maybe Dec) -- Nothing for lambda-bound variables, and - -- for anything else TH can't figure out- -- E.g. [| let x = 1 in $(do { d <- reify 'x; .. }) |]- Fixity+ Name+ Type+ (Maybe Dec)+ Fixity + {- | + A type variable.+ + The @Type@ field contains the type which underlies the variable.+ At present, this is always @'VarT' theName@, but future changes+ may permit refinement of this.+ -} | TyVarI -- Scoped type variable Name Type -- What it is bound to deriving( Show, Data, Typeable ) --- | 'InstanceDec' desribes a single instance of a class or type function+{- | +In 'ClassOpI' and 'DataConI', name of the parent class or type+-}+type ParentName = Name++-- | In 'PrimTyConI', arity of the type constructor+type Arity = Int++-- | In 'PrimTyConI', is the type constructor unlifted?+type Unlifted = Bool++-- | '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+--+-- * 'InstanceD' (with empty @['Dec']@)+--+-- * 'DataInstD' or 'NewtypeInstD' (with empty derived @['Name']@)+--+-- * 'TySynInstD' type InstanceDec = Dec data Fixity = Fixity Int FixityDirection@@ -705,27 +934,24 @@ data FixityDirection = InfixL | InfixR | InfixN deriving( Eq, Show, Data, Typeable ) +-- | Highest allowed operator precedence for 'Fixity' constructor (answer: 9) maxPrecedence :: Int maxPrecedence = (9::Int) +-- | Default fixity: @infixl 9@ defaultFixity :: Fixity defaultFixity = Fixity maxPrecedence InfixL ------------------------------------------------------------ The main syntax data types-----------------------------------------------------------{- $infix #infix#+{- Note [Unresolved infix] ~~~~~~~~~~~~~~~~~~~~~~~-+-}+{- $infix #infix# When implementing antiquotation for quasiquoters, one often wants to parse strings into expressions: -> parse :: String -> Maybe 'Exp'+> 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@@ -780,6 +1006,12 @@ -} +-----------------------------------------------------+--+-- The main syntax data types+--+-----------------------------------------------------+ data Lit = CharL Char | StringL String | IntegerL Integer -- ^ Used for overloaded and non-overloaded@@ -791,7 +1023,7 @@ | WordPrimL Integer | FloatPrimL Rational | DoublePrimL Rational- | StringPrimL String -- ^ A primitive C-style string, type Addr#+ | StringPrimL [Word8] -- ^ A primitive C-style string, type Addr# deriving( Show, Eq, Data, Typeable ) -- We could add Int, Float, Double etc, as we do in HsLit, @@ -808,10 +1040,10 @@ | 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"+ -- See "Language.Haskell.TH.Syntax#infix" | ParensP Pat -- ^ @{(p)}@ --- -- See Note [Unresolved infix] at "Language.Haskell.TH.Syntax#infix"+ -- See "Language.Haskell.TH.Syntax#infix" | TildeP Pat -- ^ @{ ~p }@ | BangP Pat -- ^ @{ !p }@ | AsP Name Pat -- ^ @{ x \@ p }@@@ -830,15 +1062,6 @@ -- ^ @f { p1 p2 = body where decs }@ deriving( Show, Eq, Data, Typeable ) --- | The 'CompE' constructor represents a list comprehension, and --- takes a ['Stmt']. The result expression of the comprehension is--- the *last* of these, and should be a 'NoBindS'.------ E.g. translation:------ > [ f x | x <- xs ]------ > CompE [BindS (VarP x) (VarE xs), NoBindS (AppE (VarE f) (VarE x))] data Exp = VarE Name -- ^ @{ x }@ | ConE Name -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2 @@@ -846,7 +1069,7 @@ | AppE Exp Exp -- ^ @{ f x }@ | InfixE (Maybe Exp) Exp (Maybe Exp) -- ^ @{x + y} or {(x+)} or {(+ x)} or {(+)}@- --+ -- It's a bit gruesome to use an Exp as the -- operator, but how else can we distinguish -- constructors from non-constructors?@@ -855,18 +1078,30 @@ | UInfixE Exp Exp Exp -- ^ @{x + y}@ --- -- See Note [Unresolved infix] at "Language.Haskell.TH.Syntax#infix"+ -- See "Language.Haskell.TH.Syntax#infix" | ParensE Exp -- ^ @{ (e) }@ --- -- See Note [Unresolved infix] at "Language.Haskell.TH.Syntax#infix"+ -- See "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 }@+ | 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 } }@- | CompE [Stmt] -- ^ @{ [ (x,y) | x <- xs, y <- ys ] }@+ | CompE [Stmt] -- ^ @{ [ (x,y) | x <- xs, y <- ys ] }@ + --+ -- The result expression of the comprehension is+ -- the /last/ of the @'Stmt'@s, and should be a 'NoBindS'.+ --+ -- E.g. translation:+ --+ -- > [ f x | x <- xs ]+ --+ -- > CompE [BindS (VarP x) (VarE xs), NoBindS (AppE (VarE f) (VarE x))]+ | ArithSeqE Range -- ^ @{ [ 1 ,2 .. 10 ] }@ | ListE [ Exp ] -- ^ @{ [1,2,3] }@ | SigE Exp Type -- ^ @{ e :: t }@@@ -879,13 +1114,15 @@ -- Omitted: implicit parameters data Body- = GuardedB [(Guard,Exp)] -- ^ @f p { | e1 = e2 | e3 = e4 } where ds@+ = GuardedB [(Guard,Exp)] -- ^ @f p { | e1 = e2 + -- | e3 = e4 } + -- where ds@ | NormalB Exp -- ^ @f p { = e } where ds@ deriving( Show, Eq, Data, Typeable ) data Guard- = NormalG Exp- | PatG [Stmt]+ = NormalG Exp -- ^ @f x { | odd x } = x@+ | PatG [Stmt] -- ^ @f x { | Just y <- x, Just z <- y } = z@ deriving( Show, Eq, Data, Typeable ) data Stmt@@ -914,10 +1151,13 @@ | InstanceD Cxt Type [Dec] -- ^ @{ instance Show w => Show [w] -- where ds }@ | SigD Name Type -- ^ @{ length :: [a] -> Int }@- | ForeignD Foreign+ | ForeignD Foreign -- ^ @{ foreign import ... }+ --{ foreign export ... }@ + | InfixD Fixity Name -- ^ @{ infix 3 foo }@+ -- | pragmas- | PragmaD Pragma -- ^ @{ {-# INLINE [1] foo #-} }@+ | PragmaD Pragma -- ^ @{ {\-# INLINE [1] foo #-\} }@ -- | type families (may also appear in [Dec] of 'ClassD' and 'InstanceD') | FamilyD FamFlavour Name @@ -949,16 +1189,30 @@ data Safety = Unsafe | Safe | Interruptible deriving( Show, Eq, Data, Typeable ) -data Pragma = InlineP Name InlineSpec- | SpecialiseP Name Type (Maybe InlineSpec)+data Pragma = InlineP Name Inline RuleMatch Phases+ | SpecialiseP Name Type (Maybe Inline) Phases+ | SpecialiseInstP Type+ | RuleP String [RuleBndr] Exp Exp Phases deriving( Show, Eq, Data, Typeable ) -data InlineSpec - = InlineSpec Bool -- False: no inline; True: inline - Bool -- False: fun-like; True: constructor-like- (Maybe (Bool, Int)) -- False: before phase; True: from phase- deriving( Show, Eq, Data, Typeable )+data Inline = NoInline+ | Inline+ | Inlinable+ deriving (Show, Eq, Data, Typeable) +data RuleMatch = ConLike+ | FunLike+ deriving (Show, Eq, Data, Typeable)++data Phases = AllPhases+ | FromPhase Int+ | BeforePhase Int+ deriving (Show, Eq, Data, Typeable)++data RuleBndr = RuleVar Name+ | TypedRuleVar Name Type+ deriving (Show, Eq, Data, Typeable)+ type Cxt = [Pred] -- ^ @(Eq a, Ord b)@ data Pred = ClassP Name [Type] -- ^ @Eq (Int, a)@@@ -977,24 +1231,73 @@ type StrictType = (Strict, Type) type VarStrictType = (Name, Strict, Type) -data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall <vars>. <ctxt> -> <type>@+data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall \<vars\>. \<ctxt\> -> \<type\>@+ | AppT Type Type -- ^ @T a b@+ | SigT Type Kind -- ^ @t :: k@ | VarT Name -- ^ @a@ | ConT Name -- ^ @T@+ | PromotedT Name -- ^ @'T@++ -- See Note [Representing concrete syntax in types] | TupleT Int -- ^ @(,), (,,), etc.@ | UnboxedTupleT Int -- ^ @(#,#), (#,,#), etc.@ | ArrowT -- ^ @->@ | ListT -- ^ @[]@- | AppT Type Type -- ^ @T a b@- | SigT Type Kind -- ^ @t :: k@+ | PromotedTupleT Int -- ^ @'(), '(,), '(,,), etc.@+ | PromotedNilT -- ^ @'[]@+ | PromotedConsT -- ^ @(':)@+ | StarT -- ^ @*@+ | ConstraintT -- ^ @Constraint@+ | LitT TyLit -- ^ @0,1,2, etc.@ deriving( Show, Eq, Data, Typeable ) data TyVarBndr = PlainTV Name -- ^ @a@ | KindedTV Name Kind -- ^ @(a :: k)@ deriving( Show, Eq, Data, Typeable ) -data Kind = StarK -- ^ @'*'@- | ArrowK Kind Kind -- ^ @k1 -> k2@- deriving( Show, Eq, Data, Typeable )+data TyLit = NumTyLit Integer -- ^ @2@+ | StrTyLit String -- ^ @"Hello"@+ deriving ( Show, Eq, Data, Typeable )++-- | To avoid duplication between kinds and types, they+-- are defined to be the same. Naturally, you would never+-- have a type be 'StarT' and you would never have a kind+-- be 'SigT', but many of the other constructors are shared.+-- Note that the kind @Bool@ is denoted with 'ConT', not+-- 'PromotedT'. Similarly, tuple kinds are made with 'TupleT',+-- not 'PromotedTupleT'.++type Kind = Type ++{- Note [Representing concrete syntax in types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Haskell has a rich concrete syntax for types, including+ t1 -> t2, (t1,t2), [t], and so on+In TH we represent all of this using AppT, with a distinguished+type construtor at the head. So,+ Type TH representation+ -----------------------------------------------+ t1 -> t2 ArrowT `AppT` t2 `AppT` t2+ [t] ListT `AppT` t+ (t1,t2) TupleT 2 `AppT` t1 `AppT` t2+ '(t1,t2) PromotedTupleT 2 `AppT` t1 `AppT` t2++But if the original HsSyn used prefix application, we won't use+these special TH constructors. For example+ [] t ConT "[]" `AppT` t+ (->) t ConT "->" `AppT` t+In this way we can faithfully represent in TH whether the original+HsType used concrete syntax or not.++The one case that doesn't fit this pattern is that of promoted lists+ '[ Maybe, IO ] PromotedListT 2 `AppT` t1 `AppT` t2+but it's very smelly because there really is no type constructor+corresponding to PromotedListT. So we encode HsExplicitListTy with+PromotedConsT and PromotedNilT (which *do* have underlying type+constructors):+ '[ Maybe, IO ] PromotedConsT `AppT` Maybe `AppT` + (PromotedConsT `AppT` IO `AppT` PromotedNilT)+-} ----------------------------------------------------- -- Internal helper functions
− Language/Haskell/TH/Syntax/Internals.hs
@@ -1,29 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving,DeriveDataTypeable #-}--------------------------------------------------------------------------------- |--- Module : Language.Haskell.Syntax.Internals--- Copyright : (c) The University of Glasgow 2009--- License : BSD-style (see the file libraries/base/LICENSE)--- --- Maintainer : libraries@haskell.org--- Stability : experimental--- Portability : portable------ Abstract syntax definitions for Template Haskell.-----------------------------------------------------------------------------------module Language.Haskell.TH.Syntax.Internals (- ModName(..), PkgName(..), OccName(..)- ) where--import Data.Data--newtype ModName = ModName String -- Module name- deriving (Eq,Ord,Typeable,Data)--newtype PkgName = PkgName String -- package name- deriving (Eq,Ord,Typeable,Data)--newtype OccName = OccName String- deriving (Eq,Ord,Typeable,Data)
template-haskell.cabal view
@@ -1,5 +1,5 @@ name: template-haskell-version: 2.7.0.0+version: 2.8.0.0 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org@@ -13,7 +13,6 @@ build-depends: base >= 4.2 && < 5, pretty, containers exposed-modules:- Language.Haskell.TH.Syntax.Internals Language.Haskell.TH.Syntax Language.Haskell.TH.PprLib Language.Haskell.TH.Ppr