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,
47 import MkIface ( ifaceTyThing )
48 import Name ( Name, nameOccName, nameModule )
49 import OccName ( isDataOcc, isTvOcc, occNameUserString )
50 -- To avoid clashes with DsMeta.varName we must make a local alias for OccName.varName
51 -- we do this by removing varName from the import of OccName above, making
52 -- a qualified instance of OccName and using OccNameAlias.varName where varName
53 -- ws previously used in this file.
54 import qualified OccName( varName, tcName )
56 import Module ( Module, mkThPkgModule, moduleUserString )
57 import Id ( Id, idType )
58 import Name ( mkKnownKeyExternalName )
59 import OccName ( mkOccFS )
62 import Type ( Type, TyThing(..), mkGenTyConApp )
63 import TyCon ( DataConDetails(..) )
64 import TysWiredIn ( stringTy )
66 import CoreUtils ( exprType )
67 import SrcLoc ( noSrcLoc )
68 import Maybe ( catMaybes, fromMaybe )
69 import Panic ( panic )
70 import Unique ( mkPreludeTyConUnique, mkPreludeMiscIdUnique )
71 import BasicTypes ( NewOrData(..), StrictnessMark(..), isBoxed )
74 import FastString ( mkFastString )
76 -----------------------------------------------------------------------------
77 dsBracket :: HsBracket Name -> [PendingSplice] -> DsM CoreExpr
78 -- Returns a CoreExpr of type M.Expr
79 -- The quoted thing is parameterised over Name, even though it has
80 -- been type checked. We don't want all those type decorations!
82 dsBracket brack splices
83 = dsExtendMetaEnv new_bit (do_brack brack)
85 new_bit = mkNameEnv [(n, Splice e) | (n,e) <- splices]
87 do_brack (ExpBr e) = do { MkC e1 <- repE e ; return e1 }
88 do_brack (PatBr p) = do { MkC p1 <- repP p ; return p1 }
89 do_brack (TypBr t) = do { MkC t1 <- repTy t ; return t1 }
90 do_brack (DecBr ds) = do { MkC ds1 <- repTopDs ds ; return ds1 }
92 -----------------------------------------------------------------------------
93 dsReify :: HsReify Id -> DsM CoreExpr
94 -- Returns a CoreExpr of type reifyType --> M.Type
95 -- reifyDecl --> M.Decl
96 -- reifyFixty --> Q M.Fix
97 dsReify (ReifyOut ReifyType name)
98 = do { thing <- dsLookupGlobal name ;
99 -- By deferring the lookup until now (rather than doing it
100 -- in the type checker) we ensure that all zonking has
103 AnId id -> do { MkC e <- repTy (toHsType (idType id)) ;
105 other -> pprPanic "dsReify: reifyType" (ppr name)
108 dsReify r@(ReifyOut ReifyDecl name)
109 = do { thing <- dsLookupGlobal name ;
110 mb_d <- repTyClD (ifaceTyThing thing) ;
112 Just (MkC d) -> return d
113 Nothing -> pprPanic "dsReify" (ppr r)
116 {- -------------- Examples --------------------
120 gensym (unpackString "x"#) `bindQ` \ x1::String ->
121 lam (pvar x1) (var x1)
124 [| \x -> $(f [| x |]) |]
126 gensym (unpackString "x"#) `bindQ` \ x1::String ->
127 lam (pvar x1) (f (var x1))
131 -------------------------------------------------------
133 -------------------------------------------------------
135 repTopDs :: HsGroup Name -> DsM (Core (M.Q [M.Dec]))
137 = do { let { bndrs = groupBinders group } ;
138 ss <- mkGenSyms bndrs ;
140 -- Bind all the names mainly to avoid repeated use of explicit strings.
142 -- do { t :: String <- genSym "T" ;
143 -- return (Data t [] ...more t's... }
144 -- The other important reason is that the output must mention
145 -- only "T", not "Foo.T" where Foo is the current module
148 decls <- addBinds ss (do {
149 val_ds <- rep_binds (hs_valds group) ;
150 tycl_ds <- mapM repTyClD (hs_tyclds group) ;
151 inst_ds <- mapM repInstD (hs_instds group) ;
153 return (val_ds ++ catMaybes tycl_ds ++ inst_ds) }) ;
155 decl_ty <- lookupType declTyConName ;
156 let { core_list = coreList' decl_ty decls } ;
157 q_decs <- repSequenceQ decl_ty core_list ;
159 wrapNongenSyms ss q_decs
160 -- Do *not* gensym top-level binders
163 groupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
164 hs_fords = foreign_decls })
165 -- Collect the binders of a Group
166 = collectHsBinders val_decls ++
167 [n | d <- tycl_decls, (n,_) <- tyClDeclNames d] ++
168 [n | ForeignImport n _ _ _ _ <- foreign_decls]
171 {- Note [Binders and occurrences]
172 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
173 When we desugar [d| data T = MkT |]
175 Data "T" [] [Con "MkT" []] []
177 Data "Foo:T" [] [Con "Foo:MkT" []] []
178 That is, the new data decl should fit into whatever new module it is
179 asked to fit in. We do *not* clone, though; no need for this:
186 then we must desugar to
187 foo = Data "Foo:T" [] [Con "Foo:MkT" []] []
189 So in repTopDs we bring the binders into scope with mkGenSyms and addBinds,
190 but in dsReify we do not. And we use lookupOcc, rather than lookupBinder
191 in repTyClD and repC.
195 repTyClD :: TyClDecl Name -> DsM (Maybe (Core M.Decl))
197 repTyClD (TyData { tcdND = DataType, tcdCtxt = [],
198 tcdName = tc, tcdTyVars = tvs,
199 tcdCons = DataCons cons, tcdDerivs = mb_derivs })
200 = do { tc1 <- lookupOcc tc ; -- See note [Binders and occurrences]
202 cons1 <- mapM repC cons ;
203 cons2 <- coreList consTyConName cons1 ;
204 derivs1 <- repDerivs mb_derivs ;
205 dec <- repData tc1 tvs1 cons2 derivs1 ;
208 repTyClD (ClassDecl { tcdCtxt = cxt, tcdName = cls,
209 tcdTyVars = tvs, tcdFDs = [],
210 tcdSigs = sigs, tcdMeths = Just binds
212 = do { cls1 <- lookupOcc cls ; -- See note [Binders and occurrences]
214 cxt1 <- repContext cxt ;
215 sigs1 <- rep_sigs sigs ;
216 binds1 <- rep_monobind binds ;
217 decls1 <- coreList declTyConName (sigs1 ++ binds1) ;
218 dec <- repClass cxt1 cls1 tvs1 decls1 ;
222 repTyClD d = do { addDsWarn (hang msg 4 (ppr d)) ;
226 msg = ptext SLIT("Cannot desugar this Template Haskell declaration:")
228 repInstD (InstDecl ty binds _ _ loc)
229 -- Ignore user pragmas for now
230 = do { cxt1 <- repContext cxt ;
231 inst_ty1 <- repPred (HsClassP cls tys) ;
232 binds1 <- rep_monobind binds ;
233 decls1 <- coreList declTyConName binds1 ;
234 repInst cxt1 inst_ty1 decls1 }
236 (tvs, cxt, cls, tys) = splitHsInstDeclTy ty
239 -------------------------------------------------------
241 -------------------------------------------------------
243 repC :: ConDecl Name -> DsM (Core M.Cons)
244 repC (ConDecl con [] [] details loc)
245 = do { con1 <- lookupOcc con ; -- See note [Binders and occurrences]
246 arg_tys <- mapM (repBangTy con) (hsConArgs details) ;
247 arg_tys1 <- coreList typeTyConName arg_tys ;
248 repConstr con1 arg_tys1 }
250 repBangTy con (BangType NotMarkedStrict ty) = repTy ty
251 repBangTy con bty = do { addDsWarn msg ; repTy (getBangType bty) }
253 msg = ptext SLIT("Ignoring stricness on argument of constructor")
256 -------------------------------------------------------
258 -------------------------------------------------------
260 repDerivs :: Maybe (HsContext Name) -> DsM (Core [String])
261 repDerivs Nothing = return (coreList' stringTy [])
262 repDerivs (Just ctxt)
263 = do { strs <- mapM rep_deriv ctxt ;
264 return (coreList' stringTy strs) }
266 rep_deriv :: HsPred Name -> DsM (Core String)
267 -- Deriving clauses must have the simple H98 form
268 rep_deriv (HsClassP cls []) = lookupOcc cls
269 rep_deriv other = panic "rep_deriv"
272 -------------------------------------------------------
273 -- Signatures in a class decl, or a group of bindings
274 -------------------------------------------------------
276 rep_sigs :: [Sig Name] -> DsM [Core M.Decl]
277 -- We silently ignore ones we don't recognise
278 rep_sigs sigs = do { sigs1 <- mapM rep_sig sigs ;
279 return (concat sigs1) }
281 rep_sig :: Sig Name -> DsM [Core M.Decl]
283 -- Empty => Too hard, signature ignored
284 rep_sig (ClassOpSig nm _ ty _) = rep_proto nm ty
285 rep_sig (Sig nm ty _) = rep_proto nm ty
286 rep_sig other = return []
288 rep_proto nm ty = do { nm1 <- lookupBinder nm ;
290 sig <- repProto nm1 ty1 ;
294 -------------------------------------------------------
296 -------------------------------------------------------
298 -- represent a list of type variables in a usage position that does not need
301 repTvs :: [HsTyVarBndr Name] -> DsM (Core [String])
302 repTvs tvs = do { tvs1 <- mapM (localVar . hsTyVarName) tvs ;
303 return (coreList' stringTy tvs1) }
305 -- represent a type context
307 repContext :: HsContext Name -> DsM (Core M.Ctxt)
309 preds <- mapM repPred ctxt
310 predList <- coreList typeTyConName preds
313 -- represent a type predicate
315 repPred :: HsPred Name -> DsM (Core M.Type)
316 repPred (HsClassP cls tys) = do
317 tcon <- repTy (HsTyVar cls)
320 repPred (HsIParam _ _) =
321 panic "DsMeta.repTy: Can't represent predicates with implicit parameters"
323 -- yield the representation of a list of types
325 repTys :: [HsType Name] -> DsM [Core M.Type]
326 repTys tys = mapM repTy tys
330 repTy :: HsType Name -> DsM (Core M.Type)
331 repTy (HsForAllTy bndrs ctxt ty) =
333 let names = map hsTyVarName (fromMaybe [] bndrs)
334 freshNames <- mkGenSyms names
335 forallTy <- addBinds freshNames $ do
336 bndrs' <- mapM lookupBinder names
337 ctxt' <- repContext ctxt
339 repTForall (coreList' stringTy bndrs') ctxt' ty'
340 wrapGenSyns typTyConName freshNames forallTy
342 | isTvOcc (nameOccName n) = do
343 tv1 <- lookupBinder n
348 repTy (HsAppTy f a) = do
352 repTy (HsFunTy f a) = do
355 tcon <- repArrowTyCon
356 repTapps tcon [f1, a1]
357 repTy (HsListTy t) = do
361 repTy (HsPArrTy t) = do
363 tcon <- repTy (HsTyVar parrTyConName)
365 repTy (HsTupleTy tc tys) = do
367 tcon <- repTupleTyCon (length tys)
369 repTy (HsOpTy ty1 HsArrow ty2) = repTy (HsFunTy ty1 ty2)
370 repTy (HsOpTy ty1 (HsTyOp n) ty2) = repTy ((HsTyVar n `HsAppTy` ty1)
372 repTy (HsParTy t) = repTy t
374 panic "DsMeta.repTy: Can't represent number types (for generics)"
375 repTy (HsPredTy pred) = repPred pred
376 repTy (HsKindSig ty kind) =
377 panic "DsMeta.repTy: Can't represent explicit kind signatures yet"
380 -----------------------------------------------------------------------------
382 -----------------------------------------------------------------------------
384 repEs :: [HsExpr Name] -> DsM (Core [M.Expr])
385 repEs es = do { es' <- mapM repE es ;
386 coreList exprTyConName es' }
388 -- FIXME: some of these panics should be converted into proper error messages
389 -- unless we can make sure that constructs, which are plainly not
390 -- supported in TH already lead to error messages at an earlier stage
391 repE :: HsExpr Name -> DsM (Core M.Expr)
393 do { mb_val <- dsLookupMetaEnv x
395 Nothing -> do { str <- globalVar x
396 ; repVarOrCon x str }
397 Just (Bound y) -> repVarOrCon x (coreVar y)
398 Just (Splice e) -> do { e' <- dsExpr e
399 ; return (MkC e') } }
400 repE (HsIPVar x) = panic "DsMeta.repE: Can't represent implicit parameters"
402 -- Remember, we're desugaring renamer output here, so
403 -- HsOverlit can definitely occur
404 repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
405 repE (HsLit l) = do { a <- repLiteral l; repLit a }
406 repE (HsLam m) = repLambda m
407 repE (HsApp x y) = do {a <- repE x; b <- repE y; repApp a b}
409 repE (OpApp e1 op fix e2) =
411 HsVar op -> do { arg1 <- repE e1;
413 the_op <- lookupOcc op ;
414 repInfixApp arg1 the_op arg2 }
415 _ -> panic "DsMeta.repE: Operator is not a variable"
416 repE (NegApp x nm) = do
418 negateVar <- lookupOcc negateName >>= repVar
420 repE (HsPar x) = repE x
421 repE (SectionL x y) = do { a <- repE x; b <- repE y; repSectionL a b }
422 repE (SectionR x y) = do { a <- repE x; b <- repE y; repSectionR a b }
423 repE (HsCase e ms loc) = do { arg <- repE e
424 ; ms2 <- mapM repMatchTup ms
425 ; repCaseE arg (nonEmptyCoreList ms2) }
426 repE (HsIf x y z loc) = do
431 repE (HsLet bs e) = do { (ss,ds) <- repBinds bs
432 ; e2 <- addBinds ss (repE e)
434 ; wrapGenSyns expTyConName ss z }
435 -- FIXME: I haven't got the types here right yet
436 repE (HsDo DoExpr sts _ ty loc)
437 = do { (ss,zs) <- repSts sts;
438 e <- repDoE (nonEmptyCoreList zs);
439 wrapGenSyns expTyConName ss e }
440 repE (HsDo ListComp sts _ ty loc)
441 = do { (ss,zs) <- repSts sts;
442 e <- repComp (nonEmptyCoreList zs);
443 wrapGenSyns expTyConName ss e }
444 repE (HsDo _ _ _ _ _) = panic "DsMeta.repE: Can't represent mdo and [: :] yet"
445 repE (ExplicitList ty es) = do { xs <- repEs es; repListExp xs }
446 repE (ExplicitPArr ty es) =
447 panic "DsMeta.repE: No explicit parallel arrays yet"
448 repE (ExplicitTuple es boxed)
449 | isBoxed boxed = do { xs <- repEs es; repTup xs }
450 | otherwise = panic "DsMeta.repE: Can't represent unboxed tuples"
451 repE (RecordConOut _ _ _) = panic "DsMeta.repE: No record construction yet"
452 repE (RecordUpdOut _ _ _ _) = panic "DsMeta.repE: No record update yet"
454 repE (ExprWithTySig e ty) = do { e1 <- repE e; t1 <- repTy ty; repSigExp e1 t1 }
455 repE (ArithSeqIn aseq) =
457 From e -> do { ds1 <- repE e; repFrom ds1 }
466 FromThenTo e1 e2 e3 -> do
470 repFromThenTo ds1 ds2 ds3
471 repE (PArrSeqOut _ aseq) = panic "DsMeta.repE: parallel array seq.s missing"
472 repE (HsCCall _ _ _ _ _) = panic "DsMeta.repE: Can't represent __ccall__"
473 repE (HsSCC _ _) = panic "DsMeta.repE: Can't represent SCC"
474 repE (HsBracketOut _ _) =
475 panic "DsMeta.repE: Can't represent Oxford brackets"
476 repE (HsSplice n e loc) = do { mb_val <- dsLookupMetaEnv n
478 Just (Splice e) -> do { e' <- dsExpr e
480 other -> pprPanic "HsSplice" (ppr n) }
481 repE (HsReify _) = panic "DsMeta.repE: Can't represent reification"
483 pprPanic "DsMeta.repE: Illegal expression form" (ppr e)
485 -----------------------------------------------------------------------------
486 -- Building representations of auxillary structures like Match, Clause, Stmt,
488 repMatchTup :: Match Name -> DsM (Core M.Mtch)
489 repMatchTup (Match [p] ty (GRHSs guards wheres ty2)) =
490 do { ss1 <- mkGenSyms (collectPatBinders p)
491 ; addBinds ss1 $ do {
493 ; (ss2,ds) <- repBinds wheres
494 ; addBinds ss2 $ do {
495 ; gs <- repGuards guards
496 ; match <- repMatch p1 gs ds
497 ; wrapGenSyns matTyConName (ss1++ss2) match }}}
499 repClauseTup :: Match Name -> DsM (Core M.Clse)
500 repClauseTup (Match ps ty (GRHSs guards wheres ty2)) =
501 do { ss1 <- mkGenSyms (collectPatsBinders ps)
502 ; addBinds ss1 $ do {
504 ; (ss2,ds) <- repBinds wheres
505 ; addBinds ss2 $ do {
506 gs <- repGuards guards
507 ; clause <- repClause ps1 gs ds
508 ; wrapGenSyns clsTyConName (ss1++ss2) clause }}}
510 repGuards :: [GRHS Name] -> DsM (Core M.Rihs)
511 repGuards [GRHS [ResultStmt e loc] loc2]
512 = do {a <- repE e; repNormal a }
514 = do { zs <- mapM process other;
515 repGuarded (nonEmptyCoreList (map corePair zs)) }
517 process (GRHS [ExprStmt e1 ty loc,ResultStmt e2 _] _)
518 = do { x <- repE e1; y <- repE e2; return (x, y) }
519 process other = panic "Non Haskell 98 guarded body"
522 -----------------------------------------------------------------------------
523 -- Representing Stmt's is tricky, especially if bound variables
524 -- shaddow each other. Consider: [| do { x <- f 1; x <- f x; g x } |]
525 -- First gensym new names for every variable in any of the patterns.
526 -- both static (x'1 and x'2), and dynamic ((gensym "x") and (gensym "y"))
527 -- if variables didn't shaddow, the static gensym wouldn't be necessary
528 -- and we could reuse the original names (x and x).
530 -- do { x'1 <- gensym "x"
531 -- ; x'2 <- gensym "x"
532 -- ; doE [ BindSt (pvar x'1) [| f 1 |]
533 -- , BindSt (pvar x'2) [| f x |]
534 -- , NoBindSt [| g x |]
538 -- The strategy is to translate a whole list of do-bindings by building a
539 -- bigger environment, and a bigger set of meta bindings
540 -- (like: x'1 <- gensym "x" ) and then combining these with the translations
541 -- of the expressions within the Do
543 -----------------------------------------------------------------------------
544 -- The helper function repSts computes the translation of each sub expression
545 -- and a bunch of prefix bindings denoting the dynamic renaming.
547 repSts :: [Stmt Name] -> DsM ([GenSymBind], [Core M.Stmt])
548 repSts [ResultStmt e loc] =
550 ; e1 <- repNoBindSt a
551 ; return ([], [e1]) }
552 repSts (BindStmt p e loc : ss) =
554 ; ss1 <- mkGenSyms (collectPatBinders p)
555 ; addBinds ss1 $ do {
557 ; (ss2,zs) <- repSts ss
558 ; z <- repBindSt p1 e2
559 ; return (ss1++ss2, z : zs) }}
560 repSts (LetStmt bs : ss) =
561 do { (ss1,ds) <- repBinds bs
563 ; (ss2,zs) <- addBinds ss1 (repSts ss)
564 ; return (ss1++ss2, z : zs) }
565 repSts (ExprStmt e ty loc : ss) =
567 ; z <- repNoBindSt e2
568 ; (ss2,zs) <- repSts ss
569 ; return (ss2, z : zs) }
570 repSts other = panic "Exotic Stmt in meta brackets"
573 -----------------------------------------------------------
575 -----------------------------------------------------------
577 repBinds :: HsBinds Name -> DsM ([GenSymBind], Core [M.Decl])
579 = do { let { bndrs = collectHsBinders decs } ;
580 ss <- mkGenSyms bndrs ;
581 core <- addBinds ss (rep_binds decs) ;
582 core_list <- coreList declTyConName core ;
583 return (ss, core_list) }
585 rep_binds :: HsBinds Name -> DsM [Core M.Decl]
586 rep_binds EmptyBinds = return []
587 rep_binds (ThenBinds x y)
588 = do { core1 <- rep_binds x
589 ; core2 <- rep_binds y
590 ; return (core1 ++ core2) }
591 rep_binds (MonoBind bs sigs _)
592 = do { core1 <- rep_monobind bs
593 ; core2 <- rep_sigs sigs
594 ; return (core1 ++ core2) }
595 rep_binds (IPBinds _ _)
596 = panic "DsMeta:repBinds: can't do implicit parameters"
598 rep_monobind :: MonoBinds Name -> DsM [Core M.Decl]
599 rep_monobind EmptyMonoBinds = return []
600 rep_monobind (AndMonoBinds x y) = do { x1 <- rep_monobind x;
601 y1 <- rep_monobind y;
604 -- Note GHC treats declarations of a variable (not a pattern)
605 -- e.g. x = g 5 as a Fun MonoBinds. This is indicated by a single match
606 -- with an empty list of patterns
607 rep_monobind (FunMonoBind fn infx [Match [] ty (GRHSs guards wheres ty2)] loc)
608 = do { (ss,wherecore) <- repBinds wheres
609 ; guardcore <- addBinds ss (repGuards guards)
610 ; fn' <- lookupBinder fn
612 ; ans <- repVal p guardcore wherecore
615 rep_monobind (FunMonoBind fn infx ms loc)
616 = do { ms1 <- mapM repClauseTup ms
617 ; fn' <- lookupBinder fn
618 ; ans <- repFun fn' (nonEmptyCoreList ms1)
621 rep_monobind (PatMonoBind pat (GRHSs guards wheres ty2) loc)
622 = do { patcore <- repP pat
623 ; (ss,wherecore) <- repBinds wheres
624 ; guardcore <- addBinds ss (repGuards guards)
625 ; ans <- repVal patcore guardcore wherecore
628 rep_monobind (VarMonoBind v e)
629 = do { v' <- lookupBinder v
632 ; patcore <- repPvar v'
633 ; empty_decls <- coreList declTyConName []
634 ; ans <- repVal patcore x empty_decls
637 -----------------------------------------------------------------------------
638 -- Since everything in a MonoBind is mutually recursive we need rename all
639 -- all the variables simultaneously. For example:
640 -- [| AndMonoBinds (f x = x + g 2) (g x = f 1 + 2) |] would translate to
641 -- do { f'1 <- gensym "f"
642 -- ; g'2 <- gensym "g"
643 -- ; [ do { x'3 <- gensym "x"; fun f'1 [pvar x'3] [| x + g2 |]},
644 -- do { x'4 <- gensym "x"; fun g'2 [pvar x'4] [| f 1 + 2 |]}
646 -- This requires collecting the bindings (f'1 <- gensym "f"), and the
647 -- environment ( f |-> f'1 ) from each binding, and then unioning them
648 -- together. As we do this we collect GenSymBinds's which represent the renamed
649 -- variables bound by the Bindings. In order not to lose track of these
650 -- representations we build a shadow datatype MB with the same structure as
651 -- MonoBinds, but which has slots for the representations
654 -----------------------------------------------------------------------------
655 -- GHC allows a more general form of lambda abstraction than specified
656 -- by Haskell 98. In particular it allows guarded lambda's like :
657 -- (\ x | even x -> 0 | odd x -> 1) at the moment we can't represent this in
658 -- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like
659 -- (\ p1 .. pn -> exp) by causing an error.
661 repLambda :: Match Name -> DsM (Core M.Expr)
662 repLambda (Match ps _ (GRHSs [GRHS [ResultStmt e _ ] _ ]
664 = do { let bndrs = collectPatsBinders ps ;
665 ; ss <- mkGenSyms bndrs
666 ; lam <- addBinds ss (
667 do { xs <- repPs ps; body <- repE e; repLam xs body })
668 ; wrapGenSyns expTyConName ss lam }
670 repLambda z = panic "Can't represent a guarded lambda in Template Haskell"
673 -----------------------------------------------------------------------------
675 -- repP deals with patterns. It assumes that we have already
676 -- walked over the pattern(s) once to collect the binders, and
677 -- have extended the environment. So every pattern-bound
678 -- variable should already appear in the environment.
680 -- Process a list of patterns
681 repPs :: [Pat Name] -> DsM (Core [M.Patt])
682 repPs ps = do { ps' <- mapM repP ps ;
683 coreList pattTyConName ps' }
685 repP :: Pat Name -> DsM (Core M.Patt)
686 repP (WildPat _) = repPwild
687 repP (LitPat l) = do { l2 <- repLiteral l; repPlit l2 }
688 repP (VarPat x) = do { x' <- lookupBinder x; repPvar x' }
689 repP (LazyPat p) = do { p1 <- repP p; repPtilde p1 }
690 repP (AsPat x p) = do { x' <- lookupBinder x; p1 <- repP p; repPaspat x' p1 }
691 repP (ParPat p) = repP p
692 repP (ListPat ps _) = repListPat ps
693 repP (TuplePat ps _) = do { qs <- repPs ps; repPtup qs }
694 repP (ConPatIn dc details)
695 = do { con_str <- lookupOcc dc
697 PrefixCon ps -> do { qs <- repPs ps; repPcon con_str qs }
698 RecCon pairs -> error "No records in template haskell yet"
699 InfixCon p1 p2 -> do { qs <- repPs [p1,p2]; repPcon con_str qs }
701 repP (NPatIn l (Just _)) = panic "Can't cope with negative overloaded patterns yet (repP (NPatIn _ (Just _)))"
702 repP (NPatIn l Nothing) = do { a <- repOverloadedLiteral l; repPlit a }
703 repP other = panic "Exotic pattern inside meta brackets"
705 repListPat :: [Pat Name] -> DsM (Core M.Patt)
706 repListPat [] = do { nil_con <- coreStringLit "[]"
707 ; nil_args <- coreList pattTyConName []
708 ; repPcon nil_con nil_args }
709 repListPat (p:ps) = do { p2 <- repP p
710 ; ps2 <- repListPat ps
711 ; cons_con <- coreStringLit ":"
712 ; repPcon cons_con (nonEmptyCoreList [p2,ps2]) }
715 ----------------------------------------------------------
716 -- The meta-environment
718 -- A name/identifier association for fresh names of locally bound entities
720 type GenSymBind = (Name, Id) -- Gensym the string and bind it to the Id
721 -- I.e. (x, x_id) means
722 -- let x_id = gensym "x" in ...
724 -- Generate a fresh name for a locally bound entity
726 mkGenSym :: Name -> DsM GenSymBind
727 mkGenSym nm = do { id <- newUniqueId nm stringTy; return (nm,id) }
729 -- Ditto for a list of names
731 mkGenSyms :: [Name] -> DsM [GenSymBind]
732 mkGenSyms ns = mapM mkGenSym ns
734 -- Add a list of fresh names for locally bound entities to the meta
735 -- environment (which is part of the state carried around by the desugarer
738 addBinds :: [GenSymBind] -> DsM a -> DsM a
739 addBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,Bound id) | (n,id) <- bs]) m
741 -- Look up a locally bound name
743 lookupBinder :: Name -> DsM (Core String)
745 = do { mb_val <- dsLookupMetaEnv n;
747 Just (Bound x) -> return (coreVar x)
748 other -> pprPanic "Failed binder lookup:" (ppr n) }
750 -- Look up a name that is either locally bound or a global name
752 -- * If it is a global name, generate the "original name" representation (ie,
753 -- the <module>:<name> form) for the associated entity
755 lookupOcc :: Name -> DsM (Core String)
756 -- Lookup an occurrence; it can't be a splice.
757 -- Use the in-scope bindings if they exist
759 = do { mb_val <- dsLookupMetaEnv n ;
761 Nothing -> globalVar n
762 Just (Bound x) -> return (coreVar x)
763 Just (Splice _) -> pprPanic "repE:lookupOcc" (ppr n)
766 globalVar :: Name -> DsM (Core String)
767 globalVar n = coreStringLit (name_mod ++ ":" ++ name_occ)
769 name_mod = moduleUserString (nameModule n)
770 name_occ = occNameUserString (nameOccName n)
772 localVar :: Name -> DsM (Core String)
773 localVar n = coreStringLit (occNameUserString (nameOccName n))
775 lookupType :: Name -- Name of type constructor (e.g. M.Expr)
776 -> DsM Type -- The type
777 lookupType tc_name = do { tc <- dsLookupTyCon tc_name ;
778 return (mkGenTyConApp tc []) }
780 -- wrapGenSyns [(nm1,id1), (nm2,id2)] y
781 -- --> bindQ (gensym nm1) (\ id1 ->
782 -- bindQ (gensym nm2 (\ id2 ->
785 wrapGenSyns :: Name -- Name of the type (consructor) for 'a'
787 -> Core (M.Q a) -> DsM (Core (M.Q a))
788 wrapGenSyns tc_name binds body@(MkC b)
789 = do { elt_ty <- lookupType tc_name
792 go elt_ty [] = return body
793 go elt_ty ((name,id) : binds)
794 = do { MkC body' <- go elt_ty binds
795 ; lit_str <- localVar name
796 ; gensym_app <- repGensym lit_str
797 ; repBindQ stringTy elt_ty
798 gensym_app (MkC (Lam id body')) }
800 -- Just like wrapGenSym, but don't actually do the gensym
801 -- Instead use the existing name
802 -- Only used for [Decl]
803 wrapNongenSyms :: [GenSymBind] -> Core a -> DsM (Core a)
804 wrapNongenSyms binds (MkC body)
805 = do { binds' <- mapM do_one binds ;
806 return (MkC (mkLets binds' body)) }
809 = do { MkC lit_str <- localVar name -- No gensym
810 ; return (NonRec id lit_str) }
812 void = placeHolderType
814 string :: String -> HsExpr Id
815 string s = HsLit (HsString (mkFastString s))
818 -- %*********************************************************************
822 -- %*********************************************************************
824 -----------------------------------------------------------------------------
825 -- PHANTOM TYPES for consistency. In order to make sure we do this correct
826 -- we invent a new datatype which uses phantom types.
828 newtype Core a = MkC CoreExpr
831 rep2 :: Name -> [ CoreExpr ] -> DsM (Core a)
832 rep2 n xs = do { id <- dsLookupGlobalId n
833 ; return (MkC (foldl App (Var id) xs)) }
835 -- Then we make "repConstructors" which use the phantom types for each of the
836 -- smart constructors of the Meta.Meta datatypes.
839 -- %*********************************************************************
841 -- The 'smart constructors'
843 -- %*********************************************************************
845 --------------- Patterns -----------------
846 repPlit :: Core M.Lit -> DsM (Core M.Patt)
847 repPlit (MkC l) = rep2 plitName [l]
849 repPvar :: Core String -> DsM (Core M.Patt)
850 repPvar (MkC s) = rep2 pvarName [s]
852 repPtup :: Core [M.Patt] -> DsM (Core M.Patt)
853 repPtup (MkC ps) = rep2 ptupName [ps]
855 repPcon :: Core String -> Core [M.Patt] -> DsM (Core M.Patt)
856 repPcon (MkC s) (MkC ps) = rep2 pconName [s, ps]
858 repPtilde :: Core M.Patt -> DsM (Core M.Patt)
859 repPtilde (MkC p) = rep2 ptildeName [p]
861 repPaspat :: Core String -> Core M.Patt -> DsM (Core M.Patt)
862 repPaspat (MkC s) (MkC p) = rep2 paspatName [s, p]
864 repPwild :: DsM (Core M.Patt)
865 repPwild = rep2 pwildName []
867 --------------- Expressions -----------------
868 repVarOrCon :: Name -> Core String -> DsM (Core M.Expr)
869 repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
870 | otherwise = repVar str
872 repVar :: Core String -> DsM (Core M.Expr)
873 repVar (MkC s) = rep2 varName [s]
875 repCon :: Core String -> DsM (Core M.Expr)
876 repCon (MkC s) = rep2 conName [s]
878 repLit :: Core M.Lit -> DsM (Core M.Expr)
879 repLit (MkC c) = rep2 litName [c]
881 repApp :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
882 repApp (MkC x) (MkC y) = rep2 appName [x,y]
884 repLam :: Core [M.Patt] -> Core M.Expr -> DsM (Core M.Expr)
885 repLam (MkC ps) (MkC e) = rep2 lamName [ps, e]
887 repTup :: Core [M.Expr] -> DsM (Core M.Expr)
888 repTup (MkC es) = rep2 tupName [es]
890 repCond :: Core M.Expr -> Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
891 repCond (MkC x) (MkC y) (MkC z) = rep2 condName [x,y,z]
893 repLetE :: Core [M.Decl] -> Core M.Expr -> DsM (Core M.Expr)
894 repLetE (MkC ds) (MkC e) = rep2 letEName [ds, e]
896 repCaseE :: Core M.Expr -> Core [M.Mtch] -> DsM( Core M.Expr)
897 repCaseE (MkC e) (MkC ms) = rep2 caseEName [e, ms]
899 repDoE :: Core [M.Stmt] -> DsM (Core M.Expr)
900 repDoE (MkC ss) = rep2 doEName [ss]
902 repComp :: Core [M.Stmt] -> DsM (Core M.Expr)
903 repComp (MkC ss) = rep2 compName [ss]
905 repListExp :: Core [M.Expr] -> DsM (Core M.Expr)
906 repListExp (MkC es) = rep2 listExpName [es]
908 repSigExp :: Core M.Expr -> Core M.Type -> DsM (Core M.Expr)
909 repSigExp (MkC e) (MkC t) = rep2 sigExpName [e,t]
911 repInfixApp :: Core M.Expr -> Core String -> Core M.Expr -> DsM (Core M.Expr)
912 repInfixApp (MkC x) (MkC y) (MkC z) = rep2 infixAppName [x,y,z]
914 repSectionL :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
915 repSectionL (MkC x) (MkC y) = rep2 infixAppName [x,y]
917 repSectionR :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
918 repSectionR (MkC x) (MkC y) = rep2 infixAppName [x,y]
920 ------------ Right hand sides (guarded expressions) ----
921 repGuarded :: Core [(M.Expr, M.Expr)] -> DsM (Core M.Rihs)
922 repGuarded (MkC pairs) = rep2 guardedName [pairs]
924 repNormal :: Core M.Expr -> DsM (Core M.Rihs)
925 repNormal (MkC e) = rep2 normalName [e]
927 ------------- Statements -------------------
928 repBindSt :: Core M.Patt -> Core M.Expr -> DsM (Core M.Stmt)
929 repBindSt (MkC p) (MkC e) = rep2 bindStName [p,e]
931 repLetSt :: Core [M.Decl] -> DsM (Core M.Stmt)
932 repLetSt (MkC ds) = rep2 letStName [ds]
934 repNoBindSt :: Core M.Expr -> DsM (Core M.Stmt)
935 repNoBindSt (MkC e) = rep2 noBindStName [e]
937 -------------- DotDot (Arithmetic sequences) -----------
938 repFrom :: Core M.Expr -> DsM (Core M.Expr)
939 repFrom (MkC x) = rep2 fromName [x]
941 repFromThen :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
942 repFromThen (MkC x) (MkC y) = rep2 fromThenName [x,y]
944 repFromTo :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
945 repFromTo (MkC x) (MkC y) = rep2 fromToName [x,y]
947 repFromThenTo :: Core M.Expr -> Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
948 repFromThenTo (MkC x) (MkC y) (MkC z) = rep2 fromThenToName [x,y,z]
950 ------------ Match and Clause Tuples -----------
951 repMatch :: Core M.Patt -> Core M.Rihs -> Core [M.Decl] -> DsM (Core M.Mtch)
952 repMatch (MkC p) (MkC bod) (MkC ds) = rep2 matchName [p, bod, ds]
954 repClause :: Core [M.Patt] -> Core M.Rihs -> Core [M.Decl] -> DsM (Core M.Clse)
955 repClause (MkC ps) (MkC bod) (MkC ds) = rep2 clauseName [ps, bod, ds]
957 -------------- Dec -----------------------------
958 repVal :: Core M.Patt -> Core M.Rihs -> Core [M.Decl] -> DsM (Core M.Decl)
959 repVal (MkC p) (MkC b) (MkC ds) = rep2 valName [p, b, ds]
961 repFun :: Core String -> Core [M.Clse] -> DsM (Core M.Decl)
962 repFun (MkC nm) (MkC b) = rep2 funName [nm, b]
964 repData :: Core String -> Core [String] -> Core [M.Cons] -> Core [String] -> DsM (Core M.Decl)
965 repData (MkC nm) (MkC tvs) (MkC cons) (MkC derivs) = rep2 dataDName [nm, tvs, cons, derivs]
967 repInst :: Core M.Ctxt -> Core M.Type -> Core [M.Decl] -> DsM (Core M.Decl)
968 repInst (MkC cxt) (MkC ty) (MkC ds) = rep2 instName [cxt, ty, ds]
970 repClass :: Core M.Ctxt -> Core String -> Core [String] -> Core [M.Decl] -> DsM (Core M.Decl)
971 repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC ds) = rep2 classDName [cxt, cls, tvs, ds]
973 repProto :: Core String -> Core M.Type -> DsM (Core M.Decl)
974 repProto (MkC s) (MkC ty) = rep2 protoName [s, ty]
976 repCtxt :: Core [M.Type] -> DsM (Core M.Ctxt)
977 repCtxt (MkC tys) = rep2 ctxtName [tys]
979 repConstr :: Core String -> Core [M.Type] -> DsM (Core M.Cons)
980 repConstr (MkC con) (MkC tys) = rep2 constrName [con, tys]
982 ------------ Types -------------------
984 repTForall :: Core [String] -> Core M.Ctxt -> Core M.Type -> DsM (Core M.Type)
985 repTForall (MkC tvars) (MkC ctxt) (MkC ty) = rep2 tforallName [tvars, ctxt, ty]
987 repTvar :: Core String -> DsM (Core M.Type)
988 repTvar (MkC s) = rep2 tvarName [s]
990 repTapp :: Core M.Type -> Core M.Type -> DsM (Core M.Type)
991 repTapp (MkC t1) (MkC t2) = rep2 tappName [t1,t2]
993 repTapps :: Core M.Type -> [Core M.Type] -> DsM (Core M.Type)
994 repTapps f [] = return f
995 repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
997 --------- Type constructors --------------
999 repNamedTyCon :: Core String -> DsM (Core M.Type)
1000 repNamedTyCon (MkC s) = rep2 namedTyConName [s]
1002 repTupleTyCon :: Int -> DsM (Core M.Type)
1003 -- Note: not Core Int; it's easier to be direct here
1004 repTupleTyCon i = rep2 tupleTyConName [mkIntExpr (fromIntegral i)]
1006 repArrowTyCon :: DsM (Core M.Type)
1007 repArrowTyCon = rep2 arrowTyConName []
1009 repListTyCon :: DsM (Core M.Type)
1010 repListTyCon = rep2 listTyConName []
1013 ----------------------------------------------------------
1016 repLiteral :: HsLit -> DsM (Core M.Lit)
1018 = do { lit_expr <- dsLit lit; rep2 lit_name [lit_expr] }
1020 lit_name = case lit of
1021 HsInteger _ -> integerLName
1022 HsChar _ -> charLName
1023 HsString _ -> stringLName
1024 HsRat _ _ -> rationalLName
1026 uh_oh = pprPanic "DsMeta.repLiteral: trying to represent exotic literal"
1029 repOverloadedLiteral :: HsOverLit -> DsM (Core M.Lit)
1030 repOverloadedLiteral (HsIntegral i _) = repLiteral (HsInteger i)
1031 repOverloadedLiteral (HsFractional f _) = do { rat_ty <- lookupType rationalTyConName ;
1032 repLiteral (HsRat f rat_ty) }
1033 -- The type Rational will be in the environment, becuase
1034 -- the smart constructor 'THSyntax.rationalL' uses it in its type,
1035 -- and rationalL is sucked in when any TH stuff is used
1037 --------------- Miscellaneous -------------------
1039 repLift :: Core e -> DsM (Core M.Expr)
1040 repLift (MkC x) = rep2 liftName [x]
1042 repGensym :: Core String -> DsM (Core (M.Q String))
1043 repGensym (MkC lit_str) = rep2 gensymName [lit_str]
1045 repBindQ :: Type -> Type -- a and b
1046 -> Core (M.Q a) -> Core (a -> M.Q b) -> DsM (Core (M.Q b))
1047 repBindQ ty_a ty_b (MkC x) (MkC y)
1048 = rep2 bindQName [Type ty_a, Type ty_b, x, y]
1050 repSequenceQ :: Type -> Core [M.Q a] -> DsM (Core (M.Q [a]))
1051 repSequenceQ ty_a (MkC list)
1052 = rep2 sequenceQName [Type ty_a, list]
1054 ------------ Lists and Tuples -------------------
1055 -- turn a list of patterns into a single pattern matching a list
1057 coreList :: Name -- Of the TyCon of the element type
1058 -> [Core a] -> DsM (Core [a])
1060 = do { elt_ty <- lookupType tc_name; return (coreList' elt_ty es) }
1062 coreList' :: Type -- The element type
1063 -> [Core a] -> Core [a]
1064 coreList' elt_ty es = MkC (mkListExpr elt_ty (map unC es ))
1066 nonEmptyCoreList :: [Core a] -> Core [a]
1067 -- The list must be non-empty so we can get the element type
1068 -- Otherwise use coreList
1069 nonEmptyCoreList [] = panic "coreList: empty argument"
1070 nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs))
1072 corePair :: (Core a, Core b) -> Core (a,b)
1073 corePair (MkC x, MkC y) = MkC (mkCoreTup [x,y])
1075 coreStringLit :: String -> DsM (Core String)
1076 coreStringLit s = do { z <- mkStringLit s; return(MkC z) }
1078 coreVar :: Id -> Core String -- The Id has type String
1079 coreVar id = MkC (Var id)
1083 -- %************************************************************************
1085 -- The known-key names for Template Haskell
1087 -- %************************************************************************
1089 -- To add a name, do three things
1091 -- 1) Allocate a key
1093 -- 3) Add the name to knownKeyNames
1095 templateHaskellNames :: NameSet
1096 -- The names that are implicitly mentioned by ``bracket''
1097 -- Should stay in sync with the import list of DsMeta
1098 templateHaskellNames
1099 = mkNameSet [ integerLName,charLName, stringLName, rationalLName,
1100 plitName, pvarName, ptupName,
1101 pconName, ptildeName, paspatName, pwildName,
1102 varName, conName, litName, appName, infixEName, lamName,
1103 tupName, doEName, compName,
1104 listExpName, sigExpName, condName, letEName, caseEName,
1105 infixAppName, sectionLName, sectionRName,
1106 guardedName, normalName,
1107 bindStName, letStName, noBindStName, parStName,
1108 fromName, fromThenName, fromToName, fromThenToName,
1109 funName, valName, liftName,
1110 gensymName, returnQName, bindQName, sequenceQName,
1111 matchName, clauseName, funName, valName, dataDName, classDName,
1112 instName, protoName, tforallName, tvarName, tconName, tappName,
1113 arrowTyConName, tupleTyConName, listTyConName, namedTyConName,
1114 ctxtName, constrName,
1115 exprTyConName, declTyConName, pattTyConName, mtchTyConName,
1116 clseTyConName, stmtTyConName, consTyConName, typeTyConName,
1117 qTyConName, expTyConName, matTyConName, clsTyConName,
1118 decTyConName, typTyConName ]
1121 varQual = mk_known_key_name OccName.varName
1122 tcQual = mk_known_key_name OccName.tcName
1125 -- NB: the THSyntax module comes from the "haskell-src" package
1126 thModule = mkThPkgModule mETA_META_Name
1128 mk_known_key_name space str uniq
1129 = mkKnownKeyExternalName thModule (mkOccFS space str) uniq
1131 integerLName = varQual FSLIT("integerL") integerLIdKey
1132 charLName = varQual FSLIT("charL") charLIdKey
1133 stringLName = varQual FSLIT("stringL") stringLIdKey
1134 rationalLName = varQual FSLIT("rationalL") rationalLIdKey
1135 plitName = varQual FSLIT("plit") plitIdKey
1136 pvarName = varQual FSLIT("pvar") pvarIdKey
1137 ptupName = varQual FSLIT("ptup") ptupIdKey
1138 pconName = varQual FSLIT("pcon") pconIdKey
1139 ptildeName = varQual FSLIT("ptilde") ptildeIdKey
1140 paspatName = varQual FSLIT("paspat") paspatIdKey
1141 pwildName = varQual FSLIT("pwild") pwildIdKey
1142 varName = varQual FSLIT("var") varIdKey
1143 conName = varQual FSLIT("con") conIdKey
1144 litName = varQual FSLIT("lit") litIdKey
1145 appName = varQual FSLIT("app") appIdKey
1146 infixEName = varQual FSLIT("infixE") infixEIdKey
1147 lamName = varQual FSLIT("lam") lamIdKey
1148 tupName = varQual FSLIT("tup") tupIdKey
1149 doEName = varQual FSLIT("doE") doEIdKey
1150 compName = varQual FSLIT("comp") compIdKey
1151 listExpName = varQual FSLIT("listExp") listExpIdKey
1152 sigExpName = varQual FSLIT("sigExp") sigExpIdKey
1153 condName = varQual FSLIT("cond") condIdKey
1154 letEName = varQual FSLIT("letE") letEIdKey
1155 caseEName = varQual FSLIT("caseE") caseEIdKey
1156 infixAppName = varQual FSLIT("infixApp") infixAppIdKey
1157 sectionLName = varQual FSLIT("sectionL") sectionLIdKey
1158 sectionRName = varQual FSLIT("sectionR") sectionRIdKey
1159 guardedName = varQual FSLIT("guarded") guardedIdKey
1160 normalName = varQual FSLIT("normal") normalIdKey
1161 bindStName = varQual FSLIT("bindSt") bindStIdKey
1162 letStName = varQual FSLIT("letSt") letStIdKey
1163 noBindStName = varQual FSLIT("noBindSt") noBindStIdKey
1164 parStName = varQual FSLIT("parSt") parStIdKey
1165 fromName = varQual FSLIT("from") fromIdKey
1166 fromThenName = varQual FSLIT("fromThen") fromThenIdKey
1167 fromToName = varQual FSLIT("fromTo") fromToIdKey
1168 fromThenToName = varQual FSLIT("fromThenTo") fromThenToIdKey
1169 liftName = varQual FSLIT("lift") liftIdKey
1170 gensymName = varQual FSLIT("gensym") gensymIdKey
1171 returnQName = varQual FSLIT("returnQ") returnQIdKey
1172 bindQName = varQual FSLIT("bindQ") bindQIdKey
1173 sequenceQName = varQual FSLIT("sequenceQ") sequenceQIdKey
1176 matchName = varQual FSLIT("match") matchIdKey
1179 clauseName = varQual FSLIT("clause") clauseIdKey
1182 funName = varQual FSLIT("fun") funIdKey
1183 valName = varQual FSLIT("val") valIdKey
1184 dataDName = varQual FSLIT("dataD") dataDIdKey
1185 classDName = varQual FSLIT("classD") classDIdKey
1186 instName = varQual FSLIT("inst") instIdKey
1187 protoName = varQual FSLIT("proto") protoIdKey
1190 tforallName = varQual FSLIT("tforall") tforallIdKey
1191 tvarName = varQual FSLIT("tvar") tvarIdKey
1192 tconName = varQual FSLIT("tcon") tconIdKey
1193 tappName = varQual FSLIT("tapp") tappIdKey
1196 arrowTyConName = varQual FSLIT("arrowTyCon") arrowIdKey
1197 tupleTyConName = varQual FSLIT("tupleTyCon") tupleIdKey
1198 listTyConName = varQual FSLIT("listTyCon") listIdKey
1199 namedTyConName = varQual FSLIT("namedTyCon") namedTyConIdKey
1202 ctxtName = varQual FSLIT("ctxt") ctxtIdKey
1205 constrName = varQual FSLIT("constr") constrIdKey
1207 exprTyConName = tcQual FSLIT("Expr") exprTyConKey
1208 declTyConName = tcQual FSLIT("Decl") declTyConKey
1209 pattTyConName = tcQual FSLIT("Patt") pattTyConKey
1210 mtchTyConName = tcQual FSLIT("Mtch") mtchTyConKey
1211 clseTyConName = tcQual FSLIT("Clse") clseTyConKey
1212 stmtTyConName = tcQual FSLIT("Stmt") stmtTyConKey
1213 consTyConName = tcQual FSLIT("Cons") consTyConKey
1214 typeTyConName = tcQual FSLIT("Type") typeTyConKey
1216 qTyConName = tcQual FSLIT("Q") qTyConKey
1217 expTyConName = tcQual FSLIT("Exp") expTyConKey
1218 decTyConName = tcQual FSLIT("Dec") decTyConKey
1219 typTyConName = tcQual FSLIT("Typ") typTyConKey
1220 matTyConName = tcQual FSLIT("Mat") matTyConKey
1221 clsTyConName = tcQual FSLIT("Cls") clsTyConKey
1223 -- TyConUniques available: 100-119
1224 -- Check in PrelNames if you want to change this
1226 expTyConKey = mkPreludeTyConUnique 100
1227 matTyConKey = mkPreludeTyConUnique 101
1228 clsTyConKey = mkPreludeTyConUnique 102
1229 qTyConKey = mkPreludeTyConUnique 103
1230 exprTyConKey = mkPreludeTyConUnique 104
1231 declTyConKey = mkPreludeTyConUnique 105
1232 pattTyConKey = mkPreludeTyConUnique 106
1233 mtchTyConKey = mkPreludeTyConUnique 107
1234 clseTyConKey = mkPreludeTyConUnique 108
1235 stmtTyConKey = mkPreludeTyConUnique 109
1236 consTyConKey = mkPreludeTyConUnique 110
1237 typeTyConKey = mkPreludeTyConUnique 111
1238 typTyConKey = mkPreludeTyConUnique 112
1239 decTyConKey = mkPreludeTyConUnique 113
1243 -- IdUniques available: 200-299
1244 -- If you want to change this, make sure you check in PrelNames
1245 fromIdKey = mkPreludeMiscIdUnique 200
1246 fromThenIdKey = mkPreludeMiscIdUnique 201
1247 fromToIdKey = mkPreludeMiscIdUnique 202
1248 fromThenToIdKey = mkPreludeMiscIdUnique 203
1249 liftIdKey = mkPreludeMiscIdUnique 204
1250 gensymIdKey = mkPreludeMiscIdUnique 205
1251 returnQIdKey = mkPreludeMiscIdUnique 206
1252 bindQIdKey = mkPreludeMiscIdUnique 207
1253 funIdKey = mkPreludeMiscIdUnique 208
1254 valIdKey = mkPreludeMiscIdUnique 209
1255 protoIdKey = mkPreludeMiscIdUnique 210
1256 matchIdKey = mkPreludeMiscIdUnique 211
1257 clauseIdKey = mkPreludeMiscIdUnique 212
1258 integerLIdKey = mkPreludeMiscIdUnique 213
1259 charLIdKey = mkPreludeMiscIdUnique 214
1261 classDIdKey = mkPreludeMiscIdUnique 215
1262 instIdKey = mkPreludeMiscIdUnique 216
1263 dataDIdKey = mkPreludeMiscIdUnique 217
1265 sequenceQIdKey = mkPreludeMiscIdUnique 218
1267 plitIdKey = mkPreludeMiscIdUnique 220
1268 pvarIdKey = mkPreludeMiscIdUnique 221
1269 ptupIdKey = mkPreludeMiscIdUnique 222
1270 pconIdKey = mkPreludeMiscIdUnique 223
1271 ptildeIdKey = mkPreludeMiscIdUnique 224
1272 paspatIdKey = mkPreludeMiscIdUnique 225
1273 pwildIdKey = mkPreludeMiscIdUnique 226
1274 varIdKey = mkPreludeMiscIdUnique 227
1275 conIdKey = mkPreludeMiscIdUnique 228
1276 litIdKey = mkPreludeMiscIdUnique 229
1277 appIdKey = mkPreludeMiscIdUnique 230
1278 infixEIdKey = mkPreludeMiscIdUnique 231
1279 lamIdKey = mkPreludeMiscIdUnique 232
1280 tupIdKey = mkPreludeMiscIdUnique 233
1281 doEIdKey = mkPreludeMiscIdUnique 234
1282 compIdKey = mkPreludeMiscIdUnique 235
1283 listExpIdKey = mkPreludeMiscIdUnique 237
1284 condIdKey = mkPreludeMiscIdUnique 238
1285 letEIdKey = mkPreludeMiscIdUnique 239
1286 caseEIdKey = mkPreludeMiscIdUnique 240
1287 infixAppIdKey = mkPreludeMiscIdUnique 241
1289 sectionLIdKey = mkPreludeMiscIdUnique 243
1290 sectionRIdKey = mkPreludeMiscIdUnique 244
1291 guardedIdKey = mkPreludeMiscIdUnique 245
1292 normalIdKey = mkPreludeMiscIdUnique 246
1293 bindStIdKey = mkPreludeMiscIdUnique 247
1294 letStIdKey = mkPreludeMiscIdUnique 248
1295 noBindStIdKey = mkPreludeMiscIdUnique 249
1296 parStIdKey = mkPreludeMiscIdUnique 250
1298 tforallIdKey = mkPreludeMiscIdUnique 251
1299 tvarIdKey = mkPreludeMiscIdUnique 252
1300 tconIdKey = mkPreludeMiscIdUnique 253
1301 tappIdKey = mkPreludeMiscIdUnique 254
1303 arrowIdKey = mkPreludeMiscIdUnique 255
1304 tupleIdKey = mkPreludeMiscIdUnique 256
1305 listIdKey = mkPreludeMiscIdUnique 257
1306 namedTyConIdKey = mkPreludeMiscIdUnique 258
1308 ctxtIdKey = mkPreludeMiscIdUnique 259
1310 constrIdKey = mkPreludeMiscIdUnique 260
1312 stringLIdKey = mkPreludeMiscIdUnique 261
1313 rationalLIdKey = mkPreludeMiscIdUnique 262
1315 sigExpIdKey = mkPreludeMiscIdUnique 263
1319 -- %************************************************************************
1323 -- %************************************************************************
1325 -- It is rather usatisfactory that we don't have a SrcLoc
1326 addDsWarn :: SDoc -> DsM ()
1327 addDsWarn msg = dsWarn (noSrcLoc, msg)