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 }) =
201 tc1 <- lookupOcc tc -- See note [Binders and occurrences]
202 dec <- addTyVarBinds decTyConName tvs $ \bndrs -> do
203 cons1 <- mapM repC cons
204 cons2 <- coreList consTyConName cons1
205 derivs1 <- repDerivs mb_derivs
206 repData tc1 (coreList' stringTy bndrs) cons2 derivs1
209 repTyClD (ClassDecl { tcdCtxt = cxt, tcdName = cls,
210 tcdTyVars = tvs, tcdFDs = [],
211 tcdSigs = sigs, tcdMeths = Just binds }) =
213 cls1 <- lookupOcc cls -- See note [Binders and occurrences]
214 dec <- addTyVarBinds decTyConName tvs $ \bndrs -> do
215 cxt1 <- repContext cxt
216 sigs1 <- rep_sigs sigs
217 binds1 <- rep_monobind binds
218 decls1 <- coreList declTyConName (sigs1 ++ binds1)
219 repClass cxt1 cls1 (coreList' stringTy bndrs) decls1
223 repTyClD d = do { addDsWarn (hang msg 4 (ppr d)) ;
227 msg = ptext SLIT("Cannot desugar this Template Haskell declaration:")
229 repInstD (InstDecl ty binds _ _ loc)
230 -- Ignore user pragmas for now
231 = do { cxt1 <- repContext cxt ;
232 inst_ty1 <- repPred (HsClassP cls tys) ;
233 binds1 <- rep_monobind binds ;
234 decls1 <- coreList declTyConName binds1 ;
235 repInst cxt1 inst_ty1 decls1 }
237 (tvs, cxt, cls, tys) = splitHsInstDeclTy ty
240 -------------------------------------------------------
242 -------------------------------------------------------
244 repC :: ConDecl Name -> DsM (Core M.Cons)
245 repC (ConDecl con [] [] details loc)
246 = do { con1 <- lookupOcc con ; -- See note [Binders and occurrences]
247 arg_tys <- mapM (repBangTy con) (hsConArgs details) ;
248 arg_tys1 <- coreList typeTyConName arg_tys ;
249 repConstr con1 arg_tys1 }
251 repBangTy con (BangType NotMarkedStrict ty) = repTy ty
252 repBangTy con bty = do { addDsWarn msg ; repTy (getBangType bty) }
254 msg = ptext SLIT("Ignoring stricness on argument of constructor")
257 -------------------------------------------------------
259 -------------------------------------------------------
261 repDerivs :: Maybe (HsContext Name) -> DsM (Core [String])
262 repDerivs Nothing = return (coreList' stringTy [])
263 repDerivs (Just ctxt)
264 = do { strs <- mapM rep_deriv ctxt ;
265 return (coreList' stringTy strs) }
267 rep_deriv :: HsPred Name -> DsM (Core String)
268 -- Deriving clauses must have the simple H98 form
269 rep_deriv (HsClassP cls []) = lookupOcc cls
270 rep_deriv other = panic "rep_deriv"
273 -------------------------------------------------------
274 -- Signatures in a class decl, or a group of bindings
275 -------------------------------------------------------
277 rep_sigs :: [Sig Name] -> DsM [Core M.Decl]
278 -- We silently ignore ones we don't recognise
279 rep_sigs sigs = do { sigs1 <- mapM rep_sig sigs ;
280 return (concat sigs1) }
282 rep_sig :: Sig Name -> DsM [Core M.Decl]
284 -- Empty => Too hard, signature ignored
285 rep_sig (ClassOpSig nm _ ty _) = rep_proto nm ty
286 rep_sig (Sig nm ty _) = rep_proto nm ty
287 rep_sig other = return []
289 rep_proto nm ty = do { nm1 <- lookupBinder nm ;
291 sig <- repProto nm1 ty1 ;
295 -------------------------------------------------------
297 -------------------------------------------------------
299 -- represent a list of type variables in a usage position that does not need
302 repTvs :: [HsTyVarBndr Name] -> DsM (Core [String])
303 repTvs tvs = do { tvs1 <- mapM (localVar . hsTyVarName) tvs ;
304 return (coreList' stringTy tvs1) }
306 -- gensym a list of type variables and enter them into the meta environment;
307 -- the computations passed as the second argument is executed in that extended
308 -- meta environment and gets the *original* names as an argument
310 addTyVarBinds :: Name -- type constructor for 'a'
311 -> [HsTyVarBndr Name] -- the binders to be added
312 -> ([Core String] -> DsM (Core (M.Q a))) -- action in the ext env
313 -> DsM (Core (M.Q a))
314 addTyVarBinds resTyName tvs m =
316 let names = map hsTyVarName tvs
317 freshNames <- mkGenSyms names
318 term <- addBinds freshNames $ do
319 bndrs <- mapM lookupBinder names
321 wrapGenSyns resTyName freshNames term
323 -- represent a type context
325 repContext :: HsContext Name -> DsM (Core M.Ctxt)
327 preds <- mapM repPred ctxt
328 predList <- coreList typeTyConName preds
331 -- represent a type predicate
333 repPred :: HsPred Name -> DsM (Core M.Type)
334 repPred (HsClassP cls tys) = do
335 tcon <- repTy (HsTyVar cls)
338 repPred (HsIParam _ _) =
339 panic "DsMeta.repTy: Can't represent predicates with implicit parameters"
341 -- yield the representation of a list of types
343 repTys :: [HsType Name] -> DsM [Core M.Type]
344 repTys tys = mapM repTy tys
348 repTy :: HsType Name -> DsM (Core M.Type)
349 repTy (HsForAllTy bndrs ctxt ty) =
350 addTyVarBinds typTyConName (fromMaybe [] bndrs) $ \bndrs' -> do
351 ctxt' <- repContext ctxt
353 repTForall (coreList' stringTy bndrs') ctxt' ty'
355 | isTvOcc (nameOccName n) = do
356 tv1 <- lookupBinder n
361 repTy (HsAppTy f a) = do
365 repTy (HsFunTy f a) = do
368 tcon <- repArrowTyCon
369 repTapps tcon [f1, a1]
370 repTy (HsListTy t) = do
374 repTy (HsPArrTy t) = do
376 tcon <- repTy (HsTyVar parrTyConName)
378 repTy (HsTupleTy tc tys) = do
380 tcon <- repTupleTyCon (length tys)
382 repTy (HsOpTy ty1 HsArrow ty2) = repTy (HsFunTy ty1 ty2)
383 repTy (HsOpTy ty1 (HsTyOp n) ty2) = repTy ((HsTyVar n `HsAppTy` ty1)
385 repTy (HsParTy t) = repTy t
387 panic "DsMeta.repTy: Can't represent number types (for generics)"
388 repTy (HsPredTy pred) = repPred pred
389 repTy (HsKindSig ty kind) =
390 panic "DsMeta.repTy: Can't represent explicit kind signatures yet"
393 -----------------------------------------------------------------------------
395 -----------------------------------------------------------------------------
397 repEs :: [HsExpr Name] -> DsM (Core [M.Expr])
398 repEs es = do { es' <- mapM repE es ;
399 coreList exprTyConName es' }
401 -- FIXME: some of these panics should be converted into proper error messages
402 -- unless we can make sure that constructs, which are plainly not
403 -- supported in TH already lead to error messages at an earlier stage
404 repE :: HsExpr Name -> DsM (Core M.Expr)
406 do { mb_val <- dsLookupMetaEnv x
408 Nothing -> do { str <- globalVar x
409 ; repVarOrCon x str }
410 Just (Bound y) -> repVarOrCon x (coreVar y)
411 Just (Splice e) -> do { e' <- dsExpr e
412 ; return (MkC e') } }
413 repE (HsIPVar x) = panic "DsMeta.repE: Can't represent implicit parameters"
415 -- Remember, we're desugaring renamer output here, so
416 -- HsOverlit can definitely occur
417 repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
418 repE (HsLit l) = do { a <- repLiteral l; repLit a }
419 repE (HsLam m) = repLambda m
420 repE (HsApp x y) = do {a <- repE x; b <- repE y; repApp a b}
422 repE (OpApp e1 op fix e2) =
424 HsVar op -> do { arg1 <- repE e1;
426 the_op <- lookupOcc op ;
427 repInfixApp arg1 the_op arg2 }
428 _ -> panic "DsMeta.repE: Operator is not a variable"
429 repE (NegApp x nm) = do
431 negateVar <- lookupOcc negateName >>= repVar
433 repE (HsPar x) = repE x
434 repE (SectionL x y) = do { a <- repE x; b <- repE y; repSectionL a b }
435 repE (SectionR x y) = do { a <- repE x; b <- repE y; repSectionR a b }
436 repE (HsCase e ms loc) = do { arg <- repE e
437 ; ms2 <- mapM repMatchTup ms
438 ; repCaseE arg (nonEmptyCoreList ms2) }
439 repE (HsIf x y z loc) = do
444 repE (HsLet bs e) = do { (ss,ds) <- repBinds bs
445 ; e2 <- addBinds ss (repE e)
447 ; wrapGenSyns expTyConName ss z }
448 -- FIXME: I haven't got the types here right yet
449 repE (HsDo DoExpr sts _ ty loc)
450 = do { (ss,zs) <- repSts sts;
451 e <- repDoE (nonEmptyCoreList zs);
452 wrapGenSyns expTyConName ss e }
453 repE (HsDo ListComp sts _ ty loc)
454 = do { (ss,zs) <- repSts sts;
455 e <- repComp (nonEmptyCoreList zs);
456 wrapGenSyns expTyConName ss e }
457 repE (HsDo _ _ _ _ _) = panic "DsMeta.repE: Can't represent mdo and [: :] yet"
458 repE (ExplicitList ty es) = do { xs <- repEs es; repListExp xs }
459 repE (ExplicitPArr ty es) =
460 panic "DsMeta.repE: No explicit parallel arrays yet"
461 repE (ExplicitTuple es boxed)
462 | isBoxed boxed = do { xs <- repEs es; repTup xs }
463 | otherwise = panic "DsMeta.repE: Can't represent unboxed tuples"
464 repE (RecordConOut _ _ _) = panic "DsMeta.repE: No record construction yet"
465 repE (RecordUpdOut _ _ _ _) = panic "DsMeta.repE: No record update yet"
467 repE (ExprWithTySig e ty) = do { e1 <- repE e; t1 <- repTy ty; repSigExp e1 t1 }
468 repE (ArithSeqIn aseq) =
470 From e -> do { ds1 <- repE e; repFrom ds1 }
479 FromThenTo e1 e2 e3 -> do
483 repFromThenTo ds1 ds2 ds3
484 repE (PArrSeqOut _ aseq) = panic "DsMeta.repE: parallel array seq.s missing"
485 repE (HsCCall _ _ _ _ _) = panic "DsMeta.repE: Can't represent __ccall__"
486 repE (HsSCC _ _) = panic "DsMeta.repE: Can't represent SCC"
487 repE (HsBracketOut _ _) =
488 panic "DsMeta.repE: Can't represent Oxford brackets"
489 repE (HsSplice n e loc) = do { mb_val <- dsLookupMetaEnv n
491 Just (Splice e) -> do { e' <- dsExpr e
493 other -> pprPanic "HsSplice" (ppr n) }
494 repE (HsReify _) = panic "DsMeta.repE: Can't represent reification"
496 pprPanic "DsMeta.repE: Illegal expression form" (ppr e)
498 -----------------------------------------------------------------------------
499 -- Building representations of auxillary structures like Match, Clause, Stmt,
501 repMatchTup :: Match Name -> DsM (Core M.Mtch)
502 repMatchTup (Match [p] ty (GRHSs guards wheres ty2)) =
503 do { ss1 <- mkGenSyms (collectPatBinders p)
504 ; addBinds ss1 $ do {
506 ; (ss2,ds) <- repBinds wheres
507 ; addBinds ss2 $ do {
508 ; gs <- repGuards guards
509 ; match <- repMatch p1 gs ds
510 ; wrapGenSyns matTyConName (ss1++ss2) match }}}
512 repClauseTup :: Match Name -> DsM (Core M.Clse)
513 repClauseTup (Match ps ty (GRHSs guards wheres ty2)) =
514 do { ss1 <- mkGenSyms (collectPatsBinders ps)
515 ; addBinds ss1 $ do {
517 ; (ss2,ds) <- repBinds wheres
518 ; addBinds ss2 $ do {
519 gs <- repGuards guards
520 ; clause <- repClause ps1 gs ds
521 ; wrapGenSyns clsTyConName (ss1++ss2) clause }}}
523 repGuards :: [GRHS Name] -> DsM (Core M.Rihs)
524 repGuards [GRHS [ResultStmt e loc] loc2]
525 = do {a <- repE e; repNormal a }
527 = do { zs <- mapM process other;
528 repGuarded (nonEmptyCoreList (map corePair zs)) }
530 process (GRHS [ExprStmt e1 ty loc,ResultStmt e2 _] _)
531 = do { x <- repE e1; y <- repE e2; return (x, y) }
532 process other = panic "Non Haskell 98 guarded body"
535 -----------------------------------------------------------------------------
536 -- Representing Stmt's is tricky, especially if bound variables
537 -- shaddow each other. Consider: [| do { x <- f 1; x <- f x; g x } |]
538 -- First gensym new names for every variable in any of the patterns.
539 -- both static (x'1 and x'2), and dynamic ((gensym "x") and (gensym "y"))
540 -- if variables didn't shaddow, the static gensym wouldn't be necessary
541 -- and we could reuse the original names (x and x).
543 -- do { x'1 <- gensym "x"
544 -- ; x'2 <- gensym "x"
545 -- ; doE [ BindSt (pvar x'1) [| f 1 |]
546 -- , BindSt (pvar x'2) [| f x |]
547 -- , NoBindSt [| g x |]
551 -- The strategy is to translate a whole list of do-bindings by building a
552 -- bigger environment, and a bigger set of meta bindings
553 -- (like: x'1 <- gensym "x" ) and then combining these with the translations
554 -- of the expressions within the Do
556 -----------------------------------------------------------------------------
557 -- The helper function repSts computes the translation of each sub expression
558 -- and a bunch of prefix bindings denoting the dynamic renaming.
560 repSts :: [Stmt Name] -> DsM ([GenSymBind], [Core M.Stmt])
561 repSts [ResultStmt e loc] =
563 ; e1 <- repNoBindSt a
564 ; return ([], [e1]) }
565 repSts (BindStmt p e loc : ss) =
567 ; ss1 <- mkGenSyms (collectPatBinders p)
568 ; addBinds ss1 $ do {
570 ; (ss2,zs) <- repSts ss
571 ; z <- repBindSt p1 e2
572 ; return (ss1++ss2, z : zs) }}
573 repSts (LetStmt bs : ss) =
574 do { (ss1,ds) <- repBinds bs
576 ; (ss2,zs) <- addBinds ss1 (repSts ss)
577 ; return (ss1++ss2, z : zs) }
578 repSts (ExprStmt e ty loc : ss) =
580 ; z <- repNoBindSt e2
581 ; (ss2,zs) <- repSts ss
582 ; return (ss2, z : zs) }
583 repSts other = panic "Exotic Stmt in meta brackets"
586 -----------------------------------------------------------
588 -----------------------------------------------------------
590 repBinds :: HsBinds Name -> DsM ([GenSymBind], Core [M.Decl])
592 = do { let { bndrs = collectHsBinders decs } ;
593 ss <- mkGenSyms bndrs ;
594 core <- addBinds ss (rep_binds decs) ;
595 core_list <- coreList declTyConName core ;
596 return (ss, core_list) }
598 rep_binds :: HsBinds Name -> DsM [Core M.Decl]
599 rep_binds EmptyBinds = return []
600 rep_binds (ThenBinds x y)
601 = do { core1 <- rep_binds x
602 ; core2 <- rep_binds y
603 ; return (core1 ++ core2) }
604 rep_binds (MonoBind bs sigs _)
605 = do { core1 <- rep_monobind bs
606 ; core2 <- rep_sigs sigs
607 ; return (core1 ++ core2) }
608 rep_binds (IPBinds _ _)
609 = panic "DsMeta:repBinds: can't do implicit parameters"
611 rep_monobind :: MonoBinds Name -> DsM [Core M.Decl]
612 rep_monobind EmptyMonoBinds = return []
613 rep_monobind (AndMonoBinds x y) = do { x1 <- rep_monobind x;
614 y1 <- rep_monobind y;
617 -- Note GHC treats declarations of a variable (not a pattern)
618 -- e.g. x = g 5 as a Fun MonoBinds. This is indicated by a single match
619 -- with an empty list of patterns
620 rep_monobind (FunMonoBind fn infx [Match [] ty (GRHSs guards wheres ty2)] loc)
621 = do { (ss,wherecore) <- repBinds wheres
622 ; guardcore <- addBinds ss (repGuards guards)
623 ; fn' <- lookupBinder fn
625 ; ans <- repVal p guardcore wherecore
628 rep_monobind (FunMonoBind fn infx ms loc)
629 = do { ms1 <- mapM repClauseTup ms
630 ; fn' <- lookupBinder fn
631 ; ans <- repFun fn' (nonEmptyCoreList ms1)
634 rep_monobind (PatMonoBind pat (GRHSs guards wheres ty2) loc)
635 = do { patcore <- repP pat
636 ; (ss,wherecore) <- repBinds wheres
637 ; guardcore <- addBinds ss (repGuards guards)
638 ; ans <- repVal patcore guardcore wherecore
641 rep_monobind (VarMonoBind v e)
642 = do { v' <- lookupBinder v
645 ; patcore <- repPvar v'
646 ; empty_decls <- coreList declTyConName []
647 ; ans <- repVal patcore x empty_decls
650 -----------------------------------------------------------------------------
651 -- Since everything in a MonoBind is mutually recursive we need rename all
652 -- all the variables simultaneously. For example:
653 -- [| AndMonoBinds (f x = x + g 2) (g x = f 1 + 2) |] would translate to
654 -- do { f'1 <- gensym "f"
655 -- ; g'2 <- gensym "g"
656 -- ; [ do { x'3 <- gensym "x"; fun f'1 [pvar x'3] [| x + g2 |]},
657 -- do { x'4 <- gensym "x"; fun g'2 [pvar x'4] [| f 1 + 2 |]}
659 -- This requires collecting the bindings (f'1 <- gensym "f"), and the
660 -- environment ( f |-> f'1 ) from each binding, and then unioning them
661 -- together. As we do this we collect GenSymBinds's which represent the renamed
662 -- variables bound by the Bindings. In order not to lose track of these
663 -- representations we build a shadow datatype MB with the same structure as
664 -- MonoBinds, but which has slots for the representations
667 -----------------------------------------------------------------------------
668 -- GHC allows a more general form of lambda abstraction than specified
669 -- by Haskell 98. In particular it allows guarded lambda's like :
670 -- (\ x | even x -> 0 | odd x -> 1) at the moment we can't represent this in
671 -- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like
672 -- (\ p1 .. pn -> exp) by causing an error.
674 repLambda :: Match Name -> DsM (Core M.Expr)
675 repLambda (Match ps _ (GRHSs [GRHS [ResultStmt e _ ] _ ]
677 = do { let bndrs = collectPatsBinders ps ;
678 ; ss <- mkGenSyms bndrs
679 ; lam <- addBinds ss (
680 do { xs <- repPs ps; body <- repE e; repLam xs body })
681 ; wrapGenSyns expTyConName ss lam }
683 repLambda z = panic "Can't represent a guarded lambda in Template Haskell"
686 -----------------------------------------------------------------------------
688 -- repP deals with patterns. It assumes that we have already
689 -- walked over the pattern(s) once to collect the binders, and
690 -- have extended the environment. So every pattern-bound
691 -- variable should already appear in the environment.
693 -- Process a list of patterns
694 repPs :: [Pat Name] -> DsM (Core [M.Patt])
695 repPs ps = do { ps' <- mapM repP ps ;
696 coreList pattTyConName ps' }
698 repP :: Pat Name -> DsM (Core M.Patt)
699 repP (WildPat _) = repPwild
700 repP (LitPat l) = do { l2 <- repLiteral l; repPlit l2 }
701 repP (VarPat x) = do { x' <- lookupBinder x; repPvar x' }
702 repP (LazyPat p) = do { p1 <- repP p; repPtilde p1 }
703 repP (AsPat x p) = do { x' <- lookupBinder x; p1 <- repP p; repPaspat x' p1 }
704 repP (ParPat p) = repP p
705 repP (ListPat ps _) = repListPat ps
706 repP (TuplePat ps _) = do { qs <- repPs ps; repPtup qs }
707 repP (ConPatIn dc details)
708 = do { con_str <- lookupOcc dc
710 PrefixCon ps -> do { qs <- repPs ps; repPcon con_str qs }
711 RecCon pairs -> error "No records in template haskell yet"
712 InfixCon p1 p2 -> do { qs <- repPs [p1,p2]; repPcon con_str qs }
714 repP (NPatIn l (Just _)) = panic "Can't cope with negative overloaded patterns yet (repP (NPatIn _ (Just _)))"
715 repP (NPatIn l Nothing) = do { a <- repOverloadedLiteral l; repPlit a }
716 repP other = panic "Exotic pattern inside meta brackets"
718 repListPat :: [Pat Name] -> DsM (Core M.Patt)
719 repListPat [] = do { nil_con <- coreStringLit "[]"
720 ; nil_args <- coreList pattTyConName []
721 ; repPcon nil_con nil_args }
722 repListPat (p:ps) = do { p2 <- repP p
723 ; ps2 <- repListPat ps
724 ; cons_con <- coreStringLit ":"
725 ; repPcon cons_con (nonEmptyCoreList [p2,ps2]) }
728 ----------------------------------------------------------
729 -- The meta-environment
731 -- A name/identifier association for fresh names of locally bound entities
733 type GenSymBind = (Name, Id) -- Gensym the string and bind it to the Id
734 -- I.e. (x, x_id) means
735 -- let x_id = gensym "x" in ...
737 -- Generate a fresh name for a locally bound entity
739 mkGenSym :: Name -> DsM GenSymBind
740 mkGenSym nm = do { id <- newUniqueId nm stringTy; return (nm,id) }
742 -- Ditto for a list of names
744 mkGenSyms :: [Name] -> DsM [GenSymBind]
745 mkGenSyms ns = mapM mkGenSym ns
747 -- Add a list of fresh names for locally bound entities to the meta
748 -- environment (which is part of the state carried around by the desugarer
751 addBinds :: [GenSymBind] -> DsM a -> DsM a
752 addBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,Bound id) | (n,id) <- bs]) m
754 -- Look up a locally bound name
756 lookupBinder :: Name -> DsM (Core String)
758 = do { mb_val <- dsLookupMetaEnv n;
760 Just (Bound x) -> return (coreVar x)
761 other -> pprPanic "Failed binder lookup:" (ppr n) }
763 -- Look up a name that is either locally bound or a global name
765 -- * If it is a global name, generate the "original name" representation (ie,
766 -- the <module>:<name> form) for the associated entity
768 lookupOcc :: Name -> DsM (Core String)
769 -- Lookup an occurrence; it can't be a splice.
770 -- Use the in-scope bindings if they exist
772 = do { mb_val <- dsLookupMetaEnv n ;
774 Nothing -> globalVar n
775 Just (Bound x) -> return (coreVar x)
776 Just (Splice _) -> pprPanic "repE:lookupOcc" (ppr n)
779 globalVar :: Name -> DsM (Core String)
780 globalVar n = coreStringLit (name_mod ++ ":" ++ name_occ)
782 name_mod = moduleUserString (nameModule n)
783 name_occ = occNameUserString (nameOccName n)
785 localVar :: Name -> DsM (Core String)
786 localVar n = coreStringLit (occNameUserString (nameOccName n))
788 lookupType :: Name -- Name of type constructor (e.g. M.Expr)
789 -> DsM Type -- The type
790 lookupType tc_name = do { tc <- dsLookupTyCon tc_name ;
791 return (mkGenTyConApp tc []) }
793 -- wrapGenSyns [(nm1,id1), (nm2,id2)] y
794 -- --> bindQ (gensym nm1) (\ id1 ->
795 -- bindQ (gensym nm2 (\ id2 ->
798 wrapGenSyns :: Name -- Name of the type (consructor) for 'a'
800 -> Core (M.Q a) -> DsM (Core (M.Q a))
801 wrapGenSyns tc_name binds body@(MkC b)
802 = do { elt_ty <- lookupType tc_name
805 go elt_ty [] = return body
806 go elt_ty ((name,id) : binds)
807 = do { MkC body' <- go elt_ty binds
808 ; lit_str <- localVar name
809 ; gensym_app <- repGensym lit_str
810 ; repBindQ stringTy elt_ty
811 gensym_app (MkC (Lam id body')) }
813 -- Just like wrapGenSym, but don't actually do the gensym
814 -- Instead use the existing name
815 -- Only used for [Decl]
816 wrapNongenSyms :: [GenSymBind] -> Core a -> DsM (Core a)
817 wrapNongenSyms binds (MkC body)
818 = do { binds' <- mapM do_one binds ;
819 return (MkC (mkLets binds' body)) }
822 = do { MkC lit_str <- localVar name -- No gensym
823 ; return (NonRec id lit_str) }
825 void = placeHolderType
827 string :: String -> HsExpr Id
828 string s = HsLit (HsString (mkFastString s))
831 -- %*********************************************************************
835 -- %*********************************************************************
837 -----------------------------------------------------------------------------
838 -- PHANTOM TYPES for consistency. In order to make sure we do this correct
839 -- we invent a new datatype which uses phantom types.
841 newtype Core a = MkC CoreExpr
844 rep2 :: Name -> [ CoreExpr ] -> DsM (Core a)
845 rep2 n xs = do { id <- dsLookupGlobalId n
846 ; return (MkC (foldl App (Var id) xs)) }
848 -- Then we make "repConstructors" which use the phantom types for each of the
849 -- smart constructors of the Meta.Meta datatypes.
852 -- %*********************************************************************
854 -- The 'smart constructors'
856 -- %*********************************************************************
858 --------------- Patterns -----------------
859 repPlit :: Core M.Lit -> DsM (Core M.Patt)
860 repPlit (MkC l) = rep2 plitName [l]
862 repPvar :: Core String -> DsM (Core M.Patt)
863 repPvar (MkC s) = rep2 pvarName [s]
865 repPtup :: Core [M.Patt] -> DsM (Core M.Patt)
866 repPtup (MkC ps) = rep2 ptupName [ps]
868 repPcon :: Core String -> Core [M.Patt] -> DsM (Core M.Patt)
869 repPcon (MkC s) (MkC ps) = rep2 pconName [s, ps]
871 repPtilde :: Core M.Patt -> DsM (Core M.Patt)
872 repPtilde (MkC p) = rep2 ptildeName [p]
874 repPaspat :: Core String -> Core M.Patt -> DsM (Core M.Patt)
875 repPaspat (MkC s) (MkC p) = rep2 paspatName [s, p]
877 repPwild :: DsM (Core M.Patt)
878 repPwild = rep2 pwildName []
880 --------------- Expressions -----------------
881 repVarOrCon :: Name -> Core String -> DsM (Core M.Expr)
882 repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
883 | otherwise = repVar str
885 repVar :: Core String -> DsM (Core M.Expr)
886 repVar (MkC s) = rep2 varName [s]
888 repCon :: Core String -> DsM (Core M.Expr)
889 repCon (MkC s) = rep2 conName [s]
891 repLit :: Core M.Lit -> DsM (Core M.Expr)
892 repLit (MkC c) = rep2 litName [c]
894 repApp :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
895 repApp (MkC x) (MkC y) = rep2 appName [x,y]
897 repLam :: Core [M.Patt] -> Core M.Expr -> DsM (Core M.Expr)
898 repLam (MkC ps) (MkC e) = rep2 lamName [ps, e]
900 repTup :: Core [M.Expr] -> DsM (Core M.Expr)
901 repTup (MkC es) = rep2 tupName [es]
903 repCond :: Core M.Expr -> Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
904 repCond (MkC x) (MkC y) (MkC z) = rep2 condName [x,y,z]
906 repLetE :: Core [M.Decl] -> Core M.Expr -> DsM (Core M.Expr)
907 repLetE (MkC ds) (MkC e) = rep2 letEName [ds, e]
909 repCaseE :: Core M.Expr -> Core [M.Mtch] -> DsM( Core M.Expr)
910 repCaseE (MkC e) (MkC ms) = rep2 caseEName [e, ms]
912 repDoE :: Core [M.Stmt] -> DsM (Core M.Expr)
913 repDoE (MkC ss) = rep2 doEName [ss]
915 repComp :: Core [M.Stmt] -> DsM (Core M.Expr)
916 repComp (MkC ss) = rep2 compName [ss]
918 repListExp :: Core [M.Expr] -> DsM (Core M.Expr)
919 repListExp (MkC es) = rep2 listExpName [es]
921 repSigExp :: Core M.Expr -> Core M.Type -> DsM (Core M.Expr)
922 repSigExp (MkC e) (MkC t) = rep2 sigExpName [e,t]
924 repInfixApp :: Core M.Expr -> Core String -> Core M.Expr -> DsM (Core M.Expr)
925 repInfixApp (MkC x) (MkC y) (MkC z) = rep2 infixAppName [x,y,z]
927 repSectionL :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
928 repSectionL (MkC x) (MkC y) = rep2 infixAppName [x,y]
930 repSectionR :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
931 repSectionR (MkC x) (MkC y) = rep2 infixAppName [x,y]
933 ------------ Right hand sides (guarded expressions) ----
934 repGuarded :: Core [(M.Expr, M.Expr)] -> DsM (Core M.Rihs)
935 repGuarded (MkC pairs) = rep2 guardedName [pairs]
937 repNormal :: Core M.Expr -> DsM (Core M.Rihs)
938 repNormal (MkC e) = rep2 normalName [e]
940 ------------- Statements -------------------
941 repBindSt :: Core M.Patt -> Core M.Expr -> DsM (Core M.Stmt)
942 repBindSt (MkC p) (MkC e) = rep2 bindStName [p,e]
944 repLetSt :: Core [M.Decl] -> DsM (Core M.Stmt)
945 repLetSt (MkC ds) = rep2 letStName [ds]
947 repNoBindSt :: Core M.Expr -> DsM (Core M.Stmt)
948 repNoBindSt (MkC e) = rep2 noBindStName [e]
950 -------------- DotDot (Arithmetic sequences) -----------
951 repFrom :: Core M.Expr -> DsM (Core M.Expr)
952 repFrom (MkC x) = rep2 fromName [x]
954 repFromThen :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
955 repFromThen (MkC x) (MkC y) = rep2 fromThenName [x,y]
957 repFromTo :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
958 repFromTo (MkC x) (MkC y) = rep2 fromToName [x,y]
960 repFromThenTo :: Core M.Expr -> Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
961 repFromThenTo (MkC x) (MkC y) (MkC z) = rep2 fromThenToName [x,y,z]
963 ------------ Match and Clause Tuples -----------
964 repMatch :: Core M.Patt -> Core M.Rihs -> Core [M.Decl] -> DsM (Core M.Mtch)
965 repMatch (MkC p) (MkC bod) (MkC ds) = rep2 matchName [p, bod, ds]
967 repClause :: Core [M.Patt] -> Core M.Rihs -> Core [M.Decl] -> DsM (Core M.Clse)
968 repClause (MkC ps) (MkC bod) (MkC ds) = rep2 clauseName [ps, bod, ds]
970 -------------- Dec -----------------------------
971 repVal :: Core M.Patt -> Core M.Rihs -> Core [M.Decl] -> DsM (Core M.Decl)
972 repVal (MkC p) (MkC b) (MkC ds) = rep2 valName [p, b, ds]
974 repFun :: Core String -> Core [M.Clse] -> DsM (Core M.Decl)
975 repFun (MkC nm) (MkC b) = rep2 funName [nm, b]
977 repData :: Core String -> Core [String] -> Core [M.Cons] -> Core [String] -> DsM (Core M.Decl)
978 repData (MkC nm) (MkC tvs) (MkC cons) (MkC derivs) = rep2 dataDName [nm, tvs, cons, derivs]
980 repInst :: Core M.Ctxt -> Core M.Type -> Core [M.Decl] -> DsM (Core M.Decl)
981 repInst (MkC cxt) (MkC ty) (MkC ds) = rep2 instName [cxt, ty, ds]
983 repClass :: Core M.Ctxt -> Core String -> Core [String] -> Core [M.Decl] -> DsM (Core M.Decl)
984 repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC ds) = rep2 classDName [cxt, cls, tvs, ds]
986 repProto :: Core String -> Core M.Type -> DsM (Core M.Decl)
987 repProto (MkC s) (MkC ty) = rep2 protoName [s, ty]
989 repCtxt :: Core [M.Type] -> DsM (Core M.Ctxt)
990 repCtxt (MkC tys) = rep2 ctxtName [tys]
992 repConstr :: Core String -> Core [M.Type] -> DsM (Core M.Cons)
993 repConstr (MkC con) (MkC tys) = rep2 constrName [con, tys]
995 ------------ Types -------------------
997 repTForall :: Core [String] -> Core M.Ctxt -> Core M.Type -> DsM (Core M.Type)
998 repTForall (MkC tvars) (MkC ctxt) (MkC ty) = rep2 tforallName [tvars, ctxt, ty]
1000 repTvar :: Core String -> DsM (Core M.Type)
1001 repTvar (MkC s) = rep2 tvarName [s]
1003 repTapp :: Core M.Type -> Core M.Type -> DsM (Core M.Type)
1004 repTapp (MkC t1) (MkC t2) = rep2 tappName [t1,t2]
1006 repTapps :: Core M.Type -> [Core M.Type] -> DsM (Core M.Type)
1007 repTapps f [] = return f
1008 repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
1010 --------- Type constructors --------------
1012 repNamedTyCon :: Core String -> DsM (Core M.Type)
1013 repNamedTyCon (MkC s) = rep2 namedTyConName [s]
1015 repTupleTyCon :: Int -> DsM (Core M.Type)
1016 -- Note: not Core Int; it's easier to be direct here
1017 repTupleTyCon i = rep2 tupleTyConName [mkIntExpr (fromIntegral i)]
1019 repArrowTyCon :: DsM (Core M.Type)
1020 repArrowTyCon = rep2 arrowTyConName []
1022 repListTyCon :: DsM (Core M.Type)
1023 repListTyCon = rep2 listTyConName []
1026 ----------------------------------------------------------
1029 repLiteral :: HsLit -> DsM (Core M.Lit)
1031 = do { lit_expr <- dsLit lit; rep2 lit_name [lit_expr] }
1033 lit_name = case lit of
1034 HsInteger _ -> integerLName
1035 HsChar _ -> charLName
1036 HsString _ -> stringLName
1037 HsRat _ _ -> rationalLName
1039 uh_oh = pprPanic "DsMeta.repLiteral: trying to represent exotic literal"
1042 repOverloadedLiteral :: HsOverLit -> DsM (Core M.Lit)
1043 repOverloadedLiteral (HsIntegral i _) = repLiteral (HsInteger i)
1044 repOverloadedLiteral (HsFractional f _) = do { rat_ty <- lookupType rationalTyConName ;
1045 repLiteral (HsRat f rat_ty) }
1046 -- The type Rational will be in the environment, becuase
1047 -- the smart constructor 'THSyntax.rationalL' uses it in its type,
1048 -- and rationalL is sucked in when any TH stuff is used
1050 --------------- Miscellaneous -------------------
1052 repLift :: Core e -> DsM (Core M.Expr)
1053 repLift (MkC x) = rep2 liftName [x]
1055 repGensym :: Core String -> DsM (Core (M.Q String))
1056 repGensym (MkC lit_str) = rep2 gensymName [lit_str]
1058 repBindQ :: Type -> Type -- a and b
1059 -> Core (M.Q a) -> Core (a -> M.Q b) -> DsM (Core (M.Q b))
1060 repBindQ ty_a ty_b (MkC x) (MkC y)
1061 = rep2 bindQName [Type ty_a, Type ty_b, x, y]
1063 repSequenceQ :: Type -> Core [M.Q a] -> DsM (Core (M.Q [a]))
1064 repSequenceQ ty_a (MkC list)
1065 = rep2 sequenceQName [Type ty_a, list]
1067 ------------ Lists and Tuples -------------------
1068 -- turn a list of patterns into a single pattern matching a list
1070 coreList :: Name -- Of the TyCon of the element type
1071 -> [Core a] -> DsM (Core [a])
1073 = do { elt_ty <- lookupType tc_name; return (coreList' elt_ty es) }
1075 coreList' :: Type -- The element type
1076 -> [Core a] -> Core [a]
1077 coreList' elt_ty es = MkC (mkListExpr elt_ty (map unC es ))
1079 nonEmptyCoreList :: [Core a] -> Core [a]
1080 -- The list must be non-empty so we can get the element type
1081 -- Otherwise use coreList
1082 nonEmptyCoreList [] = panic "coreList: empty argument"
1083 nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs))
1085 corePair :: (Core a, Core b) -> Core (a,b)
1086 corePair (MkC x, MkC y) = MkC (mkCoreTup [x,y])
1088 coreStringLit :: String -> DsM (Core String)
1089 coreStringLit s = do { z <- mkStringLit s; return(MkC z) }
1091 coreVar :: Id -> Core String -- The Id has type String
1092 coreVar id = MkC (Var id)
1096 -- %************************************************************************
1098 -- The known-key names for Template Haskell
1100 -- %************************************************************************
1102 -- To add a name, do three things
1104 -- 1) Allocate a key
1106 -- 3) Add the name to knownKeyNames
1108 templateHaskellNames :: NameSet
1109 -- The names that are implicitly mentioned by ``bracket''
1110 -- Should stay in sync with the import list of DsMeta
1111 templateHaskellNames
1112 = mkNameSet [ integerLName,charLName, stringLName, rationalLName,
1113 plitName, pvarName, ptupName,
1114 pconName, ptildeName, paspatName, pwildName,
1115 varName, conName, litName, appName, infixEName, lamName,
1116 tupName, doEName, compName,
1117 listExpName, sigExpName, condName, letEName, caseEName,
1118 infixAppName, sectionLName, sectionRName,
1119 guardedName, normalName,
1120 bindStName, letStName, noBindStName, parStName,
1121 fromName, fromThenName, fromToName, fromThenToName,
1122 funName, valName, liftName,
1123 gensymName, returnQName, bindQName, sequenceQName,
1124 matchName, clauseName, funName, valName, dataDName, classDName,
1125 instName, protoName, tforallName, tvarName, tconName, tappName,
1126 arrowTyConName, tupleTyConName, listTyConName, namedTyConName,
1127 ctxtName, constrName,
1128 exprTyConName, declTyConName, pattTyConName, mtchTyConName,
1129 clseTyConName, stmtTyConName, consTyConName, typeTyConName,
1130 qTyConName, expTyConName, matTyConName, clsTyConName,
1131 decTyConName, typTyConName ]
1134 varQual = mk_known_key_name OccName.varName
1135 tcQual = mk_known_key_name OccName.tcName
1138 -- NB: the THSyntax module comes from the "haskell-src" package
1139 thModule = mkThPkgModule mETA_META_Name
1141 mk_known_key_name space str uniq
1142 = mkKnownKeyExternalName thModule (mkOccFS space str) uniq
1144 integerLName = varQual FSLIT("integerL") integerLIdKey
1145 charLName = varQual FSLIT("charL") charLIdKey
1146 stringLName = varQual FSLIT("stringL") stringLIdKey
1147 rationalLName = varQual FSLIT("rationalL") rationalLIdKey
1148 plitName = varQual FSLIT("plit") plitIdKey
1149 pvarName = varQual FSLIT("pvar") pvarIdKey
1150 ptupName = varQual FSLIT("ptup") ptupIdKey
1151 pconName = varQual FSLIT("pcon") pconIdKey
1152 ptildeName = varQual FSLIT("ptilde") ptildeIdKey
1153 paspatName = varQual FSLIT("paspat") paspatIdKey
1154 pwildName = varQual FSLIT("pwild") pwildIdKey
1155 varName = varQual FSLIT("var") varIdKey
1156 conName = varQual FSLIT("con") conIdKey
1157 litName = varQual FSLIT("lit") litIdKey
1158 appName = varQual FSLIT("app") appIdKey
1159 infixEName = varQual FSLIT("infixE") infixEIdKey
1160 lamName = varQual FSLIT("lam") lamIdKey
1161 tupName = varQual FSLIT("tup") tupIdKey
1162 doEName = varQual FSLIT("doE") doEIdKey
1163 compName = varQual FSLIT("comp") compIdKey
1164 listExpName = varQual FSLIT("listExp") listExpIdKey
1165 sigExpName = varQual FSLIT("sigExp") sigExpIdKey
1166 condName = varQual FSLIT("cond") condIdKey
1167 letEName = varQual FSLIT("letE") letEIdKey
1168 caseEName = varQual FSLIT("caseE") caseEIdKey
1169 infixAppName = varQual FSLIT("infixApp") infixAppIdKey
1170 sectionLName = varQual FSLIT("sectionL") sectionLIdKey
1171 sectionRName = varQual FSLIT("sectionR") sectionRIdKey
1172 guardedName = varQual FSLIT("guarded") guardedIdKey
1173 normalName = varQual FSLIT("normal") normalIdKey
1174 bindStName = varQual FSLIT("bindSt") bindStIdKey
1175 letStName = varQual FSLIT("letSt") letStIdKey
1176 noBindStName = varQual FSLIT("noBindSt") noBindStIdKey
1177 parStName = varQual FSLIT("parSt") parStIdKey
1178 fromName = varQual FSLIT("from") fromIdKey
1179 fromThenName = varQual FSLIT("fromThen") fromThenIdKey
1180 fromToName = varQual FSLIT("fromTo") fromToIdKey
1181 fromThenToName = varQual FSLIT("fromThenTo") fromThenToIdKey
1182 liftName = varQual FSLIT("lift") liftIdKey
1183 gensymName = varQual FSLIT("gensym") gensymIdKey
1184 returnQName = varQual FSLIT("returnQ") returnQIdKey
1185 bindQName = varQual FSLIT("bindQ") bindQIdKey
1186 sequenceQName = varQual FSLIT("sequenceQ") sequenceQIdKey
1189 matchName = varQual FSLIT("match") matchIdKey
1192 clauseName = varQual FSLIT("clause") clauseIdKey
1195 funName = varQual FSLIT("fun") funIdKey
1196 valName = varQual FSLIT("val") valIdKey
1197 dataDName = varQual FSLIT("dataD") dataDIdKey
1198 classDName = varQual FSLIT("classD") classDIdKey
1199 instName = varQual FSLIT("inst") instIdKey
1200 protoName = varQual FSLIT("proto") protoIdKey
1203 tforallName = varQual FSLIT("tforall") tforallIdKey
1204 tvarName = varQual FSLIT("tvar") tvarIdKey
1205 tconName = varQual FSLIT("tcon") tconIdKey
1206 tappName = varQual FSLIT("tapp") tappIdKey
1209 arrowTyConName = varQual FSLIT("arrowTyCon") arrowIdKey
1210 tupleTyConName = varQual FSLIT("tupleTyCon") tupleIdKey
1211 listTyConName = varQual FSLIT("listTyCon") listIdKey
1212 namedTyConName = varQual FSLIT("namedTyCon") namedTyConIdKey
1215 ctxtName = varQual FSLIT("ctxt") ctxtIdKey
1218 constrName = varQual FSLIT("constr") constrIdKey
1220 exprTyConName = tcQual FSLIT("Expr") exprTyConKey
1221 declTyConName = tcQual FSLIT("Decl") declTyConKey
1222 pattTyConName = tcQual FSLIT("Patt") pattTyConKey
1223 mtchTyConName = tcQual FSLIT("Mtch") mtchTyConKey
1224 clseTyConName = tcQual FSLIT("Clse") clseTyConKey
1225 stmtTyConName = tcQual FSLIT("Stmt") stmtTyConKey
1226 consTyConName = tcQual FSLIT("Cons") consTyConKey
1227 typeTyConName = tcQual FSLIT("Type") typeTyConKey
1229 qTyConName = tcQual FSLIT("Q") qTyConKey
1230 expTyConName = tcQual FSLIT("Exp") expTyConKey
1231 decTyConName = tcQual FSLIT("Dec") decTyConKey
1232 typTyConName = tcQual FSLIT("Typ") typTyConKey
1233 matTyConName = tcQual FSLIT("Mat") matTyConKey
1234 clsTyConName = tcQual FSLIT("Cls") clsTyConKey
1236 -- TyConUniques available: 100-119
1237 -- Check in PrelNames if you want to change this
1239 expTyConKey = mkPreludeTyConUnique 100
1240 matTyConKey = mkPreludeTyConUnique 101
1241 clsTyConKey = mkPreludeTyConUnique 102
1242 qTyConKey = mkPreludeTyConUnique 103
1243 exprTyConKey = mkPreludeTyConUnique 104
1244 declTyConKey = mkPreludeTyConUnique 105
1245 pattTyConKey = mkPreludeTyConUnique 106
1246 mtchTyConKey = mkPreludeTyConUnique 107
1247 clseTyConKey = mkPreludeTyConUnique 108
1248 stmtTyConKey = mkPreludeTyConUnique 109
1249 consTyConKey = mkPreludeTyConUnique 110
1250 typeTyConKey = mkPreludeTyConUnique 111
1251 typTyConKey = mkPreludeTyConUnique 112
1252 decTyConKey = mkPreludeTyConUnique 113
1256 -- IdUniques available: 200-299
1257 -- If you want to change this, make sure you check in PrelNames
1258 fromIdKey = mkPreludeMiscIdUnique 200
1259 fromThenIdKey = mkPreludeMiscIdUnique 201
1260 fromToIdKey = mkPreludeMiscIdUnique 202
1261 fromThenToIdKey = mkPreludeMiscIdUnique 203
1262 liftIdKey = mkPreludeMiscIdUnique 204
1263 gensymIdKey = mkPreludeMiscIdUnique 205
1264 returnQIdKey = mkPreludeMiscIdUnique 206
1265 bindQIdKey = mkPreludeMiscIdUnique 207
1266 funIdKey = mkPreludeMiscIdUnique 208
1267 valIdKey = mkPreludeMiscIdUnique 209
1268 protoIdKey = mkPreludeMiscIdUnique 210
1269 matchIdKey = mkPreludeMiscIdUnique 211
1270 clauseIdKey = mkPreludeMiscIdUnique 212
1271 integerLIdKey = mkPreludeMiscIdUnique 213
1272 charLIdKey = mkPreludeMiscIdUnique 214
1274 classDIdKey = mkPreludeMiscIdUnique 215
1275 instIdKey = mkPreludeMiscIdUnique 216
1276 dataDIdKey = mkPreludeMiscIdUnique 217
1278 sequenceQIdKey = mkPreludeMiscIdUnique 218
1280 plitIdKey = mkPreludeMiscIdUnique 220
1281 pvarIdKey = mkPreludeMiscIdUnique 221
1282 ptupIdKey = mkPreludeMiscIdUnique 222
1283 pconIdKey = mkPreludeMiscIdUnique 223
1284 ptildeIdKey = mkPreludeMiscIdUnique 224
1285 paspatIdKey = mkPreludeMiscIdUnique 225
1286 pwildIdKey = mkPreludeMiscIdUnique 226
1287 varIdKey = mkPreludeMiscIdUnique 227
1288 conIdKey = mkPreludeMiscIdUnique 228
1289 litIdKey = mkPreludeMiscIdUnique 229
1290 appIdKey = mkPreludeMiscIdUnique 230
1291 infixEIdKey = mkPreludeMiscIdUnique 231
1292 lamIdKey = mkPreludeMiscIdUnique 232
1293 tupIdKey = mkPreludeMiscIdUnique 233
1294 doEIdKey = mkPreludeMiscIdUnique 234
1295 compIdKey = mkPreludeMiscIdUnique 235
1296 listExpIdKey = mkPreludeMiscIdUnique 237
1297 condIdKey = mkPreludeMiscIdUnique 238
1298 letEIdKey = mkPreludeMiscIdUnique 239
1299 caseEIdKey = mkPreludeMiscIdUnique 240
1300 infixAppIdKey = mkPreludeMiscIdUnique 241
1302 sectionLIdKey = mkPreludeMiscIdUnique 243
1303 sectionRIdKey = mkPreludeMiscIdUnique 244
1304 guardedIdKey = mkPreludeMiscIdUnique 245
1305 normalIdKey = mkPreludeMiscIdUnique 246
1306 bindStIdKey = mkPreludeMiscIdUnique 247
1307 letStIdKey = mkPreludeMiscIdUnique 248
1308 noBindStIdKey = mkPreludeMiscIdUnique 249
1309 parStIdKey = mkPreludeMiscIdUnique 250
1311 tforallIdKey = mkPreludeMiscIdUnique 251
1312 tvarIdKey = mkPreludeMiscIdUnique 252
1313 tconIdKey = mkPreludeMiscIdUnique 253
1314 tappIdKey = mkPreludeMiscIdUnique 254
1316 arrowIdKey = mkPreludeMiscIdUnique 255
1317 tupleIdKey = mkPreludeMiscIdUnique 256
1318 listIdKey = mkPreludeMiscIdUnique 257
1319 namedTyConIdKey = mkPreludeMiscIdUnique 258
1321 ctxtIdKey = mkPreludeMiscIdUnique 259
1323 constrIdKey = mkPreludeMiscIdUnique 260
1325 stringLIdKey = mkPreludeMiscIdUnique 261
1326 rationalLIdKey = mkPreludeMiscIdUnique 262
1328 sigExpIdKey = mkPreludeMiscIdUnique 263
1332 -- %************************************************************************
1336 -- %************************************************************************
1338 -- It is rather usatisfactory that we don't have a SrcLoc
1339 addDsWarn :: SDoc -> DsM ()
1340 addDsWarn msg = dsWarn (noSrcLoc, msg)