1 -----------------------------------------------------------------------------
2 -- The purpose of this module is to transform an HsExpr into a CoreExpr which
3 -- when evaluated, returns a (Meta.Q Meta.Exp) computation analogous to the
4 -- input HsExpr. We do this in the DsM monad, which supplies access to
5 -- CoreExpr's of the "smart constructors" of the Meta.Exp datatype.
7 -- It also defines a bunch of knownKeyNames, in the same way as is done
8 -- in prelude/PrelNames. It's much more convenient to do it here, becuase
9 -- otherwise we have to recompile PrelNames whenever we add a Name, which is
10 -- a Royal Pain (triggers other recompilation).
11 -----------------------------------------------------------------------------
14 module DsMeta( dsBracket, dsReify,
15 templateHaskellNames, qTyConName,
16 liftName, exprTyConName, declTyConName, typeTyConName,
17 decTyConName, typTyConName ) where
19 #include "HsVersions.h"
21 import {-# SOURCE #-} DsExpr ( dsExpr )
23 import MatchLit ( dsLit )
24 import DsUtils ( mkListExpr, mkStringLit, mkCoreTup, mkIntExpr )
27 import qualified Language.Haskell.THSyntax as M
29 import HsSyn ( Pat(..), HsExpr(..), Stmt(..), HsLit(..), HsOverLit(..),
30 Match(..), GRHSs(..), GRHS(..), HsBracket(..),
31 HsStmtContext(ListComp,DoExpr), ArithSeqInfo(..),
32 HsBinds(..), MonoBinds(..), HsConDetails(..),
33 TyClDecl(..), HsGroup(..),
34 HsReify(..), ReifyFlavour(..),
35 HsType(..), HsContext(..), HsPred(..), HsTyOp(..),
36 HsTyVarBndr(..), Sig(..), ForeignDecl(..),
37 InstDecl(..), ConDecl(..), BangType(..),
38 PendingSplice, splitHsInstDeclTy,
39 placeHolderType, tyClDeclNames,
40 collectHsBinders, collectPatBinders, collectPatsBinders,
41 hsTyVarName, hsConArgs, getBangType,
45 import PrelNames ( mETA_META_Name, rationalTyConName, negateName )
46 import MkIface ( ifaceTyThing )
47 import Name ( Name, nameOccName, nameModule )
48 import OccName ( isDataOcc, isTvOcc, occNameUserString )
49 -- To avoid clashes with DsMeta.varName we must make a local alias for OccName.varName
50 -- we do this by removing varName from the import of OccName above, making
51 -- a qualified instance of OccName and using OccNameAlias.varName where varName
52 -- ws previously used in this file.
53 import qualified OccName( varName, tcName )
55 import Module ( Module, mkThPkgModule, moduleUserString )
56 import Id ( Id, idType )
57 import Name ( mkKnownKeyExternalName )
58 import OccName ( mkOccFS )
61 import Type ( Type, TyThing(..), mkGenTyConApp )
62 import TyCon ( DataConDetails(..) )
63 import TysWiredIn ( stringTy )
65 import CoreUtils ( exprType )
66 import SrcLoc ( noSrcLoc )
67 import Maybe ( catMaybes )
68 import Panic ( panic )
69 import Unique ( mkPreludeTyConUnique, mkPreludeMiscIdUnique )
70 import BasicTypes ( NewOrData(..), StrictnessMark(..), isBoxed )
73 import FastString ( mkFastString )
75 -----------------------------------------------------------------------------
76 dsBracket :: HsBracket Name -> [PendingSplice] -> DsM CoreExpr
77 -- Returns a CoreExpr of type M.Expr
78 -- The quoted thing is parameterised over Name, even though it has
79 -- been type checked. We don't want all those type decorations!
81 dsBracket brack splices
82 = dsExtendMetaEnv new_bit (do_brack brack)
84 new_bit = mkNameEnv [(n, Splice e) | (n,e) <- splices]
86 do_brack (ExpBr e) = do { MkC e1 <- repE e ; return e1 }
87 do_brack (PatBr p) = do { MkC p1 <- repP p ; return p1 }
88 do_brack (TypBr t) = do { MkC t1 <- repTy t ; return t1 }
89 do_brack (DecBr ds) = do { MkC ds1 <- repTopDs ds ; return ds1 }
91 -----------------------------------------------------------------------------
92 dsReify :: HsReify Id -> DsM CoreExpr
93 -- Returns a CoreExpr of type reifyType --> M.Type
94 -- reifyDecl --> M.Decl
95 -- reifyFixty --> Q M.Fix
96 dsReify (ReifyOut ReifyType name)
97 = do { thing <- dsLookupGlobal name ;
98 -- By deferring the lookup until now (rather than doing it
99 -- in the type checker) we ensure that all zonking has
102 AnId id -> do { MkC e <- repTy (toHsType (idType id)) ;
104 other -> pprPanic "dsReify: reifyType" (ppr name)
107 dsReify r@(ReifyOut ReifyDecl name)
108 = do { thing <- dsLookupGlobal name ;
109 mb_d <- repTyClD (ifaceTyThing thing) ;
111 Just (MkC d) -> return d
112 Nothing -> pprPanic "dsReify" (ppr r)
115 {- -------------- Examples --------------------
119 gensym (unpackString "x"#) `bindQ` \ x1::String ->
120 lam (pvar x1) (var x1)
123 [| \x -> $(f [| x |]) |]
125 gensym (unpackString "x"#) `bindQ` \ x1::String ->
126 lam (pvar x1) (f (var x1))
130 -------------------------------------------------------
132 -------------------------------------------------------
134 repTopDs :: HsGroup Name -> DsM (Core (M.Q [M.Dec]))
136 = do { let { bndrs = groupBinders group } ;
137 ss <- mkGenSyms bndrs ;
139 -- Bind all the names mainly to avoid repeated use of explicit strings.
141 -- do { t :: String <- genSym "T" ;
142 -- return (Data t [] ...more t's... }
143 -- The other important reason is that the output must mention
144 -- only "T", not "Foo.T" where Foo is the current module
147 decls <- addBinds ss (do {
148 val_ds <- rep_binds (hs_valds group) ;
149 tycl_ds <- mapM repTyClD (hs_tyclds group) ;
150 inst_ds <- mapM repInstD (hs_instds group) ;
152 return (val_ds ++ catMaybes tycl_ds ++ inst_ds) }) ;
154 decl_ty <- lookupType declTyConName ;
155 let { core_list = coreList' decl_ty decls } ;
156 q_decs <- repSequenceQ decl_ty core_list ;
158 wrapNongenSyms ss q_decs
159 -- Do *not* gensym top-level binders
162 groupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
163 hs_fords = foreign_decls })
164 -- Collect the binders of a Group
165 = collectHsBinders val_decls ++
166 [n | d <- tycl_decls, (n,_) <- tyClDeclNames d] ++
167 [n | ForeignImport n _ _ _ _ <- foreign_decls]
170 {- Note [Binders and occurrences]
171 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
172 When we desugar [d| data T = MkT |]
174 Data "T" [] [Con "MkT" []] []
176 Data "Foo:T" [] [Con "Foo:MkT" []] []
177 That is, the new data decl should fit into whatever new module it is
178 asked to fit in. We do *not* clone, though; no need for this:
185 then we must desugar to
186 foo = Data "Foo:T" [] [Con "Foo:MkT" []] []
188 So in repTopDs we bring the binders into scope with mkGenSyms and addBinds,
189 but in dsReify we do not. And we use lookupOcc, rather than lookupBinder
190 in repTyClD and repC.
194 repTyClD :: TyClDecl Name -> DsM (Maybe (Core M.Decl))
196 repTyClD (TyData { tcdND = DataType, tcdCtxt = [],
197 tcdName = tc, tcdTyVars = tvs,
198 tcdCons = DataCons cons, tcdDerivs = mb_derivs })
199 = do { tc1 <- lookupOcc tc ; -- See note [Binders and occurrences]
201 cons1 <- mapM repC cons ;
202 cons2 <- coreList consTyConName cons1 ;
203 derivs1 <- repDerivs mb_derivs ;
204 dec <- repData tc1 tvs1 cons2 derivs1 ;
207 repTyClD (ClassDecl { tcdCtxt = cxt, tcdName = cls,
208 tcdTyVars = tvs, tcdFDs = [],
209 tcdSigs = sigs, tcdMeths = Just binds
211 = do { cls1 <- lookupOcc cls ; -- See note [Binders and occurrences]
213 cxt1 <- repCtxt cxt ;
214 sigs1 <- rep_sigs sigs ;
215 binds1 <- rep_monobind binds ;
216 decls1 <- coreList declTyConName (sigs1 ++ binds1) ;
217 dec <- repClass cxt1 cls1 tvs1 decls1 ;
221 repTyClD d = do { addDsWarn (hang msg 4 (ppr d)) ;
225 msg = ptext SLIT("Cannot desugar this Template Haskell declaration:")
227 repInstD (InstDecl ty binds _ _ loc)
228 -- Ignore user pragmas for now
229 = do { cxt1 <- repCtxt cxt ;
230 inst_ty1 <- repPred (HsClassP cls tys) ;
231 binds1 <- rep_monobind binds ;
232 decls1 <- coreList declTyConName binds1 ;
233 repInst cxt1 inst_ty1 decls1 }
235 (tvs, cxt, cls, tys) = splitHsInstDeclTy ty
238 -------------------------------------------------------
240 -------------------------------------------------------
242 repC :: ConDecl Name -> DsM (Core M.Cons)
243 repC (ConDecl con [] [] details loc)
244 = do { con1 <- lookupOcc con ; -- See note [Binders and occurrences]
245 arg_tys <- mapM (repBangTy con) (hsConArgs details) ;
246 arg_tys1 <- coreList typeTyConName arg_tys ;
247 repConstr con1 arg_tys1 }
249 repBangTy con (BangType NotMarkedStrict ty) = repTy ty
250 repBangTy con bty = do { addDsWarn msg ; repTy (getBangType bty) }
252 msg = ptext SLIT("Ignoring stricness on argument of constructor")
255 -------------------------------------------------------
257 -------------------------------------------------------
259 repDerivs :: Maybe (HsContext Name) -> DsM (Core [String])
260 repDerivs Nothing = return (coreList' stringTy [])
261 repDerivs (Just ctxt)
262 = do { strs <- mapM rep_deriv ctxt ;
263 return (coreList' stringTy strs) }
265 rep_deriv :: HsPred Name -> DsM (Core String)
266 -- Deriving clauses must have the simple H98 form
267 rep_deriv (HsClassP cls []) = lookupOcc cls
268 rep_deriv other = panic "rep_deriv"
271 -------------------------------------------------------
272 -- Signatures in a class decl, or a group of bindings
273 -------------------------------------------------------
275 rep_sigs :: [Sig Name] -> DsM [Core M.Decl]
276 -- We silently ignore ones we don't recognise
277 rep_sigs sigs = do { sigs1 <- mapM rep_sig sigs ;
278 return (concat sigs1) }
280 rep_sig :: Sig Name -> DsM [Core M.Decl]
282 -- Empty => Too hard, signature ignored
283 rep_sig (ClassOpSig nm _ ty _) = rep_proto nm ty
284 rep_sig (Sig nm ty _) = rep_proto nm ty
285 rep_sig other = return []
287 rep_proto nm ty = do { nm1 <- lookupBinder nm ;
289 sig <- repProto nm1 ty1 ;
293 -------------------------------------------------------
295 -------------------------------------------------------
297 repTvs :: [HsTyVarBndr Name] -> DsM (Core [String])
298 repTvs tvs = do { tvs1 <- mapM (localVar . hsTyVarName) tvs ;
299 return (coreList' stringTy tvs1) }
302 repCtxt :: HsContext Name -> DsM (Core M.Ctxt)
303 repCtxt ctxt = do { preds <- mapM repPred ctxt;
304 coreList typeTyConName preds }
307 repPred :: HsPred Name -> DsM (Core M.Type)
308 repPred (HsClassP cls tys)
309 = do { tc1 <- lookupOcc cls; tcon <- repNamedTyCon tc1;
310 tys1 <- repTys tys; repTapps tcon tys1 }
311 repPred (HsIParam _ _) = panic "No implicit parameters yet"
314 repTys :: [HsType Name] -> DsM [Core M.Type]
315 repTys tys = mapM repTy tys
318 repTy :: HsType Name -> DsM (Core M.Type)
321 | isTvOcc (nameOccName n) = do { tv1 <- localVar n ; repTvar tv1 }
322 | otherwise = do { tc1 <- lookupOcc n; repNamedTyCon tc1 }
323 repTy (HsAppTy f a) = do { f1 <- repTy f ; a1 <- repTy a ; repTapp f1 a1 }
324 repTy (HsFunTy f a) = do { f1 <- repTy f ; a1 <- repTy a ;
325 tcon <- repArrowTyCon ; repTapps tcon [f1,a1] }
326 repTy (HsListTy t) = do { t1 <- repTy t ; tcon <- repListTyCon ; repTapp tcon t1 }
327 repTy (HsTupleTy tc tys) = do { tys1 <- repTys tys;
328 tcon <- repTupleTyCon (length tys);
330 repTy (HsOpTy ty1 HsArrow ty2) = repTy (HsFunTy ty1 ty2)
331 repTy (HsOpTy ty1 (HsTyOp n) ty2) = repTy ((HsTyVar n `HsAppTy` ty1) `HsAppTy` ty2)
332 repTy (HsParTy t) = repTy t
333 repTy (HsPredTy (HsClassP c tys)) = repTy (foldl HsAppTy (HsTyVar c) tys)
335 repTy other_ty = pprPanic "repTy" (ppr other_ty) -- HsForAllTy, HsKindSig
337 -----------------------------------------------------------------------------
339 -----------------------------------------------------------------------------
341 repEs :: [HsExpr Name] -> DsM (Core [M.Expr])
342 repEs es = do { es' <- mapM repE es ;
343 coreList exprTyConName es' }
345 -- FIXME: some of these panics should be converted into proper error messages
346 -- unless we can make sure that constructs, which are plainly not
347 -- supported in TH already lead to error messages at an earlier stage
348 repE :: HsExpr Name -> DsM (Core M.Expr)
350 do { mb_val <- dsLookupMetaEnv x
352 Nothing -> do { str <- globalVar x
353 ; repVarOrCon x str }
354 Just (Bound y) -> repVarOrCon x (coreVar y)
355 Just (Splice e) -> do { e' <- dsExpr e
356 ; return (MkC e') } }
357 repE (HsIPVar x) = panic "DsMeta.repE: Can't represent implicit parameters"
359 -- Remember, we're desugaring renamer output here, so
360 -- HsOverlit can definitely occur
361 repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
362 repE (HsLit l) = do { a <- repLiteral l; repLit a }
363 repE (HsLam m) = repLambda m
364 repE (HsApp x y) = do {a <- repE x; b <- repE y; repApp a b}
366 repE (OpApp e1 op fix e2) =
368 HsVar op -> do { arg1 <- repE e1;
370 the_op <- lookupOcc op ;
371 repInfixApp arg1 the_op arg2 }
372 _ -> panic "DsMeta.repE: Operator is not a variable"
373 repE (NegApp x nm) = do
375 negateVar <- lookupOcc negateName >>= repVar
377 repE (HsPar x) = repE x
378 repE (SectionL x y) = do { a <- repE x; b <- repE y; repSectionL a b }
379 repE (SectionR x y) = do { a <- repE x; b <- repE y; repSectionR a b }
380 repE (HsCase e ms loc) = do { arg <- repE e
381 ; ms2 <- mapM repMatchTup ms
382 ; repCaseE arg (nonEmptyCoreList ms2) }
383 repE (HsIf x y z loc) = do
388 repE (HsLet bs e) = do { (ss,ds) <- repBinds bs
389 ; e2 <- addBinds ss (repE e)
391 ; wrapGenSyns expTyConName ss z }
392 -- FIXME: I haven't got the types here right yet
393 repE (HsDo DoExpr sts _ ty loc)
394 = do { (ss,zs) <- repSts sts;
395 e <- repDoE (nonEmptyCoreList zs);
396 wrapGenSyns expTyConName ss e }
397 repE (HsDo ListComp sts _ ty loc)
398 = do { (ss,zs) <- repSts sts;
399 e <- repComp (nonEmptyCoreList zs);
400 wrapGenSyns expTyConName ss e }
401 repE (HsDo _ _ _ _ _) = panic "DsMeta.repE: Can't represent mdo and [: :] yet"
402 repE (ExplicitList ty es) = do { xs <- repEs es; repListExp xs }
403 repE (ExplicitPArr ty es) =
404 panic "DsMeta.repE: No explicit parallel arrays yet"
405 repE (ExplicitTuple es boxed)
406 | isBoxed boxed = do { xs <- repEs es; repTup xs }
407 | otherwise = panic "DsMeta.repE: Can't represent unboxed tuples"
408 repE (RecordConOut _ _ _) = panic "DsMeta.repE: No record construction yet"
409 repE (RecordUpdOut _ _ _ _) = panic "DsMeta.repE: No record update yet"
411 repE (ExprWithTySig e ty) = do { e1 <- repE e; t1 <- repTy ty; repSigExp e1 t1 }
412 repE (ArithSeqIn aseq) =
414 From e -> do { ds1 <- repE e; repFrom ds1 }
423 FromThenTo e1 e2 e3 -> do
427 repFromThenTo ds1 ds2 ds3
428 repE (PArrSeqOut _ aseq) = panic "DsMeta.repE: parallel array seq.s missing"
429 repE (HsCCall _ _ _ _ _) = panic "DsMeta.repE: Can't represent __ccall__"
430 repE (HsSCC _ _) = panic "DsMeta.repE: Can't represent SCC"
431 repE (HsBracketOut _ _) =
432 panic "DsMeta.repE: Can't represent Oxford brackets"
433 repE (HsSplice n e loc) = do { mb_val <- dsLookupMetaEnv n
435 Just (Splice e) -> do { e' <- dsExpr e
437 other -> pprPanic "HsSplice" (ppr n) }
438 repE (HsReify _) = panic "DsMeta.repE: Can't represent reification"
440 pprPanic "DsMeta.repE: Illegal expression form" (ppr e)
442 -----------------------------------------------------------------------------
443 -- Building representations of auxillary structures like Match, Clause, Stmt,
445 repMatchTup :: Match Name -> DsM (Core M.Mtch)
446 repMatchTup (Match [p] ty (GRHSs guards wheres ty2)) =
447 do { ss1 <- mkGenSyms (collectPatBinders p)
448 ; addBinds ss1 $ do {
450 ; (ss2,ds) <- repBinds wheres
451 ; addBinds ss2 $ do {
452 ; gs <- repGuards guards
453 ; match <- repMatch p1 gs ds
454 ; wrapGenSyns matTyConName (ss1++ss2) match }}}
456 repClauseTup :: Match Name -> DsM (Core M.Clse)
457 repClauseTup (Match ps ty (GRHSs guards wheres ty2)) =
458 do { ss1 <- mkGenSyms (collectPatsBinders ps)
459 ; addBinds ss1 $ do {
461 ; (ss2,ds) <- repBinds wheres
462 ; addBinds ss2 $ do {
463 gs <- repGuards guards
464 ; clause <- repClause ps1 gs ds
465 ; wrapGenSyns clsTyConName (ss1++ss2) clause }}}
467 repGuards :: [GRHS Name] -> DsM (Core M.Rihs)
468 repGuards [GRHS [ResultStmt e loc] loc2]
469 = do {a <- repE e; repNormal a }
471 = do { zs <- mapM process other;
472 repGuarded (nonEmptyCoreList (map corePair zs)) }
474 process (GRHS [ExprStmt e1 ty loc,ResultStmt e2 _] _)
475 = do { x <- repE e1; y <- repE e2; return (x, y) }
476 process other = panic "Non Haskell 98 guarded body"
479 -----------------------------------------------------------------------------
480 -- Representing Stmt's is tricky, especially if bound variables
481 -- shaddow each other. Consider: [| do { x <- f 1; x <- f x; g x } |]
482 -- First gensym new names for every variable in any of the patterns.
483 -- both static (x'1 and x'2), and dynamic ((gensym "x") and (gensym "y"))
484 -- if variables didn't shaddow, the static gensym wouldn't be necessary
485 -- and we could reuse the original names (x and x).
487 -- do { x'1 <- gensym "x"
488 -- ; x'2 <- gensym "x"
489 -- ; doE [ BindSt (pvar x'1) [| f 1 |]
490 -- , BindSt (pvar x'2) [| f x |]
491 -- , NoBindSt [| g x |]
495 -- The strategy is to translate a whole list of do-bindings by building a
496 -- bigger environment, and a bigger set of meta bindings
497 -- (like: x'1 <- gensym "x" ) and then combining these with the translations
498 -- of the expressions within the Do
500 -----------------------------------------------------------------------------
501 -- The helper function repSts computes the translation of each sub expression
502 -- and a bunch of prefix bindings denoting the dynamic renaming.
504 repSts :: [Stmt Name] -> DsM ([GenSymBind], [Core M.Stmt])
505 repSts [ResultStmt e loc] =
507 ; e1 <- repNoBindSt a
508 ; return ([], [e1]) }
509 repSts (BindStmt p e loc : ss) =
511 ; ss1 <- mkGenSyms (collectPatBinders p)
512 ; addBinds ss1 $ do {
514 ; (ss2,zs) <- repSts ss
515 ; z <- repBindSt p1 e2
516 ; return (ss1++ss2, z : zs) }}
517 repSts (LetStmt bs : ss) =
518 do { (ss1,ds) <- repBinds bs
520 ; (ss2,zs) <- addBinds ss1 (repSts ss)
521 ; return (ss1++ss2, z : zs) }
522 repSts (ExprStmt e ty loc : ss) =
524 ; z <- repNoBindSt e2
525 ; (ss2,zs) <- repSts ss
526 ; return (ss2, z : zs) }
527 repSts other = panic "Exotic Stmt in meta brackets"
530 -----------------------------------------------------------
532 -----------------------------------------------------------
534 repBinds :: HsBinds Name -> DsM ([GenSymBind], Core [M.Decl])
536 = do { let { bndrs = collectHsBinders decs } ;
537 ss <- mkGenSyms bndrs ;
538 core <- addBinds ss (rep_binds decs) ;
539 core_list <- coreList declTyConName core ;
540 return (ss, core_list) }
542 rep_binds :: HsBinds Name -> DsM [Core M.Decl]
543 rep_binds EmptyBinds = return []
544 rep_binds (ThenBinds x y)
545 = do { core1 <- rep_binds x
546 ; core2 <- rep_binds y
547 ; return (core1 ++ core2) }
548 rep_binds (MonoBind bs sigs _)
549 = do { core1 <- rep_monobind bs
550 ; core2 <- rep_sigs sigs
551 ; return (core1 ++ core2) }
552 rep_binds (IPBinds _ _)
553 = panic "DsMeta:repBinds: can't do implicit parameters"
555 rep_monobind :: MonoBinds Name -> DsM [Core M.Decl]
556 rep_monobind EmptyMonoBinds = return []
557 rep_monobind (AndMonoBinds x y) = do { x1 <- rep_monobind x;
558 y1 <- rep_monobind y;
561 -- Note GHC treats declarations of a variable (not a pattern)
562 -- e.g. x = g 5 as a Fun MonoBinds. This is indicated by a single match
563 -- with an empty list of patterns
564 rep_monobind (FunMonoBind fn infx [Match [] ty (GRHSs guards wheres ty2)] loc)
565 = do { (ss,wherecore) <- repBinds wheres
566 ; guardcore <- addBinds ss (repGuards guards)
567 ; fn' <- lookupBinder fn
569 ; ans <- repVal p guardcore wherecore
572 rep_monobind (FunMonoBind fn infx ms loc)
573 = do { ms1 <- mapM repClauseTup ms
574 ; fn' <- lookupBinder fn
575 ; ans <- repFun fn' (nonEmptyCoreList ms1)
578 rep_monobind (PatMonoBind pat (GRHSs guards wheres ty2) loc)
579 = do { patcore <- repP pat
580 ; (ss,wherecore) <- repBinds wheres
581 ; guardcore <- addBinds ss (repGuards guards)
582 ; ans <- repVal patcore guardcore wherecore
585 rep_monobind (VarMonoBind v e)
586 = do { v' <- lookupBinder v
589 ; patcore <- repPvar v'
590 ; empty_decls <- coreList declTyConName []
591 ; ans <- repVal patcore x empty_decls
594 -----------------------------------------------------------------------------
595 -- Since everything in a MonoBind is mutually recursive we need rename all
596 -- all the variables simultaneously. For example:
597 -- [| AndMonoBinds (f x = x + g 2) (g x = f 1 + 2) |] would translate to
598 -- do { f'1 <- gensym "f"
599 -- ; g'2 <- gensym "g"
600 -- ; [ do { x'3 <- gensym "x"; fun f'1 [pvar x'3] [| x + g2 |]},
601 -- do { x'4 <- gensym "x"; fun g'2 [pvar x'4] [| f 1 + 2 |]}
603 -- This requires collecting the bindings (f'1 <- gensym "f"), and the
604 -- environment ( f |-> f'1 ) from each binding, and then unioning them
605 -- together. As we do this we collect GenSymBinds's which represent the renamed
606 -- variables bound by the Bindings. In order not to lose track of these
607 -- representations we build a shadow datatype MB with the same structure as
608 -- MonoBinds, but which has slots for the representations
611 -----------------------------------------------------------------------------
612 -- GHC allows a more general form of lambda abstraction than specified
613 -- by Haskell 98. In particular it allows guarded lambda's like :
614 -- (\ x | even x -> 0 | odd x -> 1) at the moment we can't represent this in
615 -- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like
616 -- (\ p1 .. pn -> exp) by causing an error.
618 repLambda :: Match Name -> DsM (Core M.Expr)
619 repLambda (Match ps _ (GRHSs [GRHS [ResultStmt e _ ] _ ]
621 = do { let bndrs = collectPatsBinders ps ;
622 ; ss <- mkGenSyms bndrs
623 ; lam <- addBinds ss (
624 do { xs <- repPs ps; body <- repE e; repLam xs body })
625 ; wrapGenSyns expTyConName ss lam }
627 repLambda z = panic "Can't represent a guarded lambda in Template Haskell"
630 -----------------------------------------------------------------------------
632 -- repP deals with patterns. It assumes that we have already
633 -- walked over the pattern(s) once to collect the binders, and
634 -- have extended the environment. So every pattern-bound
635 -- variable should already appear in the environment.
637 -- Process a list of patterns
638 repPs :: [Pat Name] -> DsM (Core [M.Patt])
639 repPs ps = do { ps' <- mapM repP ps ;
640 coreList pattTyConName ps' }
642 repP :: Pat Name -> DsM (Core M.Patt)
643 repP (WildPat _) = repPwild
644 repP (LitPat l) = do { l2 <- repLiteral l; repPlit l2 }
645 repP (VarPat x) = do { x' <- lookupBinder x; repPvar x' }
646 repP (LazyPat p) = do { p1 <- repP p; repPtilde p1 }
647 repP (AsPat x p) = do { x' <- lookupBinder x; p1 <- repP p; repPaspat x' p1 }
648 repP (ParPat p) = repP p
649 repP (ListPat ps _) = repListPat ps
650 repP (TuplePat ps _) = do { qs <- repPs ps; repPtup qs }
651 repP (ConPatIn dc details)
652 = do { con_str <- lookupOcc dc
654 PrefixCon ps -> do { qs <- repPs ps; repPcon con_str qs }
655 RecCon pairs -> error "No records in template haskell yet"
656 InfixCon p1 p2 -> do { qs <- repPs [p1,p2]; repPcon con_str qs }
658 repP (NPatIn l (Just _)) = panic "Can't cope with negative overloaded patterns yet (repP (NPatIn _ (Just _)))"
659 repP (NPatIn l Nothing) = do { a <- repOverloadedLiteral l; repPlit a }
660 repP other = panic "Exotic pattern inside meta brackets"
662 repListPat :: [Pat Name] -> DsM (Core M.Patt)
663 repListPat [] = do { nil_con <- coreStringLit "[]"
664 ; nil_args <- coreList pattTyConName []
665 ; repPcon nil_con nil_args }
666 repListPat (p:ps) = do { p2 <- repP p
667 ; ps2 <- repListPat ps
668 ; cons_con <- coreStringLit ":"
669 ; repPcon cons_con (nonEmptyCoreList [p2,ps2]) }
672 ----------------------------------------------------------
673 -- The meta-environment
675 type GenSymBind = (Name, Id) -- Gensym the string and bind it to the Id
676 -- I.e. (x, x_id) means
677 -- let x_id = gensym "x" in ...
679 addBinds :: [GenSymBind] -> DsM a -> DsM a
680 addBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,Bound id) | (n,id) <- bs]) m
682 mkGenSym :: Name -> DsM GenSymBind
683 mkGenSym nm = do { id <- newUniqueId nm stringTy; return (nm,id) }
685 mkGenSyms :: [Name] -> DsM [GenSymBind]
686 mkGenSyms ns = mapM mkGenSym ns
688 lookupBinder :: Name -> DsM (Core String)
690 = do { mb_val <- dsLookupMetaEnv n;
692 Just (Bound x) -> return (coreVar x)
693 other -> pprPanic "Failed binder lookup:" (ppr n) }
695 lookupOcc :: Name -> DsM (Core String)
696 -- Lookup an occurrence; it can't be a splice.
697 -- Use the in-scope bindings if they exist
699 = do { mb_val <- dsLookupMetaEnv n ;
701 Nothing -> globalVar n
702 Just (Bound x) -> return (coreVar x)
703 Just (Splice _) -> pprPanic "repE:lookupOcc" (ppr n)
706 globalVar :: Name -> DsM (Core String)
707 globalVar n = coreStringLit (name_mod ++ ":" ++ name_occ)
709 name_mod = moduleUserString (nameModule n)
710 name_occ = occNameUserString (nameOccName n)
712 localVar :: Name -> DsM (Core String)
713 localVar n = coreStringLit (occNameUserString (nameOccName n))
715 lookupType :: Name -- Name of type constructor (e.g. M.Expr)
716 -> DsM Type -- The type
717 lookupType tc_name = do { tc <- dsLookupTyCon tc_name ;
718 return (mkGenTyConApp tc []) }
720 -- wrapGenSyns [(nm1,id1), (nm2,id2)] y
721 -- --> bindQ (gensym nm1) (\ id1 ->
722 -- bindQ (gensym nm2 (\ id2 ->
725 wrapGenSyns :: Name -- Name of the type (consructor) for 'a'
727 -> Core (M.Q a) -> DsM (Core (M.Q a))
728 wrapGenSyns tc_name binds body@(MkC b)
729 = do { elt_ty <- lookupType tc_name
732 go elt_ty [] = return body
733 go elt_ty ((name,id) : binds)
734 = do { MkC body' <- go elt_ty binds
735 ; lit_str <- localVar name
736 ; gensym_app <- repGensym lit_str
737 ; repBindQ stringTy elt_ty
738 gensym_app (MkC (Lam id body')) }
740 -- Just like wrapGenSym, but don't actually do the gensym
741 -- Instead use the existing name
742 -- Only used for [Decl]
743 wrapNongenSyms :: [GenSymBind] -> Core a -> DsM (Core a)
744 wrapNongenSyms binds (MkC body)
745 = do { binds' <- mapM do_one binds ;
746 return (MkC (mkLets binds' body)) }
749 = do { MkC lit_str <- localVar name -- No gensym
750 ; return (NonRec id lit_str) }
752 void = placeHolderType
754 string :: String -> HsExpr Id
755 string s = HsLit (HsString (mkFastString s))
758 -- %*********************************************************************
762 -- %*********************************************************************
764 -----------------------------------------------------------------------------
765 -- PHANTOM TYPES for consistency. In order to make sure we do this correct
766 -- we invent a new datatype which uses phantom types.
768 newtype Core a = MkC CoreExpr
771 rep2 :: Name -> [ CoreExpr ] -> DsM (Core a)
772 rep2 n xs = do { id <- dsLookupGlobalId n
773 ; return (MkC (foldl App (Var id) xs)) }
775 -- Then we make "repConstructors" which use the phantom types for each of the
776 -- smart constructors of the Meta.Meta datatypes.
779 -- %*********************************************************************
781 -- The 'smart constructors'
783 -- %*********************************************************************
785 --------------- Patterns -----------------
786 repPlit :: Core M.Lit -> DsM (Core M.Patt)
787 repPlit (MkC l) = rep2 plitName [l]
789 repPvar :: Core String -> DsM (Core M.Patt)
790 repPvar (MkC s) = rep2 pvarName [s]
792 repPtup :: Core [M.Patt] -> DsM (Core M.Patt)
793 repPtup (MkC ps) = rep2 ptupName [ps]
795 repPcon :: Core String -> Core [M.Patt] -> DsM (Core M.Patt)
796 repPcon (MkC s) (MkC ps) = rep2 pconName [s, ps]
798 repPtilde :: Core M.Patt -> DsM (Core M.Patt)
799 repPtilde (MkC p) = rep2 ptildeName [p]
801 repPaspat :: Core String -> Core M.Patt -> DsM (Core M.Patt)
802 repPaspat (MkC s) (MkC p) = rep2 paspatName [s, p]
804 repPwild :: DsM (Core M.Patt)
805 repPwild = rep2 pwildName []
807 --------------- Expressions -----------------
808 repVarOrCon :: Name -> Core String -> DsM (Core M.Expr)
809 repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
810 | otherwise = repVar str
812 repVar :: Core String -> DsM (Core M.Expr)
813 repVar (MkC s) = rep2 varName [s]
815 repCon :: Core String -> DsM (Core M.Expr)
816 repCon (MkC s) = rep2 conName [s]
818 repLit :: Core M.Lit -> DsM (Core M.Expr)
819 repLit (MkC c) = rep2 litName [c]
821 repApp :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
822 repApp (MkC x) (MkC y) = rep2 appName [x,y]
824 repLam :: Core [M.Patt] -> Core M.Expr -> DsM (Core M.Expr)
825 repLam (MkC ps) (MkC e) = rep2 lamName [ps, e]
827 repTup :: Core [M.Expr] -> DsM (Core M.Expr)
828 repTup (MkC es) = rep2 tupName [es]
830 repCond :: Core M.Expr -> Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
831 repCond (MkC x) (MkC y) (MkC z) = rep2 condName [x,y,z]
833 repLetE :: Core [M.Decl] -> Core M.Expr -> DsM (Core M.Expr)
834 repLetE (MkC ds) (MkC e) = rep2 letEName [ds, e]
836 repCaseE :: Core M.Expr -> Core [M.Mtch] -> DsM( Core M.Expr)
837 repCaseE (MkC e) (MkC ms) = rep2 caseEName [e, ms]
839 repDoE :: Core [M.Stmt] -> DsM (Core M.Expr)
840 repDoE (MkC ss) = rep2 doEName [ss]
842 repComp :: Core [M.Stmt] -> DsM (Core M.Expr)
843 repComp (MkC ss) = rep2 compName [ss]
845 repListExp :: Core [M.Expr] -> DsM (Core M.Expr)
846 repListExp (MkC es) = rep2 listExpName [es]
848 repSigExp :: Core M.Expr -> Core M.Type -> DsM (Core M.Expr)
849 repSigExp (MkC e) (MkC t) = rep2 sigExpName [e,t]
851 repInfixApp :: Core M.Expr -> Core String -> Core M.Expr -> DsM (Core M.Expr)
852 repInfixApp (MkC x) (MkC y) (MkC z) = rep2 infixAppName [x,y,z]
854 repSectionL :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
855 repSectionL (MkC x) (MkC y) = rep2 infixAppName [x,y]
857 repSectionR :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
858 repSectionR (MkC x) (MkC y) = rep2 infixAppName [x,y]
860 ------------ Right hand sides (guarded expressions) ----
861 repGuarded :: Core [(M.Expr, M.Expr)] -> DsM (Core M.Rihs)
862 repGuarded (MkC pairs) = rep2 guardedName [pairs]
864 repNormal :: Core M.Expr -> DsM (Core M.Rihs)
865 repNormal (MkC e) = rep2 normalName [e]
867 ------------- Statements -------------------
868 repBindSt :: Core M.Patt -> Core M.Expr -> DsM (Core M.Stmt)
869 repBindSt (MkC p) (MkC e) = rep2 bindStName [p,e]
871 repLetSt :: Core [M.Decl] -> DsM (Core M.Stmt)
872 repLetSt (MkC ds) = rep2 letStName [ds]
874 repNoBindSt :: Core M.Expr -> DsM (Core M.Stmt)
875 repNoBindSt (MkC e) = rep2 noBindStName [e]
877 -------------- DotDot (Arithmetic sequences) -----------
878 repFrom :: Core M.Expr -> DsM (Core M.Expr)
879 repFrom (MkC x) = rep2 fromName [x]
881 repFromThen :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
882 repFromThen (MkC x) (MkC y) = rep2 fromThenName [x,y]
884 repFromTo :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
885 repFromTo (MkC x) (MkC y) = rep2 fromToName [x,y]
887 repFromThenTo :: Core M.Expr -> Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
888 repFromThenTo (MkC x) (MkC y) (MkC z) = rep2 fromThenToName [x,y,z]
890 ------------ Match and Clause Tuples -----------
891 repMatch :: Core M.Patt -> Core M.Rihs -> Core [M.Decl] -> DsM (Core M.Mtch)
892 repMatch (MkC p) (MkC bod) (MkC ds) = rep2 matchName [p, bod, ds]
894 repClause :: Core [M.Patt] -> Core M.Rihs -> Core [M.Decl] -> DsM (Core M.Clse)
895 repClause (MkC ps) (MkC bod) (MkC ds) = rep2 clauseName [ps, bod, ds]
897 -------------- Dec -----------------------------
898 repVal :: Core M.Patt -> Core M.Rihs -> Core [M.Decl] -> DsM (Core M.Decl)
899 repVal (MkC p) (MkC b) (MkC ds) = rep2 valName [p, b, ds]
901 repFun :: Core String -> Core [M.Clse] -> DsM (Core M.Decl)
902 repFun (MkC nm) (MkC b) = rep2 funName [nm, b]
904 repData :: Core String -> Core [String] -> Core [M.Cons] -> Core [String] -> DsM (Core M.Decl)
905 repData (MkC nm) (MkC tvs) (MkC cons) (MkC derivs) = rep2 dataDName [nm, tvs, cons, derivs]
907 repInst :: Core M.Ctxt -> Core M.Type -> Core [M.Decl] -> DsM (Core M.Decl)
908 repInst (MkC cxt) (MkC ty) (MkC ds) = rep2 instName [cxt, ty, ds]
910 repClass :: Core M.Ctxt -> Core String -> Core [String] -> Core [M.Decl] -> DsM (Core M.Decl)
911 repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC ds) = rep2 classDName [cxt, cls, tvs, ds]
913 repProto :: Core String -> Core M.Type -> DsM (Core M.Decl)
914 repProto (MkC s) (MkC ty) = rep2 protoName [s, ty]
916 repConstr :: Core String -> Core [M.Type] -> DsM (Core M.Cons)
917 repConstr (MkC con) (MkC tys) = rep2 constrName [con,tys]
919 ------------ Types -------------------
921 repTvar :: Core String -> DsM (Core M.Type)
922 repTvar (MkC s) = rep2 tvarName [s]
924 repTapp :: Core M.Type -> Core M.Type -> DsM (Core M.Type)
925 repTapp (MkC t1) (MkC t2) = rep2 tappName [t1,t2]
927 repTapps :: Core M.Type -> [Core M.Type] -> DsM (Core M.Type)
928 repTapps f [] = return f
929 repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
931 --------- Type constructors --------------
933 repNamedTyCon :: Core String -> DsM (Core M.Type)
934 repNamedTyCon (MkC s) = rep2 namedTyConName [s]
936 repTupleTyCon :: Int -> DsM (Core M.Type)
937 -- Note: not Core Int; it's easier to be direct here
938 repTupleTyCon i = rep2 tupleTyConName [mkIntExpr (fromIntegral i)]
940 repArrowTyCon :: DsM (Core M.Type)
941 repArrowTyCon = rep2 arrowTyConName []
943 repListTyCon :: DsM (Core M.Type)
944 repListTyCon = rep2 listTyConName []
947 ----------------------------------------------------------
950 repLiteral :: HsLit -> DsM (Core M.Lit)
952 = do { lit_expr <- dsLit lit; rep2 lit_name [lit_expr] }
954 lit_name = case lit of
955 HsInteger _ -> integerLName
956 HsChar _ -> charLName
957 HsString _ -> stringLName
958 HsRat _ _ -> rationalLName
960 uh_oh = pprPanic "DsMeta.repLiteral: trying to represent exotic literal"
963 repOverloadedLiteral :: HsOverLit -> DsM (Core M.Lit)
964 repOverloadedLiteral (HsIntegral i _) = repLiteral (HsInteger i)
965 repOverloadedLiteral (HsFractional f _) = do { rat_ty <- lookupType rationalTyConName ;
966 repLiteral (HsRat f rat_ty) }
967 -- The type Rational will be in the environment, becuase
968 -- the smart constructor 'THSyntax.rationalL' uses it in its type,
969 -- and rationalL is sucked in when any TH stuff is used
971 --------------- Miscellaneous -------------------
973 repLift :: Core e -> DsM (Core M.Expr)
974 repLift (MkC x) = rep2 liftName [x]
976 repGensym :: Core String -> DsM (Core (M.Q String))
977 repGensym (MkC lit_str) = rep2 gensymName [lit_str]
979 repBindQ :: Type -> Type -- a and b
980 -> Core (M.Q a) -> Core (a -> M.Q b) -> DsM (Core (M.Q b))
981 repBindQ ty_a ty_b (MkC x) (MkC y)
982 = rep2 bindQName [Type ty_a, Type ty_b, x, y]
984 repSequenceQ :: Type -> Core [M.Q a] -> DsM (Core (M.Q [a]))
985 repSequenceQ ty_a (MkC list)
986 = rep2 sequenceQName [Type ty_a, list]
988 ------------ Lists and Tuples -------------------
989 -- turn a list of patterns into a single pattern matching a list
991 coreList :: Name -- Of the TyCon of the element type
992 -> [Core a] -> DsM (Core [a])
994 = do { elt_ty <- lookupType tc_name; return (coreList' elt_ty es) }
996 coreList' :: Type -- The element type
997 -> [Core a] -> Core [a]
998 coreList' elt_ty es = MkC (mkListExpr elt_ty (map unC es ))
1000 nonEmptyCoreList :: [Core a] -> Core [a]
1001 -- The list must be non-empty so we can get the element type
1002 -- Otherwise use coreList
1003 nonEmptyCoreList [] = panic "coreList: empty argument"
1004 nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs))
1006 corePair :: (Core a, Core b) -> Core (a,b)
1007 corePair (MkC x, MkC y) = MkC (mkCoreTup [x,y])
1009 coreStringLit :: String -> DsM (Core String)
1010 coreStringLit s = do { z <- mkStringLit s; return(MkC z) }
1012 coreVar :: Id -> Core String -- The Id has type String
1013 coreVar id = MkC (Var id)
1017 -- %************************************************************************
1019 -- The known-key names for Template Haskell
1021 -- %************************************************************************
1023 -- To add a name, do three things
1025 -- 1) Allocate a key
1027 -- 3) Add the name to knownKeyNames
1029 templateHaskellNames :: NameSet
1030 -- The names that are implicitly mentioned by ``bracket''
1031 -- Should stay in sync with the import list of DsMeta
1032 templateHaskellNames
1033 = mkNameSet [ integerLName,charLName, stringLName, rationalLName,
1034 plitName, pvarName, ptupName,
1035 pconName, ptildeName, paspatName, pwildName,
1036 varName, conName, litName, appName, infixEName, lamName,
1037 tupName, doEName, compName,
1038 listExpName, sigExpName, condName, letEName, caseEName,
1039 infixAppName, sectionLName, sectionRName,
1040 guardedName, normalName,
1041 bindStName, letStName, noBindStName, parStName,
1042 fromName, fromThenName, fromToName, fromThenToName,
1043 funName, valName, liftName,
1044 gensymName, returnQName, bindQName, sequenceQName,
1045 matchName, clauseName, funName, valName, dataDName, classDName,
1046 instName, protoName, tvarName, tconName, tappName,
1047 arrowTyConName, tupleTyConName, listTyConName, namedTyConName,
1049 exprTyConName, declTyConName, pattTyConName, mtchTyConName,
1050 clseTyConName, stmtTyConName, consTyConName, typeTyConName,
1051 qTyConName, expTyConName, matTyConName, clsTyConName,
1052 decTyConName, typTyConName ]
1055 varQual = mk_known_key_name OccName.varName
1056 tcQual = mk_known_key_name OccName.tcName
1059 -- NB: the THSyntax module comes from the "haskell-src" package
1060 thModule = mkThPkgModule mETA_META_Name
1062 mk_known_key_name space str uniq
1063 = mkKnownKeyExternalName thModule (mkOccFS space str) uniq
1065 integerLName = varQual FSLIT("integerL") integerLIdKey
1066 charLName = varQual FSLIT("charL") charLIdKey
1067 stringLName = varQual FSLIT("stringL") stringLIdKey
1068 rationalLName = varQual FSLIT("rationalL") rationalLIdKey
1069 plitName = varQual FSLIT("plit") plitIdKey
1070 pvarName = varQual FSLIT("pvar") pvarIdKey
1071 ptupName = varQual FSLIT("ptup") ptupIdKey
1072 pconName = varQual FSLIT("pcon") pconIdKey
1073 ptildeName = varQual FSLIT("ptilde") ptildeIdKey
1074 paspatName = varQual FSLIT("paspat") paspatIdKey
1075 pwildName = varQual FSLIT("pwild") pwildIdKey
1076 varName = varQual FSLIT("var") varIdKey
1077 conName = varQual FSLIT("con") conIdKey
1078 litName = varQual FSLIT("lit") litIdKey
1079 appName = varQual FSLIT("app") appIdKey
1080 infixEName = varQual FSLIT("infixE") infixEIdKey
1081 lamName = varQual FSLIT("lam") lamIdKey
1082 tupName = varQual FSLIT("tup") tupIdKey
1083 doEName = varQual FSLIT("doE") doEIdKey
1084 compName = varQual FSLIT("comp") compIdKey
1085 listExpName = varQual FSLIT("listExp") listExpIdKey
1086 sigExpName = varQual FSLIT("sigExp") sigExpIdKey
1087 condName = varQual FSLIT("cond") condIdKey
1088 letEName = varQual FSLIT("letE") letEIdKey
1089 caseEName = varQual FSLIT("caseE") caseEIdKey
1090 infixAppName = varQual FSLIT("infixApp") infixAppIdKey
1091 sectionLName = varQual FSLIT("sectionL") sectionLIdKey
1092 sectionRName = varQual FSLIT("sectionR") sectionRIdKey
1093 guardedName = varQual FSLIT("guarded") guardedIdKey
1094 normalName = varQual FSLIT("normal") normalIdKey
1095 bindStName = varQual FSLIT("bindSt") bindStIdKey
1096 letStName = varQual FSLIT("letSt") letStIdKey
1097 noBindStName = varQual FSLIT("noBindSt") noBindStIdKey
1098 parStName = varQual FSLIT("parSt") parStIdKey
1099 fromName = varQual FSLIT("from") fromIdKey
1100 fromThenName = varQual FSLIT("fromThen") fromThenIdKey
1101 fromToName = varQual FSLIT("fromTo") fromToIdKey
1102 fromThenToName = varQual FSLIT("fromThenTo") fromThenToIdKey
1103 liftName = varQual FSLIT("lift") liftIdKey
1104 gensymName = varQual FSLIT("gensym") gensymIdKey
1105 returnQName = varQual FSLIT("returnQ") returnQIdKey
1106 bindQName = varQual FSLIT("bindQ") bindQIdKey
1107 sequenceQName = varQual FSLIT("sequenceQ") sequenceQIdKey
1110 matchName = varQual FSLIT("match") matchIdKey
1113 clauseName = varQual FSLIT("clause") clauseIdKey
1116 funName = varQual FSLIT("fun") funIdKey
1117 valName = varQual FSLIT("val") valIdKey
1118 dataDName = varQual FSLIT("dataD") dataDIdKey
1119 classDName = varQual FSLIT("classD") classDIdKey
1120 instName = varQual FSLIT("inst") instIdKey
1121 protoName = varQual FSLIT("proto") protoIdKey
1124 tvarName = varQual FSLIT("tvar") tvarIdKey
1125 tconName = varQual FSLIT("tcon") tconIdKey
1126 tappName = varQual FSLIT("tapp") tappIdKey
1129 arrowTyConName = varQual FSLIT("arrowTyCon") arrowIdKey
1130 tupleTyConName = varQual FSLIT("tupleTyCon") tupleIdKey
1131 listTyConName = varQual FSLIT("listTyCon") listIdKey
1132 namedTyConName = varQual FSLIT("namedTyCon") namedTyConIdKey
1135 constrName = varQual FSLIT("constr") constrIdKey
1137 exprTyConName = tcQual FSLIT("Expr") exprTyConKey
1138 declTyConName = tcQual FSLIT("Decl") declTyConKey
1139 pattTyConName = tcQual FSLIT("Patt") pattTyConKey
1140 mtchTyConName = tcQual FSLIT("Mtch") mtchTyConKey
1141 clseTyConName = tcQual FSLIT("Clse") clseTyConKey
1142 stmtTyConName = tcQual FSLIT("Stmt") stmtTyConKey
1143 consTyConName = tcQual FSLIT("Cons") consTyConKey
1144 typeTyConName = tcQual FSLIT("Type") typeTyConKey
1146 qTyConName = tcQual FSLIT("Q") qTyConKey
1147 expTyConName = tcQual FSLIT("Exp") expTyConKey
1148 decTyConName = tcQual FSLIT("Dec") decTyConKey
1149 typTyConName = tcQual FSLIT("Typ") typTyConKey
1150 matTyConName = tcQual FSLIT("Mat") matTyConKey
1151 clsTyConName = tcQual FSLIT("Cls") clsTyConKey
1153 -- TyConUniques available: 100-119
1154 -- Check in PrelNames if you want to change this
1156 expTyConKey = mkPreludeTyConUnique 100
1157 matTyConKey = mkPreludeTyConUnique 101
1158 clsTyConKey = mkPreludeTyConUnique 102
1159 qTyConKey = mkPreludeTyConUnique 103
1160 exprTyConKey = mkPreludeTyConUnique 104
1161 declTyConKey = mkPreludeTyConUnique 105
1162 pattTyConKey = mkPreludeTyConUnique 106
1163 mtchTyConKey = mkPreludeTyConUnique 107
1164 clseTyConKey = mkPreludeTyConUnique 108
1165 stmtTyConKey = mkPreludeTyConUnique 109
1166 consTyConKey = mkPreludeTyConUnique 110
1167 typeTyConKey = mkPreludeTyConUnique 111
1168 typTyConKey = mkPreludeTyConUnique 112
1169 decTyConKey = mkPreludeTyConUnique 113
1173 -- IdUniques available: 200-299
1174 -- If you want to change this, make sure you check in PrelNames
1175 fromIdKey = mkPreludeMiscIdUnique 200
1176 fromThenIdKey = mkPreludeMiscIdUnique 201
1177 fromToIdKey = mkPreludeMiscIdUnique 202
1178 fromThenToIdKey = mkPreludeMiscIdUnique 203
1179 liftIdKey = mkPreludeMiscIdUnique 204
1180 gensymIdKey = mkPreludeMiscIdUnique 205
1181 returnQIdKey = mkPreludeMiscIdUnique 206
1182 bindQIdKey = mkPreludeMiscIdUnique 207
1183 funIdKey = mkPreludeMiscIdUnique 208
1184 valIdKey = mkPreludeMiscIdUnique 209
1185 protoIdKey = mkPreludeMiscIdUnique 210
1186 matchIdKey = mkPreludeMiscIdUnique 211
1187 clauseIdKey = mkPreludeMiscIdUnique 212
1188 integerLIdKey = mkPreludeMiscIdUnique 213
1189 charLIdKey = mkPreludeMiscIdUnique 214
1191 classDIdKey = mkPreludeMiscIdUnique 215
1192 instIdKey = mkPreludeMiscIdUnique 216
1193 dataDIdKey = mkPreludeMiscIdUnique 217
1195 sequenceQIdKey = mkPreludeMiscIdUnique 218
1197 plitIdKey = mkPreludeMiscIdUnique 220
1198 pvarIdKey = mkPreludeMiscIdUnique 221
1199 ptupIdKey = mkPreludeMiscIdUnique 222
1200 pconIdKey = mkPreludeMiscIdUnique 223
1201 ptildeIdKey = mkPreludeMiscIdUnique 224
1202 paspatIdKey = mkPreludeMiscIdUnique 225
1203 pwildIdKey = mkPreludeMiscIdUnique 226
1204 varIdKey = mkPreludeMiscIdUnique 227
1205 conIdKey = mkPreludeMiscIdUnique 228
1206 litIdKey = mkPreludeMiscIdUnique 229
1207 appIdKey = mkPreludeMiscIdUnique 230
1208 infixEIdKey = mkPreludeMiscIdUnique 231
1209 lamIdKey = mkPreludeMiscIdUnique 232
1210 tupIdKey = mkPreludeMiscIdUnique 233
1211 doEIdKey = mkPreludeMiscIdUnique 234
1212 compIdKey = mkPreludeMiscIdUnique 235
1213 listExpIdKey = mkPreludeMiscIdUnique 237
1214 condIdKey = mkPreludeMiscIdUnique 238
1215 letEIdKey = mkPreludeMiscIdUnique 239
1216 caseEIdKey = mkPreludeMiscIdUnique 240
1217 infixAppIdKey = mkPreludeMiscIdUnique 241
1219 sectionLIdKey = mkPreludeMiscIdUnique 243
1220 sectionRIdKey = mkPreludeMiscIdUnique 244
1221 guardedIdKey = mkPreludeMiscIdUnique 245
1222 normalIdKey = mkPreludeMiscIdUnique 246
1223 bindStIdKey = mkPreludeMiscIdUnique 247
1224 letStIdKey = mkPreludeMiscIdUnique 248
1225 noBindStIdKey = mkPreludeMiscIdUnique 249
1226 parStIdKey = mkPreludeMiscIdUnique 250
1228 tvarIdKey = mkPreludeMiscIdUnique 251
1229 tconIdKey = mkPreludeMiscIdUnique 252
1230 tappIdKey = mkPreludeMiscIdUnique 253
1232 arrowIdKey = mkPreludeMiscIdUnique 254
1233 tupleIdKey = mkPreludeMiscIdUnique 255
1234 listIdKey = mkPreludeMiscIdUnique 256
1235 namedTyConIdKey = mkPreludeMiscIdUnique 257
1237 constrIdKey = mkPreludeMiscIdUnique 258
1239 stringLIdKey = mkPreludeMiscIdUnique 259
1240 rationalLIdKey = mkPreludeMiscIdUnique 260
1242 sigExpIdKey = mkPreludeMiscIdUnique 261
1246 -- %************************************************************************
1250 -- %************************************************************************
1252 -- It is rather usatisfactory that we don't have a SrcLoc
1253 addDsWarn :: SDoc -> DsM ()
1254 addDsWarn msg = dsWarn (noSrcLoc, msg)