Commit 8bcb2068 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺

Fold template-haskell.git into ghc.git (re #8545)

At the time of merge, template-haskell.git was at
[9bcc122819a6f4a2ae7ad569717324b8368e801c/template-haskell]
Signed-off-by: Herbert Valerio Riedel's avatarHerbert Valerio Riedel <hvr@gnu.org>
parents 670599db 717fc49f
GNUmakefile
dist-install
ghc.mk
The Glasgow Haskell Compiler License
Copyright 2002-2007, The University Court of the University of Glasgow.
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
- Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
- Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
- Neither name of the University nor the names of its contributors may be
used to endorse or promote products derived from this software without
specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
DAMAGE.
{- | 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
Q,
runQ,
-- ** Administration: errors, locations and IO
reportError, -- :: String -> Q ()
reportWarning, -- :: String -> Q ()
report, -- :: Bool -> String -> Q ()
recover, -- :: Q a -> Q a -> Q a
location, -- :: Q Loc
Loc(..),
runIO, -- :: IO a -> Q a
-- ** Querying the compiler
-- *** Reify
reify, -- :: Name -> Q Info
reifyModule,
thisModule,
Info(..), ModuleInfo(..),
InstanceDec,
ParentName,
Arity,
Unlifted,
-- *** Name lookup
lookupTypeName, -- :: String -> Q (Maybe Name)
lookupValueName, -- :: String -> Q (Maybe Name)
-- *** Instance lookup
reifyInstances,
isInstance,
-- *** Roles lookup
reifyRoles,
-- *** Annotation lookup
reifyAnnotations, AnnLookup(..),
-- * Typed expressions
TExp, unType,
-- * 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 (@$( ... )@)
-- ** Declarations
Dec(..), Con(..), Clause(..),
Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..),
Inline(..), RuleMatch(..), Phases(..), RuleBndr(..), AnnTarget(..),
FunDep(..), FamFlavour(..), TySynEqn(..),
Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,
-- ** Expressions
Exp(..), Match(..), Body(..), Guard(..), Stmt(..), Range(..), Lit(..),
-- ** Patterns
Pat(..), FieldExp, FieldPat,
-- ** Types
Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred, Syntax.Role(..),
-- * Library functions
-- ** Abbreviations
InfoQ, ExpQ, DecQ, DecsQ, ConQ, TypeQ, TyLitQ, CxtQ, PredQ, MatchQ, ClauseQ,
BodyQ, GuardQ, StmtQ, RangeQ, StrictTypeQ, VarStrictTypeQ, PatQ, FieldPatQ,
RuleBndrQ, TySynEqnQ,
-- ** Constructors lifted to 'Q'
-- *** Literals
intPrimL, wordPrimL, floatPrimL, doublePrimL, integerL, rationalL,
charL, stringL, stringPrimL,
-- *** Patterns
litP, varP, tupP, conP, uInfixP, parensP, infixP,
tildeP, bangP, asP, wildP, recP,
listP, sigP, viewP,
fieldPat,
-- *** Pattern Guards
normalB, guardedB, normalG, normalGE, patG, patGE, match, clause,
-- *** Expressions
dyn, global, varE, conE, litE, appE, uInfixE, parensE,
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,
-- **** Statements
doE, compE,
bindS, letS, noBindS, parS,
-- *** Types
forallT, varT, conT, appT, arrowT, equalityT, listT, tupleT, sigT, litT,
promotedT, promotedTupleT, promotedNilT, promotedConsT,
-- **** Type literals
numTyLit, strTyLit,
-- **** Strictness
isStrict, notStrict, strictType, varStrictType,
-- **** Class Contexts
cxt, normalC, recC, infixC, forallC,
-- *** Kinds
varK, conK, tupleK, arrowK, listK, appK, starK, constraintK,
-- *** Roles
nominalR, representationalR, phantomR, inferR,
-- *** Top Level Declarations
-- **** Data
valD, funD, tySynD, dataD, newtypeD,
-- **** Class
classD, instanceD, sigD,
-- **** Role annotations
roleAnnotD,
-- **** Type Family / Data Family
familyNoKindD, familyKindD, dataInstD,
closedTypeFamilyNoKindD, closedTypeFamilyKindD,
newtypeInstD, tySynInstD,
typeFam, dataFam, tySynEqn,
-- **** Foreign Function Interface (FFI)
cCall, stdCall, unsafe, safe, forImpD,
-- **** Pragmas
ruleVar, typedRuleVar,
pragInlD, pragSpecD, pragSpecInlD, pragSpecInstD, pragRuleD, pragAnnD,
-- * Pretty-printer
Ppr(..), pprint, pprExp, pprLit, pprPat, pprParendType
) where
import Language.Haskell.TH.Syntax as Syntax
import Language.Haskell.TH.Lib
import Language.Haskell.TH.Ppr
This diff is collapsed.
This diff is collapsed.
{-# LANGUAGE FlexibleInstances, MagicHash #-}
-- | Monadic front-end to Text.PrettyPrint
module Language.Haskell.TH.PprLib (
-- * The document type
Doc, -- Abstract, instance of Show
PprM,
-- * Primitive Documents
empty,
semi, comma, colon, space, equals, arrow,
lparen, rparen, lbrack, rbrack, lbrace, rbrace,
-- * Converting values into documents
text, char, ptext,
int, integer, float, double, rational,
-- * Wrapping documents in delimiters
parens, brackets, braces, quotes, doubleQuotes,
-- * Combining documents
(<>), (<+>), hcat, hsep,
($$), ($+$), vcat,
sep, cat,
fsep, fcat,
nest,
hang, punctuate,
-- * Predicates on documents
isEmpty,
to_HPJ_Doc, pprName, pprName'
) where
import Language.Haskell.TH.Syntax
(Name(..), showName', NameFlavour(..), NameIs(..))
import qualified Text.PrettyPrint as HPJ
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, liftM2, ap)
import Data.Map ( Map )
import qualified Data.Map as Map ( lookup, insert, empty )
import GHC.Base (Int(..))
infixl 6 <>
infixl 6 <+>
infixl 5 $$, $+$
-- ---------------------------------------------------------------------------
-- The interface
-- The primitive Doc values
instance Show Doc where
show d = HPJ.render (to_HPJ_Doc d)
isEmpty :: Doc -> PprM Bool; -- ^ Returns 'True' if the document is empty
empty :: Doc; -- ^ An empty document
semi :: Doc; -- ^ A ';' character
comma :: Doc; -- ^ A ',' character
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
rbrack :: Doc; -- ^ A ']' character
lbrace :: Doc; -- ^ A '{' character
rbrace :: Doc; -- ^ A '}' character
text :: String -> Doc
ptext :: String -> Doc
char :: Char -> Doc
int :: Int -> Doc
integer :: Integer -> Doc
float :: Float -> Doc
double :: Double -> Doc
rational :: Rational -> Doc
parens :: Doc -> Doc; -- ^ Wrap document in @(...)@
brackets :: Doc -> Doc; -- ^ Wrap document in @[...]@
braces :: Doc -> Doc; -- ^ Wrap document in @{...}@
quotes :: Doc -> Doc; -- ^ Wrap document in @\'...\'@
doubleQuotes :: Doc -> Doc; -- ^ Wrap document in @\"...\"@
-- Combining @Doc@ values
(<>) :: Doc -> Doc -> Doc; -- ^Beside
hcat :: [Doc] -> Doc; -- ^List version of '<>'
(<+>) :: Doc -> Doc -> Doc; -- ^Beside, separated by space
hsep :: [Doc] -> Doc; -- ^List version of '<+>'
($$) :: Doc -> Doc -> Doc; -- ^Above; if there is no
-- overlap it \"dovetails\" the two
($+$) :: Doc -> Doc -> Doc; -- ^Above, without dovetailing.
vcat :: [Doc] -> Doc; -- ^List version of '$$'
cat :: [Doc] -> Doc; -- ^ Either hcat or vcat
sep :: [Doc] -> Doc; -- ^ Either hsep or vcat
fcat :: [Doc] -> Doc; -- ^ \"Paragraph fill\" version of cat
fsep :: [Doc] -> Doc; -- ^ \"Paragraph fill\" version of sep
nest :: Int -> Doc -> Doc; -- ^ Nested
-- GHC-specific ones.
hang :: Doc -> Int -> Doc -> Doc; -- ^ @hang d1 n d2 = sep [d1, nest n d2]@
punctuate :: Doc -> [Doc] -> [Doc]; -- ^ @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@
-- ---------------------------------------------------------------------------
-- The "implementation"
type State = (Map Name Name, Int)
data PprM a = PprM { runPprM :: State -> (a, State) }
pprName :: Name -> Doc
pprName = pprName' Alone
pprName' :: NameIs -> Name -> Doc
pprName' ni n@(Name o (NameU _))
= PprM $ \s@(fm, i@(I# i'))
-> let (n', s') = case Map.lookup n fm of
Just d -> (d, s)
Nothing -> let n'' = Name o (NameU i')
in (n'', (Map.insert n n'' fm, i + 1))
in (HPJ.text $ showName' ni n', s')
pprName' ni n = text $ showName' ni n
{-
instance Show Name where
show (Name occ (NameU u)) = occString occ ++ "_" ++ show (I# u)
show (Name occ NameS) = occString occ
show (Name occ (NameG ns m)) = modString m ++ "." ++ occString occ
data Name = Name OccName NameFlavour
data NameFlavour
| NameU Int# -- A unique local name
-}
to_HPJ_Doc :: Doc -> HPJ.Doc
to_HPJ_Doc d = fst $ runPprM d (Map.empty, 0)
instance Functor PprM where
fmap = liftM
instance Applicative PprM where
pure = return
(<*>) = ap
instance Monad PprM where
return x = PprM $ \s -> (x, s)
m >>= k = PprM $ \s -> let (x, s') = runPprM m s
in runPprM (k x) s'
type Doc = PprM HPJ.Doc
-- The primitive Doc values
isEmpty = liftM HPJ.isEmpty
empty = return HPJ.empty
semi = return HPJ.semi
comma = return HPJ.comma
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
rbrack = return HPJ.rbrack
lbrace = return HPJ.lbrace
rbrace = return HPJ.rbrace
text = return . HPJ.text
ptext = return . HPJ.ptext
char = return . HPJ.char
int = return . HPJ.int
integer = return . HPJ.integer
float = return . HPJ.float
double = return . HPJ.double
rational = return . HPJ.rational
parens = liftM HPJ.parens
brackets = liftM HPJ.brackets
braces = liftM HPJ.braces
quotes = liftM HPJ.quotes
doubleQuotes = liftM HPJ.doubleQuotes
-- Combining @Doc@ values
(<>) = liftM2 (HPJ.<>)
hcat = liftM HPJ.hcat . sequence
(<+>) = liftM2 (HPJ.<+>)
hsep = liftM HPJ.hsep . sequence
($$) = liftM2 (HPJ.$$)
($+$) = liftM2 (HPJ.$+$)
vcat = liftM HPJ.vcat . sequence
cat = liftM HPJ.cat . sequence
sep = liftM HPJ.sep . sequence
fcat = liftM HPJ.fcat . sequence
fsep = liftM HPJ.fsep . sequence
nest n = liftM (HPJ.nest n)
hang d1 n d2 = do d1' <- d1
d2' <- d2
return (HPJ.hang d1' n d2')
-- punctuate uses the same definition as Text.PrettyPrint
punctuate _ [] = []
punctuate p (d:ds) = go d ds
where
go d' [] = [d']
go d' (e:es) = (d' <> p) : go e es
{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
module Language.Haskell.TH.Quote(
QuasiQuoter(..),
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,
quoteType :: String -> Q Type,
quoteDec :: String -> Q [Dec] }
dataToQa :: forall a k q. Data a
=> (Name -> k)
-> (Lit -> Q q)
-> (k -> [Q q] -> Q q)
-> (forall b . Data b => b -> Maybe (Q q))
-> a
-> Q q
dataToQa mkCon mkLit appCon antiQ t =
case antiQ t of
Nothing ->
case constrRep constr of
AlgConstr _ ->
appCon (mkCon conName) conArgs
where
conName :: Name
conName =
case showConstr constr of
"(:)" -> 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
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 ->
mkLit $ rationalL n
CharConstr c ->
mkLit $ charL c
where
constr :: Constr
constr = toConstr t
Just y -> y
-- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the same
-- value. It takes a function to handle type-specific cases.
dataToExpQ :: Data a
=> (forall b . Data b => b -> Maybe (Q Exp))
-> a
-> Q Exp
dataToExpQ = dataToQa conE litE (foldl appE)
-- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same
-- value. It takes a function to handle type-specific cases.
dataToPatQ :: Data a
=> (forall b . Data b => b -> Maybe (Q Pat))
-> 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)
; addDependentFile file_name
; old_quoter file_cts }
This diff is collapsed.
module Main (main) where
import Distribution.Simple
main :: IO ()
main = defaultMain
Facilities for manipulating Haskell source code using Template Haskell.
name: template-haskell
version: 2.10.0.0
-- GHC 7.8.1 released with 2.9.0.0
license: BSD3
license-file: LICENSE
category: Template Haskell
maintainer: libraries@haskell.org
bug-reports: http://ghc.haskell.org/trac/ghc/newticket?component=Template%20Haskell
synopsis: Support library for Template Haskell
build-type: Simple
Cabal-Version: >= 1.10
description:
This package provides modules containing facilities for manipulating
Haskell source code using Template Haskell.
.
See <http://www.haskell.org/haskellwiki/Template_Haskell> for more
information.
source-repository head
type: git
location: http://git.haskell.org/packages/template-haskell.git
source-repository this
type: git
location: http://git.haskell.org/packages/template-haskell.git
tag: template-haskell-2.10.0.0-release
Library
default-language: Haskell2010
other-extensions:
DeriveDataTypeable
FlexibleInstances
MagicHash
PolymorphicComponents
RankNTypes
RoleAnnotations
ScopedTypeVariables
TemplateHaskell
UnboxedTuples
exposed-modules:
Language.Haskell.TH
Language.Haskell.TH.Lib
Language.Haskell.TH.Ppr
Language.Haskell.TH.PprLib
Language.Haskell.TH.Quote
Language.Haskell.TH.Syntax
build-depends:
base == 4.7.*,
containers == 0.5.*,
pretty == 1.1.*
-- We need to set the package name to template-haskell (without a
-- version number) as it's magic.
ghc-options: -Wall -package-name template-haskell
# This Makefile runs the tests using GHC's testsuite framework. It
# assumes the package is part of a GHC build tree with the testsuite
# installed in ../../../testsuite.
TOP=../../../testsuite
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
# difficult to test TH with profiling, because we have to build twice
test('dataToExpQUnit', omit_ways(prof_ways), compile, ['-v0'])
{-# LANGUAGE TemplateHaskell #-}
module Foo where
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import System.IO
$( do u1 <- runQ (dataToExpQ (const Nothing) ())
u2 <- runQ [| () |]
runIO $ print (u1 == u2)
runIO $ hFlush stdout
return []
)
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment