template-haskell 2.4.0.1 → 2.5.0.0
raw patch · 7 files changed
+346/−207 lines, 7 filesdep ~basedep ~containersdep ~pretty
Dependency ranges changed: base, containers, pretty
Files
- Language/Haskell/TH.hs +60/−20
- Language/Haskell/TH/Lib.hs +47/−34
- Language/Haskell/TH/Ppr.hs +35/−24
- Language/Haskell/TH/PprLib.hs +1/−1
- Language/Haskell/TH/Quote.hs +20/−3
- Language/Haskell/TH/Syntax.hs +182/−124
- template-haskell.cabal +1/−1
Language/Haskell/TH.hs view
@@ -1,15 +1,21 @@--- The public face of Template Haskell+{- | The public face of Template Haskell +For other documentation, refer to:+<http://www.haskell.org/haskellwiki/Template_Haskell>++-} module Language.Haskell.TH(- -- The monad and its operations+ -- * The monad and its operations Q, runQ, report, -- :: Bool -> String -> Q () recover, -- :: Q a -> Q a -> Q a reify, -- :: Name -> Q Info location, -- :: Q Location runIO, -- :: IO a -> Q a+ isClassInstance,+ classInstances, - -- Names+ -- * Names Name, mkName, -- :: String -> Name newName, -- :: String -> Q Name@@ -17,40 +23,74 @@ nameModule, -- :: Name -> Maybe String tupleTypeName, tupleDataName, -- Int -> Name - -- The algebraic data types+ -- * 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, Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..),- InlineSpec(..), FunDep(..), FamFlavour(..), Info(..), Loc(..),+ InlineSpec(..), FunDep(..), FamFlavour(..), Info(..),+ ClassInstance(..), Loc(..), Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence, - -- Library functions- InfoQ, ExpQ, DecQ, ConQ, TypeQ, CxtQ, PredQ, MatchQ, ClauseQ, BodyQ,+ -- * Library functions+ -- ** Abbreviations+ InfoQ, ExpQ, DecQ, DecsQ, ConQ, TypeQ, CxtQ, PredQ, MatchQ, ClauseQ, BodyQ, GuardQ, StmtQ, RangeQ, StrictTypeQ, VarStrictTypeQ, PatQ, FieldPatQ, InlineSpecQ,++ -- ** Constructors lifted to 'Q'+ -- *** Literals intPrimL, wordPrimL, floatPrimL, doublePrimL, integerL, rationalL,- charL, stringL,+ charL, stringL, stringPrimL,+ -- *** Patterns litP, varP, tupP, conP, infixP, tildeP, bangP, asP, wildP, recP,- listP, sigP, + listP, sigP, viewP, fieldPat,- bindS, letS, noBindS, parS, - fromR, fromThenR, fromToR, fromThenToR, ++ -- *** Pattern Guards normalB, guardedB, normalG, normalGE, patG, patGE, match, clause, ++ -- *** Expressions dyn, global, varE, conE, litE, appE, infixE, infixApp, sectionL, sectionR, - lamE, lam1E, tupE, condE, letE, caseE, doE, compE, arithSeqE, appsE,- fromE, fromThenE, fromToE, fromThenToE,+ lamE, lam1E, tupE, condE, letE, caseE, appsE, listE, sigE, recConE, recUpdE, stringE, fieldExp,- valD, funD, tySynD, dataD, newtypeD, classD, instanceD, sigD, forImpD,- pragInlD, pragSpecD, familyNoKindD, familyKindD, dataInstD,- newtypeInstD, tySynInstD, - cxt, classP, equalP, normalC, recC, infixC,+ -- **** Ranges+ fromE, fromThenE, fromToE, fromThenToE,++ -- ***** Ranges with more indirection+ arithSeqE,+ fromR, fromThenR, fromToR, fromThenToR, + -- **** Statements+ doE, compE,+ bindS, letS, noBindS, parS,++ -- *** Types forallT, varT, conT, appT, arrowT, listT, tupleT, sigT,+ -- **** Strictness isStrict, notStrict, strictType, varStrictType,- cCall, stdCall, unsafe, safe, threadsafe, - inlineSpecNoPhase, inlineSpecPhase, typeFam, dataFam,+ -- **** Class Contexts+ cxt, classP, equalP, normalC, recC, infixC, - -- Pretty-printer+ -- *** Top Level Declarations+ -- **** Data+ valD, funD, tySynD, dataD, newtypeD,+ -- **** Class+ classD, instanceD, sigD,+ -- **** Type Family / Data Family+ familyNoKindD, familyKindD, dataInstD,+ newtypeInstD, tySynInstD, + typeFam, dataFam,+ -- **** Foreign Function Interface (FFI)+ cCall, stdCall, unsafe, safe, threadsafe, forImpD,+ -- **** Pragmas+ -- | Just inline supported so far+ inlineSpecNoPhase, inlineSpecPhase,+ pragInlD, pragSpecD,++ -- * Pretty-printer Ppr(..), pprint, pprExp, pprLit, pprPat, pprParendType ) where
Language/Haskell/TH/Lib.hs view
@@ -1,3 +1,4 @@+-- | -- TH.Lib contains lots of useful helper functions for -- generating and manipulating Template Haskell terms @@ -10,7 +11,7 @@ import Control.Monad( liftM, liftM2 ) ------------------------------------------------------------- Type synonyms+-- * Type synonyms ---------------------------------------------------------- type InfoQ = Q Info@@ -18,6 +19,7 @@ type FieldPatQ = Q FieldPat type ExpQ = Q Exp type DecQ = Q Dec+type DecsQ = Q [Dec] type ConQ = Q Con type TypeQ = Q Type type CxtQ = Q Cxt@@ -34,7 +36,7 @@ type InlineSpecQ = Q InlineSpec ------------------------------------------------------------- Lowercase pattern syntax functions+-- * Lowercase pattern syntax functions ---------------------------------------------------------- intPrimL :: Integer -> Lit@@ -51,6 +53,8 @@ charL = CharL stringL :: String -> Lit stringL = StringL+stringPrimL :: String -> Lit+stringPrimL = StringPrimL rationalL :: Rational -> Lit rationalL = RationalL @@ -88,6 +92,10 @@ sigP p t = do p' <- p t' <- t return (SigP p' t')+viewP :: ExpQ -> PatQ -> PatQ+viewP e p = do e' <- e+ p' <- p+ return (ViewP e' p') fieldPat :: Name -> PatQ -> FieldPatQ fieldPat n p = do p' <- p@@ -95,7 +103,7 @@ ---------------------------------------------------------------------------------- Stmt+-- * Stmt bindS :: PatQ -> ExpQ -> StmtQ bindS p e = liftM2 BindS p e@@ -110,7 +118,7 @@ parS _ = fail "No parallel comprehensions yet" ---------------------------------------------------------------------------------- Range+-- * Range fromR :: ExpQ -> RangeQ fromR x = do { a <- x; return (FromR a) } @@ -125,7 +133,7 @@ fromThenToR x y z = do { a <- x; b <- y; c <- z; return (FromThenToR a b c) } ---------------------------------------------------------------------------------- Body+-- * Body normalB :: ExpQ -> BodyQ normalB e = do { e1 <- e; return (NormalB e1) }@@ -134,7 +142,7 @@ guardedB ges = do { ges' <- sequence ges; return (GuardedB ges') } ---------------------------------------------------------------------------------- Guard+-- * Guard normalG :: ExpQ -> GuardQ normalG e = do { e1 <- e; return (NormalG e1) }@@ -151,14 +159,16 @@ return (PatG ss', e') } ---------------------------------------------------------------------------------- Match and Clause+-- * Match and Clause +-- | Use with 'caseE' match :: PatQ -> BodyQ -> [DecQ] -> MatchQ match p rhs ds = do { p' <- p; r' <- rhs; ds' <- sequence ds; return (Match p' r' ds') } +-- | Use with 'funD' clause :: [PatQ] -> BodyQ -> [DecQ] -> ClauseQ clause ps r ds = do { ps' <- sequence ps; r' <- r;@@ -167,8 +177,9 @@ ------------------------------------------------------------------------------ Exp+-- * Exp +-- | Dynamically binding a variable (unhygenic) dyn :: String -> Q Exp dyn s = return (VarE (mkName s)) @@ -208,7 +219,8 @@ e' <- e return (LamE ps' e') -lam1E :: PatQ -> ExpQ -> ExpQ -- Single-arg lambda+-- | Single-arg lambda+lam1E :: PatQ -> ExpQ -> ExpQ lam1E p e = lamE [p] e tupE :: [ExpQ] -> ExpQ@@ -232,21 +244,6 @@ arithSeqE :: RangeQ -> ExpQ arithSeqE r = do { r' <- r; return (ArithSeqE r') } --- arithSeqE Shortcuts-fromE :: ExpQ -> ExpQ-fromE x = do { a <- x; return (ArithSeqE (FromR a)) } --fromThenE :: ExpQ -> ExpQ -> ExpQ-fromThenE x y = do { a <- x; b <- y; return (ArithSeqE (FromThenR a b)) } --fromToE :: ExpQ -> ExpQ -> ExpQ-fromToE x y = do { a <- x; b <- y; return (ArithSeqE (FromToR a b)) } --fromThenToE :: ExpQ -> ExpQ -> ExpQ -> ExpQ-fromThenToE x y z = do { a <- x; b <- y; c <- z;- return (ArithSeqE (FromThenToR a b c)) } --- End arithSeqE shortcuts- listE :: [ExpQ] -> ExpQ listE es = do { es1 <- sequence es; return (ListE es1) } @@ -265,8 +262,23 @@ fieldExp :: Name -> ExpQ -> Q (Name, Exp) fieldExp s e = do { e' <- e; return (s,e') } +-- ** 'arithSeqE' Shortcuts+fromE :: ExpQ -> ExpQ+fromE x = do { a <- x; return (ArithSeqE (FromR a)) } ++fromThenE :: ExpQ -> ExpQ -> ExpQ+fromThenE x y = do { a <- x; b <- y; return (ArithSeqE (FromThenR a b)) } ++fromToE :: ExpQ -> ExpQ -> ExpQ+fromToE x y = do { a <- x; b <- y; return (ArithSeqE (FromToR a b)) } ++fromThenToE :: ExpQ -> ExpQ -> ExpQ -> ExpQ+fromThenToE x y z = do { a <- x; b <- y; c <- z;+ return (ArithSeqE (FromThenToR a b c)) } ++ ---------------------------------------------------------------------------------- Dec+-- * Dec valD :: PatQ -> BodyQ -> [DecQ] -> DecQ valD p b ds = @@ -402,7 +414,7 @@ ---------------------------------------------------------------------------------- Type+-- * Type forallT :: [TyVarBndr] -> CxtQ -> TypeQ -> TypeQ forallT tvars ctxt ty = do@@ -449,7 +461,7 @@ return (v, s, t) ---------------------------------------------------------------------------------- Kind+-- * Kind plainTV :: Name -> TyVarBndr plainTV = PlainTV@@ -464,14 +476,14 @@ arrowK = ArrowK ---------------------------------------------------------------------------------- Callconv+-- * Callconv cCall, stdCall :: Callconv cCall = CCall stdCall = StdCall ---------------------------------------------------------------------------------- Safety+-- * Safety unsafe, safe, threadsafe :: Safety unsafe = Unsafe@@ -479,7 +491,7 @@ threadsafe = Threadsafe ---------------------------------------------------------------------------------- InlineSpec+-- * InlineSpec inlineSpecNoPhase :: Bool -> Bool -> InlineSpecQ inlineSpecNoPhase inline conlike@@ -490,20 +502,20 @@ = return $ InlineSpec inline conlike (Just (beforeFrom, phase)) ---------------------------------------------------------------------------------- FunDep+-- * FunDep funDep :: [Name] -> [Name] -> FunDep funDep = FunDep ---------------------------------------------------------------------------------- FamFlavour+-- * FamFlavour typeFam, dataFam :: FamFlavour typeFam = TypeFam dataFam = DataFam ----------------------------------------------------------------- Useful helper functions+-- * Useful helper functions combine :: [([(Name, Name)], Pat)] -> ([(Name, Name)], [Pat]) combine pairs = foldr f ([],[]) pairs@@ -531,6 +543,7 @@ rename (ListP pats) = do { pairs <- mapM rename pats; g(combine pairs) } where g (es,ps) = return (es,ListP ps) rename (SigP {}) = fail "rename: Don't know how to do SigP yet"+rename (ViewP {}) = fail "rename: Don't know how to do ViewP yet" genpat :: Pat -> Q ((Name -> ExpQ), Pat) genpat p = do { (env,p2) <- rename p; return (alpha env,p2) }@@ -541,7 +554,7 @@ Nothing -> varE s appsE :: [ExpQ] -> ExpQ-appsE [] = error "appsExp []"+appsE [] = error "appsE []" appsE [x] = x appsE (x:y:zs) = appsE ( (appE x y) : zs )
Language/Haskell/TH/Ppr.hs view
@@ -1,4 +1,4 @@--- TH.Ppr contains a prettyprinter for the+-- | contains a prettyprinter for the -- Template Haskell datatypes module Language.Haskell.TH.Ppr where@@ -43,8 +43,8 @@ ------------------------------ instance Ppr Info where- ppr (ClassI d) = ppr d- ppr (TyConI d) = ppr d+ ppr (ClassI d is) = ppr d $$ vcat (map ppr is)+ ppr (TyConI d) = ppr d ppr (PrimTyConI name arity is_unlifted) = text "Primitive" <+> (if is_unlifted then text "unlifted" else empty)@@ -62,6 +62,15 @@ = 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 @@ -164,6 +173,7 @@ pprLit i (IntegerL x) = parensIf (i > noPrec && x < 0) (integer x) pprLit _ (CharL c) = text (show c) pprLit _ (StringL s) = text (show s)+pprLit _ (StringPrimL s) = text (show s) <> char '#' pprLit i (RationalL rat) = parensIf (i > noPrec) $ rational rat ------------------------------@@ -191,6 +201,7 @@ map (\(s,p) -> ppr s <+> equals <+> ppr p) fs) pprPat _ (ListP ps) = brackets $ sep $ punctuate comma $ map ppr ps pprPat i (SigP p t) = parensIf (i > noPrec) $ ppr p <+> text "::" <+> ppr t+pprPat _ (ViewP e p) = parens $ pprExp noPrec e <+> text "->" <+> pprPat noPrec p ------------------------------ instance Ppr Dec where@@ -242,15 +253,15 @@ ppr_data :: Doc -> Cxt -> Name -> Doc -> [Con] -> [Name] -> Doc ppr_data maybeInst ctxt t argsDoc cs decs- = text "data" <+> maybeInst- <+> pprCxt ctxt- <+> ppr t <+> argsDoc- <+> sep (pref $ map ppr cs)- $$ if null decs- then empty- else nest nestDepth- $ text "deriving"- <+> parens (hsep $ punctuate comma $ map ppr decs)+ = sep [text "data" <+> maybeInst+ <+> pprCxt ctxt+ <+> ppr t <+> argsDoc,+ nest nestDepth (sep (pref $ map ppr cs)),+ if null decs+ then empty+ else nest nestDepth+ $ text "deriving"+ <+> parens (hsep $ punctuate comma $ map ppr decs)] where pref :: [Doc] -> [Doc] pref [] = [] -- No constructors; can't happen in H98@@ -258,15 +269,15 @@ ppr_newtype :: Doc -> Cxt -> Name -> Doc -> Con -> [Name] -> Doc ppr_newtype maybeInst ctxt t argsDoc c decs- = text "newtype" <+> maybeInst- <+> pprCxt ctxt- <+> ppr t <+> argsDoc- <+> char '=' <+> ppr c- $$ if null decs- then empty- else nest nestDepth- $ text "deriving"- <+> parens (hsep $ punctuate comma $ map ppr decs)+ = sep [text "newtype" <+> maybeInst+ <+> pprCxt ctxt+ <+> ppr t <+> argsDoc,+ nest 2 (char '=' <+> ppr c),+ if null decs+ then empty+ else nest nestDepth+ $ text "deriving"+ <+> parens (hsep $ punctuate comma $ map ppr decs)] ppr_tySyn :: Doc -> Name -> Doc -> Type -> Doc ppr_tySyn maybeInst t argsDoc rhs@@ -343,7 +354,7 @@ <+> pprName' Infix c <+> pprStrictType st2 ppr (ForallC ns ctxt con) = text "forall" <+> hsep (map ppr ns)- <+> char '.' <+> pprCxt ctxt <+> ppr con+ <+> char '.' <+> sep [pprCxt ctxt, ppr con] ------------------------------ pprVarStrictType :: (Name, Strict, Type) -> Doc@@ -369,7 +380,7 @@ instance Ppr Type where ppr (ForallT tvars ctxt ty) = text "forall" <+> hsep (map ppr tvars) <+> text "."- <+> pprCxt ctxt <+> ppr ty+ <+> sep [pprCxt ctxt, ppr ty] ppr (SigT ty k) = ppr ty <+> text "::" <+> ppr k ppr ty = pprTyApp (split ty) @@ -409,7 +420,7 @@ pprCxt :: Cxt -> Doc pprCxt [] = empty pprCxt [t] = ppr t <+> text "=>"-pprCxt ts = parens (hsep $ punctuate comma $ map ppr ts) <+> text "=>"+pprCxt ts = parens (sep $ punctuate comma $ map ppr ts) <+> text "=>" ------------------------------ instance Ppr Pred where
Language/Haskell/TH/PprLib.hs view
@@ -1,5 +1,5 @@ --- Monadic front-end to Text.PrettyPrint.HughesPJ+-- | Monadic front-end to Text.PrettyPrint.HughesPJ module Language.Haskell.TH.PprLib (
Language/Haskell/TH/Quote.hs view
@@ -1,15 +1,18 @@ {-# LANGUAGE RankNTypes, ScopedTypeVariables #-} module Language.Haskell.TH.Quote( QuasiQuoter(..),- dataToQa, dataToExpQ, dataToPatQ+ dataToQa, dataToExpQ, dataToPatQ,+ quoteFile ) where import Data.Data import Language.Haskell.TH.Lib import Language.Haskell.TH.Syntax -data QuasiQuoter = QuasiQuoter { quoteExp :: String -> Q Exp,- quotePat :: String -> Q Pat }+data QuasiQuoter = QuasiQuoter { quoteExp :: String -> Q Exp,+ quotePat :: String -> Q Pat,+ quoteType :: String -> Q Type,+ quoteDec :: String -> Q [Dec] } dataToQa :: forall a k q. Data a => (Name -> k)@@ -60,3 +63,17 @@ -> a -> Q Pat dataToPatQ = dataToQa id litP conP++-- | 'quoteFile' takes a 'QuasiQuoter' and lifts it into one that read+-- the data out of a file. For example, suppose 'asmq' is an +-- assembly-language quoter, so that you can write [asmq| ld r1, r2 |]+-- as an expression. Then if you define @asmq_f = quoteFile asmq@, then+-- the quote [asmq_f| foo.s |] will take input from file "foo.s" instead+-- of the inline text+quoteFile :: QuasiQuoter -> QuasiQuoter+quoteFile (QuasiQuoter { quoteExp = qe, quotePat = qp, quoteType = qt, quoteDec = qd }) + = QuasiQuoter { quoteExp = get qe, quotePat = get qp, quoteType = get qt, quoteDec = get qd }+ where+ get :: (String -> Q a) -> String -> Q a+ get old_quoter file_name = do { file_cts <- runIO (readFile file_name) + ; old_quoter file_cts }
Language/Haskell/TH/Syntax.hs view
@@ -25,21 +25,22 @@ Q, runQ, report, recover, reify, location, runIO,+ isClassInstance, classInstances, - -- Names+ -- * Names Name(..), mkName, newName, nameBase, nameModule, showName, showName', NameIs(..), - -- The algebraic data types+ -- * The algebraic data types Dec(..), Exp(..), Con(..), Type(..), TyVarBndr(..), Kind(..),Cxt, Pred(..), Match(..), Clause(..), Body(..), Guard(..), Stmt(..),- Range(..), Lit(..), Pat(..), FieldExp, FieldPat, + Range(..), Lit(..), Pat(..), FieldExp, FieldPat, ClassInstance(..), Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..), InlineSpec(..), StrictType, VarStrictType, FunDep(..), FamFlavour(..), Info(..), Loc(..), CharPos, Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence, - -- Internal functions+ -- * Internal functions returnQ, bindQ, sequenceQ, NameFlavour(..), NameSpace (..), mkNameG_v, mkNameG_d, mkNameG_tc, Uniq, mkNameL, mkNameU,@@ -67,21 +68,26 @@ ----------------------------------------------------- class (Monad m, Functor m) => Quasi m where- -- Fresh names qNewName :: String -> m Name+ -- ^ Fresh names -- Error reporting and recovery- qReport :: Bool -> String -> m () -- Report an error (True) or warning (False)+ qReport :: Bool -> String -> m () -- ^ Report an error (True) or warning (False) -- ...but carry on; use 'fail' to stop- qRecover :: m a -> m a -> m a -- Recover from the monadic 'fail'- -- The first arg is the error handler+ qRecover :: m a -- ^ the error handler+ -> m a -- ^ action which may fail+ -> m a -- ^ Recover from the monadic 'fail' -- Inspect the type-checker's environment qReify :: Name -> m Info+ qClassInstances :: Name -> [Type] -> m [Name]+ -- Is (cls tys) an instance?+ -- Returns list of matching witnesses+ qLocation :: m Loc - -- Input/output (dangerous) qRunIO :: IO a -> m a+ -- ^ Input/output (dangerous) -----------------------------------------------------@@ -103,9 +109,10 @@ qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg) qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg) - qReify _ = badIO "reify"- qLocation = badIO "currentLocation"- qRecover _ _ = badIO "recover" -- Maybe we could fix this?+ qReify _ = badIO "reify"+ qClassInstances _ _ = badIO "classInstances"+ qLocation = badIO "currentLocation"+ qRecover _ _ = badIO "recover" -- Maybe we could fix this? qRunIO m = m @@ -147,13 +154,23 @@ report :: Bool -> String -> Q () report b s = Q (qReport b s) -recover :: Q a -> Q a -> Q a+recover :: Q a -- ^ recover with this one+ -> Q a -- ^ failing action+ -> Q a recover (Q r) (Q m) = Q (qRecover r m) -- | '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 [Name]+classInstances cls tys = Q (qClassInstances cls tys)++isClassInstance :: Name -> [Type] -> Q Bool+isClassInstance cls tys = do { dfuns <- classInstances cls tys+ ; return (not (null dfuns)) }+ -- | 'location' gives you the 'Location' at which this -- computation is spliced. location :: Q Loc@@ -170,12 +187,13 @@ runIO m = Q (qRunIO m) instance Quasi Q where- qNewName = newName- qReport = report- qRecover = recover - qReify = reify- qLocation = location- qRunIO = runIO+ qNewName = newName+ qReport = report+ qRecover = recover + qReify = reify+ qClassInstances = classInstances+ qLocation = location+ qRunIO = runIO ----------------------------------------------------@@ -311,39 +329,48 @@ -- Names ----------------------------------------------------- --- For "global" names (NameG) we need a totally unique name,+-- |+-- For "global" names ('NameG') we need a totally unique name, -- so we must include the name-space of the thing ----- For unique-numbered things (NameU), we've got a unique reference+-- For unique-numbered things ('NameU'), we've got a unique reference -- anyway, so no need for name space ----- For dynamically bound thing (NameS) we probably want them to +-- For dynamically bound thing ('NameS') we probably want them to -- in a context-dependent way, so again we don't want the name -- space. For example:--- let v = mkName "T" in [| data $v = $v |]+--+-- > let v = mkName "T" in [| data $v = $v |]+-- -- Here we use the same Name for both type constructor and data constructor-+--+--+-- NameL and NameG are bound *outside* the TH syntax tree+-- either globally (NameG) or locally (NameL). Ex:+--+-- > f x = $(h [| (map, x) |])+--+-- 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 data Name = Name OccName NameFlavour deriving (Typeable, Data) data NameFlavour- = NameS -- An unqualified name; dynamically bound- | NameQ ModName -- A qualified name; dynamically bound+ = NameS -- ^ An unqualified name; dynamically bound+ | NameQ ModName -- ^ A qualified name; dynamically bound - | NameU Int# -- A unique local name+ | NameU Int# -- ^ A unique local name - -- The next two are for lexically-scoped names that- -- are bound *outside* the TH syntax tree, - -- either globally (NameG) or locally (NameL)- -- e.g. f x = $(h [| (map, x) |]- -- 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 - | NameL Int# -- - | NameG NameSpace PkgName ModName -- An original name (occurrences only, not binders)+ | 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 deriving ( Typeable ) +-- | -- Although the NameFlavour type is abstract, the Data instance is not. The reason for this -- is that currently we use Data to serialize values in annotations, and in order for that to -- work for Template Haskell names introduced via the 'x syntax we need gunfold on NameFlavour@@ -386,14 +413,15 @@ [con_NameS, con_NameQ, con_NameU, con_NameL, con_NameG] -data NameSpace = VarName -- Variables- | DataName -- Data constructors - | TcClsName -- Type constructors and classes; Haskell has them+data NameSpace = VarName -- ^ Variables+ | DataName -- ^ Data constructors + | TcClsName -- ^ Type constructors and classes; Haskell has them -- in the same name space for now. deriving( Eq, Ord, Data, Typeable ) type Uniq = Int +-- | Base, unqualified name. nameBase :: Name -> String nameBase (Name occ _) = occString occ @@ -403,14 +431,16 @@ nameModule _ = Nothing 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 -- -- Parse the string to see if it has a "." in it -- so we know whether to generate a qualified or unqualified name -- It's a bit tricky because we need to parse --- Foo.Baz.x as Qual Foo.Baz x+--+-- > Foo.Baz.x as Qual Foo.Baz x+-- -- So we parse it from back to front mkName str = split [] (reverse str)@@ -427,14 +457,17 @@ -- This rather bizarre case actually happened; (.&.) is in Data.Bits split occ (c:rev) = split (c:occ) rev -mkNameU :: String -> Uniq -> Name -- Only used internally+-- | Only used internally+mkNameU :: String -> Uniq -> Name mkNameU s (I# u) = Name (mkOccName s) (NameU u) -mkNameL :: String -> Uniq -> Name -- Only used internally+-- | Only used internally+mkNameL :: String -> Uniq -> Name mkNameL s (I# u) = Name (mkOccName s) (NameL u) -mkNameG :: NameSpace -> String -> String -> String -> Name -- Used for 'x etc, but not available-mkNameG ns pkg modu occ -- to the programmer+-- | Used for 'x etc, but not available to the programmer+mkNameG :: NameSpace -> String -> String -> String -> Name+mkNameG ns pkg modu occ = Name (mkOccName occ) (NameG ns (mkPkgName pkg) (mkModName modu)) mkNameG_v, mkNameG_tc, mkNameG_d :: String -> String -> String -> Name@@ -525,8 +558,8 @@ show = showName -- Tuple data and type constructors-tupleDataName :: Int -> Name -- Data constructor-tupleTypeName :: Int -> Name -- Type constructor+tupleDataName :: Int -> Name -- ^ Data constructor+tupleTypeName :: Int -> Name -- ^ Type constructor tupleDataName 0 = mk_tup_name 0 DataName tupleDataName 1 = error "tupleDataName 1"@@ -566,8 +599,14 @@ -- ----------------------------------------------------- -data Info - = ClassI Dec+-- | 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+ [ClassInstance] -- The instances of that class+ | ClassOpI Name -- The class op itself Type -- Type of the class-op (fully polymoprhic)@@ -601,6 +640,16 @@ 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 )+ data Fixity = Fixity Int FixityDirection deriving( Eq, Show, Data, Typeable ) data FixityDirection = InfixL | InfixR | InfixN@@ -621,7 +670,7 @@ data Lit = CharL Char | StringL String - | IntegerL Integer -- Used for overloaded and non-overloaded+ | IntegerL Integer -- ^ Used for overloaded and non-overloaded -- literals. We don't have a good way to -- represent non-overloaded literals at -- the moment. Maybe that doesn't matter?@@ -630,66 +679,73 @@ | WordPrimL Integer | FloatPrimL Rational | DoublePrimL Rational+ | StringPrimL String -- ^ A primitive C-style string, type Addr# deriving( Show, Eq, Data, Typeable ) -- We could add Int, Float, Double etc, as we do in HsLit, -- but that could complicate the -- suppposedly-simple TH.Syntax literal type +-- | Pattern in Haskell given in @{}@ data Pat - = LitP Lit -- { 5 or 'c' }- | VarP Name -- { x }- | TupP [Pat] -- { (p1,p2) }- | ConP Name [Pat] -- data T1 = C1 t1 t2; {C1 p1 p1} = e - | InfixP Pat Name Pat -- foo ({x :+ y}) = e - | TildeP Pat -- { ~p }- | BangP Pat -- { !p }- | AsP Name Pat -- { x @ p }- | WildP -- { _ }- | RecP Name [FieldPat] -- f (Pt { pointx = x }) = g x- | ListP [ Pat ] -- { [1,2,3] }- | SigP Pat Type -- { p :: t }+ = LitP Lit -- ^ @{ 5 or 'c' }@+ | VarP Name -- ^ @{ x }@+ | TupP [Pat] -- ^ @{ (p1,p2) }@+ | ConP Name [Pat] -- ^ @data T1 = C1 t1 t2; {C1 p1 p1} = e@+ | InfixP Pat Name Pat -- ^ @foo ({x :+ y}) = e@+ | TildeP Pat -- ^ @{ ~p }@+ | BangP Pat -- ^ @{ !p }@+ | AsP Name Pat -- ^ @{ x \@ p }@+ | WildP -- ^ @{ _ }@+ | RecP Name [FieldPat] -- ^ @f (Pt { pointx = x }) = g x@+ | ListP [ Pat ] -- ^ @{ [1,2,3] }@+ | SigP Pat Type -- ^ @{ p :: t }@+ | ViewP Exp Pat -- ^ @{ e -> p }@ deriving( Show, Eq, Data, Typeable ) type FieldPat = (Name,Pat) -data Match = Match Pat Body [Dec]- -- case e of { pat -> body where decs } +data Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@ deriving( Show, Eq, Data, Typeable ) data Clause = Clause [Pat] Body [Dec]- -- f { p1 p2 = body where decs }+ -- ^ @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. [ f x | x <- xs ] is represented by--- CompE [BindS (VarP x) (VarE xs), NoBindS (AppE (VarE f) (VarE x))]+--+-- 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 - | LitE Lit -- { 5 or 'c'}- | AppE Exp Exp -- { f x }+ = VarE Name -- ^ @{ x }@+ | ConE Name -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2 @+ | LitE Lit -- ^ @{ 5 or 'c'}@+ | AppE Exp Exp -- ^ @{ f x }@ - | InfixE (Maybe Exp) Exp (Maybe Exp) -- {x + y} or {(x+)} or {(+ x)} or {(+)}+ | 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? -- Maybe there should be a var-or-con type? -- Or maybe we should leave it to the String itself? - | LamE [Pat] Exp -- { \ p1 p2 -> e }- | TupE [Exp] -- { (e1,e2) } - | CondE Exp Exp Exp -- { if e1 then e2 else e3 }- | 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 ] }- | ArithSeqE Range -- { [ 1 ,2 .. 10 ] }- | ListE [ Exp ] -- { [1,2,3] }- | SigE Exp Type -- { e :: t }- | RecConE Name [FieldExp] -- { T { x = y, z = w } }- | RecUpdE Exp [FieldExp] -- { (f x) { z = w } }+ | LamE [Pat] Exp -- ^ @{ \ p1 p2 -> e }@+ | TupE [Exp] -- ^ @{ (e1,e2) } @+ | CondE Exp Exp Exp -- ^ @{ if e1 then e2 else e3 }@+ | 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 ] }@+ | ArithSeqE Range -- ^ @{ [ 1 ,2 .. 10 ] }@+ | ListE [ Exp ] -- ^ @{ [1,2,3] }@+ | SigE Exp Type -- ^ @{ e :: t }@+ | RecConE Name [FieldExp] -- ^ @{ T { x = y, z = w } }@+ | RecUpdE Exp [FieldExp] -- ^ @{ (f x) { z = w } }@ deriving( Show, Eq, Data, Typeable ) type FieldExp = (Name,Exp)@@ -697,8 +753,8 @@ -- Omitted: implicit parameters data Body- = GuardedB [(Guard,Exp)] -- f p { | e1 = e2 | e3 = e4 } where ds- | NormalB Exp -- f p { = e } 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@@ -718,35 +774,37 @@ deriving( Show, Eq, Data, Typeable ) data Dec - = FunD Name [Clause] -- { f p1 p2 = b where decs }- | ValD Pat Body [Dec] -- { p = b where decs }+ = FunD Name [Clause] -- ^ @{ f p1 p2 = b where decs }@+ | ValD Pat Body [Dec] -- ^ @{ p = b where decs }@ | DataD Cxt Name [TyVarBndr] - [Con] [Name] -- { data Cxt x => T x = A x | B (T x)- -- deriving (Z,W)}+ [Con] [Name] -- ^ @{ data Cxt x => T x = A x | B (T x)+ -- deriving (Z,W)}@ | NewtypeD Cxt Name [TyVarBndr] - Con [Name] -- { newtype Cxt x => T x = A (B x)- -- deriving (Z,W)}- | TySynD Name [TyVarBndr] Type -- { type T x = (x,x) }+ Con [Name] -- ^ @{ newtype Cxt x => T x = A (B x)+ -- deriving (Z,W)}@+ | TySynD Name [TyVarBndr] Type -- ^ @{ type T x = (x,x) }@ | ClassD Cxt Name [TyVarBndr] - [FunDep] [Dec] -- { class Eq a => Ord a where ds }- | InstanceD Cxt Type [Dec] -- { instance Show w => Show [w]- -- where ds }- | SigD Name Type -- { length :: [a] -> Int }+ [FunDep] [Dec] -- ^ @{ class Eq a => Ord a where ds }@+ | InstanceD Cxt Type [Dec] -- ^ @{ instance Show w => Show [w]+ -- where ds }@+ | SigD Name Type -- ^ @{ length :: [a] -> Int }@ | ForeignD Foreign- -- pragmas- | PragmaD Pragma -- { {-# INLINE [1] foo #-} }- -- type families (may also appear in [Dec] of 'ClassD' and 'InstanceD')++ -- | pragmas+ | PragmaD Pragma -- ^ @{ {-# INLINE [1] foo #-} }@++ -- | type families (may also appear in [Dec] of 'ClassD' and 'InstanceD') | FamilyD FamFlavour Name - [TyVarBndr] (Maybe Kind) -- { type family T a b c :: * }+ [TyVarBndr] (Maybe Kind) -- ^ @{ type family T a b c :: * }@ | DataInstD Cxt Name [Type]- [Con] [Name] -- { data instance Cxt x => T [x] = A x + [Con] [Name] -- ^ @{ data instance Cxt x => T [x] = A x -- | B (T x)- -- deriving (Z,W)}+ -- deriving (Z,W)}@ | NewtypeInstD Cxt Name [Type]- Con [Name] -- { newtype instance Cxt x => T [x] = A (B x)- -- deriving (Z,W)}- | TySynInstD Name [Type] Type -- { type instance T (Maybe x) = (x,x) }+ Con [Name] -- ^ @{ newtype instance Cxt x => T [x] = A (B x)+ -- deriving (Z,W)}@+ | TySynInstD Name [Type] Type -- ^ @{ type instance T (Maybe x) = (x,x) }@ deriving( Show, Eq, Data, Typeable ) data FunDep = FunDep [Name] [Name]@@ -775,40 +833,40 @@ (Maybe (Bool, Int)) -- False: before phase; True: from phase deriving( Show, Eq, Data, Typeable ) -type Cxt = [Pred] -- (Eq a, Ord b)+type Cxt = [Pred] -- ^ @(Eq a, Ord b)@ -data Pred = ClassP Name [Type] -- Eq (Int, a)- | EqualP Type Type -- F a ~ Bool+data Pred = ClassP Name [Type] -- ^ @Eq (Int, a)@+ | EqualP Type Type -- ^ @F a ~ Bool@ deriving( Show, Eq, Data, Typeable ) data Strict = IsStrict | NotStrict deriving( Show, Eq, Data, Typeable ) -data Con = NormalC Name [StrictType] -- C Int a- | RecC Name [VarStrictType] -- C { v :: Int, w :: a }- | InfixC StrictType Name StrictType -- Int :+ a- | ForallC [TyVarBndr] Cxt Con -- forall a. Eq a => C [a]+data Con = NormalC Name [StrictType] -- ^ @C Int a@+ | RecC Name [VarStrictType] -- ^ @C { v :: Int, w :: a }@+ | InfixC StrictType Name StrictType -- ^ @Int :+ a@+ | ForallC [TyVarBndr] Cxt Con -- ^ @forall a. Eq a => C [a]@ deriving( Show, Eq, Data, Typeable ) type StrictType = (Strict, Type) type VarStrictType = (Name, Strict, Type) -data Type = ForallT [TyVarBndr] Cxt Type -- forall <vars>. <ctxt> -> <type>- | VarT Name -- a- | ConT Name -- T- | TupleT Int -- (,), (,,), etc.- | ArrowT -- ->- | ListT -- []- | AppT Type Type -- T a b- | SigT Type Kind -- t :: k+data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall <vars>. <ctxt> -> <type>@+ | VarT Name -- ^ @a@+ | ConT Name -- ^ @T@+ | TupleT Int -- ^ @(,), (,,), etc.@+ | ArrowT -- ^ @->@+ | ListT -- ^ @[]@+ | AppT Type Type -- ^ @T a b@+ | SigT Type Kind -- ^ @t :: k@ deriving( Show, Eq, Data, Typeable ) -data TyVarBndr = PlainTV Name -- a- | KindedTV Name Kind -- (a :: k)+data TyVarBndr = PlainTV Name -- ^ @a@+ | KindedTV Name Kind -- ^ @(a :: k)@ deriving( Show, Eq, Data, Typeable ) -data Kind = StarK -- '*'- | ArrowK Kind Kind -- k1 -> k2+data Kind = StarK -- ^ @'*'@+ | ArrowK Kind Kind -- ^ @k1 -> k2@ deriving( Show, Eq, Data, Typeable ) -----------------------------------------------------
template-haskell.cabal view
@@ -1,5 +1,5 @@ name: template-haskell-version: 2.4.0.1+version: 2.5.0.0 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org