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, mkGenTyConApp )
63 import TcType ( TyThing(..), tcTyConAppArgs )
64 import TyCon ( DataConDetails(..) )
65 import TysWiredIn ( stringTy )
67 import CoreUtils ( exprType )
68 import SrcLoc ( noSrcLoc )
69 import Maybes ( orElse )
70 import Maybe ( catMaybes, fromMaybe )
71 import Panic ( panic )
72 import Unique ( mkPreludeTyConUnique, mkPreludeMiscIdUnique )
73 import BasicTypes ( NewOrData(..), StrictnessMark(..), isBoxed )
76 import FastString ( mkFastString )
78 import Monad ( zipWithM )
80 -----------------------------------------------------------------------------
81 dsBracket :: HsBracket Name -> [PendingSplice] -> DsM CoreExpr
82 -- Returns a CoreExpr of type M.Expr
83 -- The quoted thing is parameterised over Name, even though it has
84 -- been type checked. We don't want all those type decorations!
86 dsBracket brack splices
87 = dsExtendMetaEnv new_bit (do_brack brack)
89 new_bit = mkNameEnv [(n, Splice e) | (n,e) <- splices]
91 do_brack (ExpBr e) = do { MkC e1 <- repE e ; return e1 }
92 do_brack (PatBr p) = do { MkC p1 <- repP p ; return p1 }
93 do_brack (TypBr t) = do { MkC t1 <- repTy t ; return t1 }
94 do_brack (DecBr ds) = do { MkC ds1 <- repTopDs ds ; return ds1 }
96 -----------------------------------------------------------------------------
97 dsReify :: HsReify Id -> DsM CoreExpr
98 -- Returns a CoreExpr of type reifyType --> M.Type
99 -- reifyDecl --> M.Decl
100 -- reifyFixty --> Q M.Fix
101 dsReify (ReifyOut ReifyType name)
102 = do { thing <- dsLookupGlobal name ;
103 -- By deferring the lookup until now (rather than doing it
104 -- in the type checker) we ensure that all zonking has
107 AnId id -> do { MkC e <- repTy (toHsType (idType id)) ;
109 other -> pprPanic "dsReify: reifyType" (ppr name)
112 dsReify r@(ReifyOut ReifyDecl name)
113 = do { thing <- dsLookupGlobal name ;
114 mb_d <- repTyClD (ifaceTyThing thing) ;
116 Just (MkC d) -> return d
117 Nothing -> pprPanic "dsReify" (ppr r)
120 {- -------------- Examples --------------------
124 gensym (unpackString "x"#) `bindQ` \ x1::String ->
125 lam (pvar x1) (var x1)
128 [| \x -> $(f [| x |]) |]
130 gensym (unpackString "x"#) `bindQ` \ x1::String ->
131 lam (pvar x1) (f (var x1))
135 -------------------------------------------------------
137 -------------------------------------------------------
139 repTopDs :: HsGroup Name -> DsM (Core (M.Q [M.Dec]))
141 = do { let { bndrs = groupBinders group } ;
142 ss <- mkGenSyms bndrs ;
144 -- Bind all the names mainly to avoid repeated use of explicit strings.
146 -- do { t :: String <- genSym "T" ;
147 -- return (Data t [] ...more t's... }
148 -- The other important reason is that the output must mention
149 -- only "T", not "Foo:T" where Foo is the current module
152 decls <- addBinds ss (do {
153 val_ds <- rep_binds (hs_valds group) ;
154 tycl_ds <- mapM repTyClD (hs_tyclds group) ;
155 inst_ds <- mapM repInstD (hs_instds group) ;
157 return (val_ds ++ catMaybes tycl_ds ++ inst_ds) }) ;
159 decl_ty <- lookupType declTyConName ;
160 let { core_list = coreList' decl_ty decls } ;
161 q_decs <- repSequenceQ decl_ty core_list ;
163 wrapNongenSyms ss q_decs
164 -- Do *not* gensym top-level binders
167 groupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
168 hs_fords = foreign_decls })
169 -- Collect the binders of a Group
170 = collectHsBinders val_decls ++
171 [n | d <- tycl_decls, (n,_) <- tyClDeclNames d] ++
172 [n | ForeignImport n _ _ _ _ <- foreign_decls]
175 {- Note [Binders and occurrences]
176 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
177 When we desugar [d| data T = MkT |]
179 Data "T" [] [Con "MkT" []] []
181 Data "Foo:T" [] [Con "Foo:MkT" []] []
182 That is, the new data decl should fit into whatever new module it is
183 asked to fit in. We do *not* clone, though; no need for this:
190 then we must desugar to
191 foo = Data "Foo:T" [] [Con "Foo:MkT" []] []
193 So in repTopDs we bring the binders into scope with mkGenSyms and addBinds,
194 but in dsReify we do not. And we use lookupOcc, rather than lookupBinder
195 in repTyClD and repC.
199 repTyClD :: TyClDecl Name -> DsM (Maybe (Core M.Decl))
201 repTyClD (TyData { tcdND = DataType, tcdCtxt = [],
202 tcdName = tc, tcdTyVars = tvs,
203 tcdCons = DataCons cons, tcdDerivs = mb_derivs })
204 = do { tc1 <- lookupOcc tc ; -- See note [Binders and occurrences]
205 dec <- addTyVarBinds tvs $ \bndrs -> do {
206 cons1 <- mapM repC cons ;
207 cons2 <- coreList consTyConName cons1 ;
208 derivs1 <- repDerivs mb_derivs ;
209 repData tc1 (coreList' stringTy bndrs) cons2 derivs1 } ;
212 repTyClD (TySynonym { tcdName = tc, tcdTyVars = tvs, tcdSynRhs = ty })
213 = do { tc1 <- lookupOcc tc ; -- See note [Binders and occurrences]
214 dec <- addTyVarBinds tvs $ \bndrs -> do {
216 repTySyn tc1 (coreList' stringTy bndrs) ty1 } ;
219 repTyClD (ClassDecl { tcdCtxt = cxt, tcdName = cls,
221 tcdFDs = [], -- We don't understand functional dependencies
222 tcdSigs = sigs, tcdMeths = mb_meth_binds })
223 = do { cls1 <- lookupOcc cls ; -- See note [Binders and occurrences]
224 dec <- addTyVarBinds tvs $ \bndrs -> do {
225 cxt1 <- repContext cxt ;
226 sigs1 <- rep_sigs sigs ;
227 binds1 <- rep_monobind meth_binds ;
228 decls1 <- coreList declTyConName (sigs1 ++ binds1) ;
229 repClass cxt1 cls1 (coreList' stringTy bndrs) decls1 } ;
232 -- If the user quotes a class decl, it'll have default-method
233 -- bindings; but if we (reifyDecl C) where C is a class, we
234 -- won't be given the default methods (a definite infelicity).
235 meth_binds = mb_meth_binds `orElse` EmptyMonoBinds
238 repTyClD d = do { addDsWarn (hang msg 4 (ppr d)) ;
242 msg = ptext SLIT("Cannot desugar this Template Haskell declaration:")
244 repInstD (InstDecl ty binds _ _ loc)
245 -- Ignore user pragmas for now
246 = do { cxt1 <- repContext cxt ;
247 inst_ty1 <- repPred (HsClassP cls tys) ;
248 binds1 <- rep_monobind binds ;
249 decls1 <- coreList declTyConName binds1 ;
250 repInst cxt1 inst_ty1 decls1 }
252 (tvs, cxt, cls, tys) = splitHsInstDeclTy ty
255 -------------------------------------------------------
257 -------------------------------------------------------
259 repC :: ConDecl Name -> DsM (Core M.Cons)
260 repC (ConDecl con [] [] details loc)
261 = do { con1 <- lookupOcc con ; -- See note [Binders and occurrences]
262 repConstr con1 details }
264 repBangTy :: BangType Name -> DsM (Core (M.Q (M.Strictness, M.Typ)))
265 repBangTy (BangType str ty) = do MkC s <- rep2 strName []
267 rep2 strictTypeName [s, t]
268 where strName = case str of
269 NotMarkedStrict -> nonstrictName
272 -------------------------------------------------------
274 -------------------------------------------------------
276 repDerivs :: Maybe (HsContext Name) -> DsM (Core [String])
277 repDerivs Nothing = return (coreList' stringTy [])
278 repDerivs (Just ctxt)
279 = do { strs <- mapM rep_deriv ctxt ;
280 return (coreList' stringTy strs) }
282 rep_deriv :: HsPred Name -> DsM (Core String)
283 -- Deriving clauses must have the simple H98 form
284 rep_deriv (HsClassP cls []) = lookupOcc cls
285 rep_deriv other = panic "rep_deriv"
288 -------------------------------------------------------
289 -- Signatures in a class decl, or a group of bindings
290 -------------------------------------------------------
292 rep_sigs :: [Sig Name] -> DsM [Core M.Decl]
293 -- We silently ignore ones we don't recognise
294 rep_sigs sigs = do { sigs1 <- mapM rep_sig sigs ;
295 return (concat sigs1) }
297 rep_sig :: Sig Name -> DsM [Core M.Decl]
299 -- Empty => Too hard, signature ignored
300 rep_sig (ClassOpSig nm _ ty _) = rep_proto nm ty
301 rep_sig (Sig nm ty _) = rep_proto nm ty
302 rep_sig other = return []
304 rep_proto nm ty = do { nm1 <- lookupOcc nm ;
306 sig <- repProto nm1 ty1 ;
310 -------------------------------------------------------
312 -------------------------------------------------------
314 -- gensym a list of type variables and enter them into the meta environment;
315 -- the computations passed as the second argument is executed in that extended
316 -- meta environment and gets the *new* names on Core-level as an argument
318 addTyVarBinds :: [HsTyVarBndr Name] -- the binders to be added
319 -> ([Core String] -> DsM (Core (M.Q a))) -- action in the ext env
320 -> DsM (Core (M.Q a))
321 addTyVarBinds tvs m =
323 let names = map hsTyVarName tvs
324 freshNames <- mkGenSyms names
325 term <- addBinds freshNames $ do
326 bndrs <- mapM lookupBinder names
328 wrapGenSyns freshNames term
330 -- represent a type context
332 repContext :: HsContext Name -> DsM (Core M.Ctxt)
334 preds <- mapM repPred ctxt
335 predList <- coreList typeTyConName preds
338 -- represent a type predicate
340 repPred :: HsPred Name -> DsM (Core M.Type)
341 repPred (HsClassP cls tys) = do
342 tcon <- repTy (HsTyVar cls)
345 repPred (HsIParam _ _) =
346 panic "DsMeta.repTy: Can't represent predicates with implicit parameters"
348 -- yield the representation of a list of types
350 repTys :: [HsType Name] -> DsM [Core M.Type]
351 repTys tys = mapM repTy tys
355 repTy :: HsType Name -> DsM (Core M.Type)
356 repTy (HsForAllTy bndrs ctxt ty) =
357 addTyVarBinds (fromMaybe [] bndrs) $ \bndrs' -> do
358 ctxt' <- repContext ctxt
360 repTForall (coreList' stringTy bndrs') ctxt' ty'
363 | isTvOcc (nameOccName n) = do
364 tv1 <- lookupBinder n
369 repTy (HsAppTy f a) = do
373 repTy (HsFunTy f a) = do
376 tcon <- repArrowTyCon
377 repTapps tcon [f1, a1]
378 repTy (HsListTy t) = do
382 repTy (HsPArrTy t) = do
384 tcon <- repTy (HsTyVar parrTyConName)
386 repTy (HsTupleTy tc tys) = do
388 tcon <- repTupleTyCon (length tys)
390 repTy (HsOpTy ty1 HsArrow ty2) = repTy (HsFunTy ty1 ty2)
391 repTy (HsOpTy ty1 (HsTyOp n) ty2) = repTy ((HsTyVar n `HsAppTy` ty1)
393 repTy (HsParTy t) = repTy t
395 panic "DsMeta.repTy: Can't represent number types (for generics)"
396 repTy (HsPredTy pred) = repPred pred
397 repTy (HsKindSig ty kind) =
398 panic "DsMeta.repTy: Can't represent explicit kind signatures yet"
401 -----------------------------------------------------------------------------
403 -----------------------------------------------------------------------------
405 repEs :: [HsExpr Name] -> DsM (Core [M.Expr])
406 repEs es = do { es' <- mapM repE es ;
407 coreList exprTyConName es' }
409 -- FIXME: some of these panics should be converted into proper error messages
410 -- unless we can make sure that constructs, which are plainly not
411 -- supported in TH already lead to error messages at an earlier stage
412 repE :: HsExpr Name -> DsM (Core M.Expr)
414 do { mb_val <- dsLookupMetaEnv x
416 Nothing -> do { str <- globalVar x
417 ; repVarOrCon x str }
418 Just (Bound y) -> repVarOrCon x (coreVar y)
419 Just (Splice e) -> do { e' <- dsExpr e
420 ; return (MkC e') } }
421 repE (HsIPVar x) = panic "DsMeta.repE: Can't represent implicit parameters"
423 -- Remember, we're desugaring renamer output here, so
424 -- HsOverlit can definitely occur
425 repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
426 repE (HsLit l) = do { a <- repLiteral l; repLit a }
427 repE (HsLam m) = repLambda m
428 repE (HsApp x y) = do {a <- repE x; b <- repE y; repApp a b}
430 repE (OpApp e1 op fix e2) =
431 do { arg1 <- repE e1;
434 repInfixApp arg1 the_op arg2 }
435 repE (NegApp x nm) = do
437 negateVar <- lookupOcc negateName >>= repVar
439 repE (HsPar x) = repE x
440 repE (SectionL x y) = do { a <- repE x; b <- repE y; repSectionL a b }
441 repE (SectionR x y) = do { a <- repE x; b <- repE y; repSectionR a b }
442 repE (HsCase e ms loc) = do { arg <- repE e
443 ; ms2 <- mapM repMatchTup ms
444 ; repCaseE arg (nonEmptyCoreList ms2) }
445 repE (HsIf x y z loc) = do
450 repE (HsLet bs e) = do { (ss,ds) <- repBinds bs
451 ; e2 <- addBinds ss (repE e)
454 -- FIXME: I haven't got the types here right yet
455 repE (HsDo DoExpr sts _ ty loc)
456 = do { (ss,zs) <- repSts sts;
457 e <- repDoE (nonEmptyCoreList zs);
459 repE (HsDo ListComp sts _ ty loc)
460 = do { (ss,zs) <- repSts sts;
461 e <- repComp (nonEmptyCoreList zs);
463 repE (HsDo _ _ _ _ _) = panic "DsMeta.repE: Can't represent mdo and [: :] yet"
464 repE (ExplicitList ty es) = do { xs <- repEs es; repListExp xs }
465 repE (ExplicitPArr ty es) =
466 panic "DsMeta.repE: No explicit parallel arrays yet"
467 repE (ExplicitTuple es boxed)
468 | isBoxed boxed = do { xs <- repEs es; repTup xs }
469 | otherwise = panic "DsMeta.repE: Can't represent unboxed tuples"
470 repE (RecordConOut _ _ _) = panic "DsMeta.repE: No record construction yet"
471 repE (RecordUpdOut _ _ _ _) = panic "DsMeta.repE: No record update yet"
473 repE (ExprWithTySig e ty) = do { e1 <- repE e; t1 <- repTy ty; repSigExp e1 t1 }
474 repE (ArithSeqIn aseq) =
476 From e -> do { ds1 <- repE e; repFrom ds1 }
485 FromThenTo e1 e2 e3 -> do
489 repFromThenTo ds1 ds2 ds3
490 repE (PArrSeqOut _ aseq) = panic "DsMeta.repE: parallel array seq.s missing"
491 repE (HsCoreAnn _ _) = panic "DsMeta.repE: Can't represent CoreAnn" -- hdaume: core annotations
492 repE (HsCCall _ _ _ _ _) = panic "DsMeta.repE: Can't represent __ccall__"
493 repE (HsSCC _ _) = panic "DsMeta.repE: Can't represent SCC"
494 repE (HsBracketOut _ _) =
495 panic "DsMeta.repE: Can't represent Oxford brackets"
496 repE (HsSplice n e loc) = do { mb_val <- dsLookupMetaEnv n
498 Just (Splice e) -> do { e' <- dsExpr e
500 other -> pprPanic "HsSplice" (ppr n) }
501 repE (HsReify _) = panic "DsMeta.repE: Can't represent reification"
503 pprPanic "DsMeta.repE: Illegal expression form" (ppr e)
505 -----------------------------------------------------------------------------
506 -- Building representations of auxillary structures like Match, Clause, Stmt,
508 repMatchTup :: Match Name -> DsM (Core M.Mtch)
509 repMatchTup (Match [p] ty (GRHSs guards wheres ty2)) =
510 do { ss1 <- mkGenSyms (collectPatBinders p)
511 ; addBinds ss1 $ do {
513 ; (ss2,ds) <- repBinds wheres
514 ; addBinds ss2 $ do {
515 ; gs <- repGuards guards
516 ; match <- repMatch p1 gs ds
517 ; wrapGenSyns (ss1++ss2) match }}}
519 repClauseTup :: Match Name -> DsM (Core M.Clse)
520 repClauseTup (Match ps ty (GRHSs guards wheres ty2)) =
521 do { ss1 <- mkGenSyms (collectPatsBinders ps)
522 ; addBinds ss1 $ do {
524 ; (ss2,ds) <- repBinds wheres
525 ; addBinds ss2 $ do {
526 gs <- repGuards guards
527 ; clause <- repClause ps1 gs ds
528 ; wrapGenSyns (ss1++ss2) clause }}}
530 repGuards :: [GRHS Name] -> DsM (Core M.Rihs)
531 repGuards [GRHS [ResultStmt e loc] loc2]
532 = do {a <- repE e; repNormal a }
534 = do { zs <- mapM process other;
535 repGuarded (nonEmptyCoreList (map corePair zs)) }
537 process (GRHS [ExprStmt e1 ty loc,ResultStmt e2 _] _)
538 = do { x <- repE e1; y <- repE e2; return (x, y) }
539 process other = panic "Non Haskell 98 guarded body"
542 -----------------------------------------------------------------------------
543 -- Representing Stmt's is tricky, especially if bound variables
544 -- shaddow each other. Consider: [| do { x <- f 1; x <- f x; g x } |]
545 -- First gensym new names for every variable in any of the patterns.
546 -- both static (x'1 and x'2), and dynamic ((gensym "x") and (gensym "y"))
547 -- if variables didn't shaddow, the static gensym wouldn't be necessary
548 -- and we could reuse the original names (x and x).
550 -- do { x'1 <- gensym "x"
551 -- ; x'2 <- gensym "x"
552 -- ; doE [ BindSt (pvar x'1) [| f 1 |]
553 -- , BindSt (pvar x'2) [| f x |]
554 -- , NoBindSt [| g x |]
558 -- The strategy is to translate a whole list of do-bindings by building a
559 -- bigger environment, and a bigger set of meta bindings
560 -- (like: x'1 <- gensym "x" ) and then combining these with the translations
561 -- of the expressions within the Do
563 -----------------------------------------------------------------------------
564 -- The helper function repSts computes the translation of each sub expression
565 -- and a bunch of prefix bindings denoting the dynamic renaming.
567 repSts :: [Stmt Name] -> DsM ([GenSymBind], [Core M.Stmt])
568 repSts [ResultStmt e loc] =
570 ; e1 <- repNoBindSt a
571 ; return ([], [e1]) }
572 repSts (BindStmt p e loc : ss) =
574 ; ss1 <- mkGenSyms (collectPatBinders p)
575 ; addBinds ss1 $ do {
577 ; (ss2,zs) <- repSts ss
578 ; z <- repBindSt p1 e2
579 ; return (ss1++ss2, z : zs) }}
580 repSts (LetStmt bs : ss) =
581 do { (ss1,ds) <- repBinds bs
583 ; (ss2,zs) <- addBinds ss1 (repSts ss)
584 ; return (ss1++ss2, z : zs) }
585 repSts (ExprStmt e ty loc : ss) =
587 ; z <- repNoBindSt e2
588 ; (ss2,zs) <- repSts ss
589 ; return (ss2, z : zs) }
590 repSts other = panic "Exotic Stmt in meta brackets"
593 -----------------------------------------------------------
595 -----------------------------------------------------------
597 repBinds :: HsBinds Name -> DsM ([GenSymBind], Core [M.Decl])
599 = do { let { bndrs = collectHsBinders decs } ;
600 ss <- mkGenSyms bndrs ;
601 core <- addBinds ss (rep_binds decs) ;
602 core_list <- coreList declTyConName core ;
603 return (ss, core_list) }
605 rep_binds :: HsBinds Name -> DsM [Core M.Decl]
606 rep_binds EmptyBinds = return []
607 rep_binds (ThenBinds x y)
608 = do { core1 <- rep_binds x
609 ; core2 <- rep_binds y
610 ; return (core1 ++ core2) }
611 rep_binds (MonoBind bs sigs _)
612 = do { core1 <- rep_monobind bs
613 ; core2 <- rep_sigs sigs
614 ; return (core1 ++ core2) }
615 rep_binds (IPBinds _ _)
616 = panic "DsMeta:repBinds: can't do implicit parameters"
618 rep_monobind :: MonoBinds Name -> DsM [Core M.Decl]
619 rep_monobind EmptyMonoBinds = return []
620 rep_monobind (AndMonoBinds x y) = do { x1 <- rep_monobind x;
621 y1 <- rep_monobind y;
624 -- Note GHC treats declarations of a variable (not a pattern)
625 -- e.g. x = g 5 as a Fun MonoBinds. This is indicated by a single match
626 -- with an empty list of patterns
627 rep_monobind (FunMonoBind fn infx [Match [] ty (GRHSs guards wheres ty2)] loc)
628 = do { (ss,wherecore) <- repBinds wheres
629 ; guardcore <- addBinds ss (repGuards guards)
630 ; fn' <- lookupBinder fn
632 ; ans <- repVal p guardcore wherecore
635 rep_monobind (FunMonoBind fn infx ms loc)
636 = do { ms1 <- mapM repClauseTup ms
637 ; fn' <- lookupBinder fn
638 ; ans <- repFun fn' (nonEmptyCoreList ms1)
641 rep_monobind (PatMonoBind pat (GRHSs guards wheres ty2) loc)
642 = do { patcore <- repP pat
643 ; (ss,wherecore) <- repBinds wheres
644 ; guardcore <- addBinds ss (repGuards guards)
645 ; ans <- repVal patcore guardcore wherecore
648 rep_monobind (VarMonoBind v e)
649 = do { v' <- lookupBinder v
652 ; patcore <- repPvar v'
653 ; empty_decls <- coreList declTyConName []
654 ; ans <- repVal patcore x empty_decls
657 -----------------------------------------------------------------------------
658 -- Since everything in a MonoBind is mutually recursive we need rename all
659 -- all the variables simultaneously. For example:
660 -- [| AndMonoBinds (f x = x + g 2) (g x = f 1 + 2) |] would translate to
661 -- do { f'1 <- gensym "f"
662 -- ; g'2 <- gensym "g"
663 -- ; [ do { x'3 <- gensym "x"; fun f'1 [pvar x'3] [| x + g2 |]},
664 -- do { x'4 <- gensym "x"; fun g'2 [pvar x'4] [| f 1 + 2 |]}
666 -- This requires collecting the bindings (f'1 <- gensym "f"), and the
667 -- environment ( f |-> f'1 ) from each binding, and then unioning them
668 -- together. As we do this we collect GenSymBinds's which represent the renamed
669 -- variables bound by the Bindings. In order not to lose track of these
670 -- representations we build a shadow datatype MB with the same structure as
671 -- MonoBinds, but which has slots for the representations
674 -----------------------------------------------------------------------------
675 -- GHC allows a more general form of lambda abstraction than specified
676 -- by Haskell 98. In particular it allows guarded lambda's like :
677 -- (\ x | even x -> 0 | odd x -> 1) at the moment we can't represent this in
678 -- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like
679 -- (\ p1 .. pn -> exp) by causing an error.
681 repLambda :: Match Name -> DsM (Core M.Expr)
682 repLambda (Match ps _ (GRHSs [GRHS [ResultStmt e _ ] _ ]
684 = do { let bndrs = collectPatsBinders ps ;
685 ; ss <- mkGenSyms bndrs
686 ; lam <- addBinds ss (
687 do { xs <- repPs ps; body <- repE e; repLam xs body })
688 ; wrapGenSyns ss lam }
690 repLambda z = panic "Can't represent a guarded lambda in Template Haskell"
693 -----------------------------------------------------------------------------
695 -- repP deals with patterns. It assumes that we have already
696 -- walked over the pattern(s) once to collect the binders, and
697 -- have extended the environment. So every pattern-bound
698 -- variable should already appear in the environment.
700 -- Process a list of patterns
701 repPs :: [Pat Name] -> DsM (Core [M.Patt])
702 repPs ps = do { ps' <- mapM repP ps ;
703 coreList pattTyConName ps' }
705 repP :: Pat Name -> DsM (Core M.Patt)
706 repP (WildPat _) = repPwild
707 repP (LitPat l) = do { l2 <- repLiteral l; repPlit l2 }
708 repP (VarPat x) = do { x' <- lookupBinder x; repPvar x' }
709 repP (LazyPat p) = do { p1 <- repP p; repPtilde p1 }
710 repP (AsPat x p) = do { x' <- lookupBinder x; p1 <- repP p; repPaspat x' p1 }
711 repP (ParPat p) = repP p
712 repP (ListPat ps _) = repListPat ps
713 repP (TuplePat ps _) = do { qs <- repPs ps; repPtup qs }
714 repP (ConPatIn dc details)
715 = do { con_str <- lookupOcc dc
717 PrefixCon ps -> do { qs <- repPs ps; repPcon con_str qs }
718 RecCon pairs -> error "No records in template haskell yet"
719 InfixCon p1 p2 -> do { qs <- repPs [p1,p2]; repPcon con_str qs }
721 repP (NPatIn l (Just _)) = panic "Can't cope with negative overloaded patterns yet (repP (NPatIn _ (Just _)))"
722 repP (NPatIn l Nothing) = do { a <- repOverloadedLiteral l; repPlit a }
723 repP other = panic "Exotic pattern inside meta brackets"
725 repListPat :: [Pat Name] -> DsM (Core M.Patt)
726 repListPat [] = do { nil_con <- coreStringLit "[]"
727 ; nil_args <- coreList pattTyConName []
728 ; repPcon nil_con nil_args }
729 repListPat (p:ps) = do { p2 <- repP p
730 ; ps2 <- repListPat ps
731 ; cons_con <- coreStringLit ":"
732 ; repPcon cons_con (nonEmptyCoreList [p2,ps2]) }
735 ----------------------------------------------------------
736 -- The meta-environment
738 -- A name/identifier association for fresh names of locally bound entities
740 type GenSymBind = (Name, Id) -- Gensym the string and bind it to the Id
741 -- I.e. (x, x_id) means
742 -- let x_id = gensym "x" in ...
744 -- Generate a fresh name for a locally bound entity
746 mkGenSym :: Name -> DsM GenSymBind
747 mkGenSym nm = do { id <- newUniqueId nm stringTy; return (nm,id) }
749 -- Ditto for a list of names
751 mkGenSyms :: [Name] -> DsM [GenSymBind]
752 mkGenSyms ns = mapM mkGenSym ns
754 -- Add a list of fresh names for locally bound entities to the meta
755 -- environment (which is part of the state carried around by the desugarer
758 addBinds :: [GenSymBind] -> DsM a -> DsM a
759 addBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,Bound id) | (n,id) <- bs]) m
761 -- Look up a locally bound name
763 lookupBinder :: Name -> DsM (Core String)
765 = do { mb_val <- dsLookupMetaEnv n;
767 Just (Bound x) -> return (coreVar x)
768 other -> pprPanic "Failed binder lookup:" (ppr n) }
770 -- Look up a name that is either locally bound or a global name
772 -- * If it is a global name, generate the "original name" representation (ie,
773 -- the <module>:<name> form) for the associated entity
775 lookupOcc :: Name -> DsM (Core String)
776 -- Lookup an occurrence; it can't be a splice.
777 -- Use the in-scope bindings if they exist
779 = do { mb_val <- dsLookupMetaEnv n ;
781 Nothing -> globalVar n
782 Just (Bound x) -> return (coreVar x)
783 Just (Splice _) -> pprPanic "repE:lookupOcc" (ppr n)
786 globalVar :: Name -> DsM (Core String)
787 globalVar n = coreStringLit (name_mod ++ ":" ++ name_occ)
789 name_mod = moduleUserString (nameModule n)
790 name_occ = occNameUserString (nameOccName n)
792 localVar :: Name -> DsM (Core String)
793 localVar n = coreStringLit (occNameUserString (nameOccName n))
795 lookupType :: Name -- Name of type constructor (e.g. M.Expr)
796 -> DsM Type -- The type
797 lookupType tc_name = do { tc <- dsLookupTyCon tc_name ;
798 return (mkGenTyConApp tc []) }
800 -- wrapGenSyns [(nm1,id1), (nm2,id2)] y
801 -- --> bindQ (gensym nm1) (\ id1 ->
802 -- bindQ (gensym nm2 (\ id2 ->
805 wrapGenSyns :: [GenSymBind]
806 -> Core (M.Q a) -> DsM (Core (M.Q a))
807 wrapGenSyns binds body@(MkC b)
810 [elt_ty] = tcTyConAppArgs (exprType b)
811 -- b :: Q a, so we can get the type 'a' by looking at the
812 -- argument type. NB: this relies on Q being a data/newtype,
813 -- not a type synonym
816 go ((name,id) : binds)
817 = do { MkC body' <- go binds
818 ; lit_str <- localVar name
819 ; gensym_app <- repGensym lit_str
820 ; repBindQ stringTy elt_ty
821 gensym_app (MkC (Lam id body')) }
823 -- Just like wrapGenSym, but don't actually do the gensym
824 -- Instead use the existing name
825 -- Only used for [Decl]
826 wrapNongenSyms :: [GenSymBind] -> Core a -> DsM (Core a)
827 wrapNongenSyms binds (MkC body)
828 = do { binds' <- mapM do_one binds ;
829 return (MkC (mkLets binds' body)) }
832 = do { MkC lit_str <- localVar name -- No gensym
833 ; return (NonRec id lit_str) }
835 void = placeHolderType
837 string :: String -> HsExpr Id
838 string s = HsLit (HsString (mkFastString s))
841 -- %*********************************************************************
845 -- %*********************************************************************
847 -----------------------------------------------------------------------------
848 -- PHANTOM TYPES for consistency. In order to make sure we do this correct
849 -- we invent a new datatype which uses phantom types.
851 newtype Core a = MkC CoreExpr
854 rep2 :: Name -> [ CoreExpr ] -> DsM (Core a)
855 rep2 n xs = do { id <- dsLookupGlobalId n
856 ; return (MkC (foldl App (Var id) xs)) }
858 -- Then we make "repConstructors" which use the phantom types for each of the
859 -- smart constructors of the Meta.Meta datatypes.
862 -- %*********************************************************************
864 -- The 'smart constructors'
866 -- %*********************************************************************
868 --------------- Patterns -----------------
869 repPlit :: Core M.Lit -> DsM (Core M.Patt)
870 repPlit (MkC l) = rep2 plitName [l]
872 repPvar :: Core String -> DsM (Core M.Patt)
873 repPvar (MkC s) = rep2 pvarName [s]
875 repPtup :: Core [M.Patt] -> DsM (Core M.Patt)
876 repPtup (MkC ps) = rep2 ptupName [ps]
878 repPcon :: Core String -> Core [M.Patt] -> DsM (Core M.Patt)
879 repPcon (MkC s) (MkC ps) = rep2 pconName [s, ps]
881 repPtilde :: Core M.Patt -> DsM (Core M.Patt)
882 repPtilde (MkC p) = rep2 ptildeName [p]
884 repPaspat :: Core String -> Core M.Patt -> DsM (Core M.Patt)
885 repPaspat (MkC s) (MkC p) = rep2 paspatName [s, p]
887 repPwild :: DsM (Core M.Patt)
888 repPwild = rep2 pwildName []
890 --------------- Expressions -----------------
891 repVarOrCon :: Name -> Core String -> DsM (Core M.Expr)
892 repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
893 | otherwise = repVar str
895 repVar :: Core String -> DsM (Core M.Expr)
896 repVar (MkC s) = rep2 varName [s]
898 repCon :: Core String -> DsM (Core M.Expr)
899 repCon (MkC s) = rep2 conName [s]
901 repLit :: Core M.Lit -> DsM (Core M.Expr)
902 repLit (MkC c) = rep2 litName [c]
904 repApp :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
905 repApp (MkC x) (MkC y) = rep2 appName [x,y]
907 repLam :: Core [M.Patt] -> Core M.Expr -> DsM (Core M.Expr)
908 repLam (MkC ps) (MkC e) = rep2 lamName [ps, e]
910 repTup :: Core [M.Expr] -> DsM (Core M.Expr)
911 repTup (MkC es) = rep2 tupName [es]
913 repCond :: Core M.Expr -> Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
914 repCond (MkC x) (MkC y) (MkC z) = rep2 condName [x,y,z]
916 repLetE :: Core [M.Decl] -> Core M.Expr -> DsM (Core M.Expr)
917 repLetE (MkC ds) (MkC e) = rep2 letEName [ds, e]
919 repCaseE :: Core M.Expr -> Core [M.Mtch] -> DsM( Core M.Expr)
920 repCaseE (MkC e) (MkC ms) = rep2 caseEName [e, ms]
922 repDoE :: Core [M.Stmt] -> DsM (Core M.Expr)
923 repDoE (MkC ss) = rep2 doEName [ss]
925 repComp :: Core [M.Stmt] -> DsM (Core M.Expr)
926 repComp (MkC ss) = rep2 compName [ss]
928 repListExp :: Core [M.Expr] -> DsM (Core M.Expr)
929 repListExp (MkC es) = rep2 listExpName [es]
931 repSigExp :: Core M.Expr -> Core M.Type -> DsM (Core M.Expr)
932 repSigExp (MkC e) (MkC t) = rep2 sigExpName [e,t]
934 repInfixApp :: Core M.Expr -> Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
935 repInfixApp (MkC x) (MkC y) (MkC z) = rep2 infixAppName [x,y,z]
937 repSectionL :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
938 repSectionL (MkC x) (MkC y) = rep2 sectionLName [x,y]
940 repSectionR :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
941 repSectionR (MkC x) (MkC y) = rep2 sectionRName [x,y]
943 ------------ Right hand sides (guarded expressions) ----
944 repGuarded :: Core [(M.Expr, M.Expr)] -> DsM (Core M.Rihs)
945 repGuarded (MkC pairs) = rep2 guardedName [pairs]
947 repNormal :: Core M.Expr -> DsM (Core M.Rihs)
948 repNormal (MkC e) = rep2 normalName [e]
950 ------------- Statements -------------------
951 repBindSt :: Core M.Patt -> Core M.Expr -> DsM (Core M.Stmt)
952 repBindSt (MkC p) (MkC e) = rep2 bindStName [p,e]
954 repLetSt :: Core [M.Decl] -> DsM (Core M.Stmt)
955 repLetSt (MkC ds) = rep2 letStName [ds]
957 repNoBindSt :: Core M.Expr -> DsM (Core M.Stmt)
958 repNoBindSt (MkC e) = rep2 noBindStName [e]
960 -------------- DotDot (Arithmetic sequences) -----------
961 repFrom :: Core M.Expr -> DsM (Core M.Expr)
962 repFrom (MkC x) = rep2 fromName [x]
964 repFromThen :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
965 repFromThen (MkC x) (MkC y) = rep2 fromThenName [x,y]
967 repFromTo :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
968 repFromTo (MkC x) (MkC y) = rep2 fromToName [x,y]
970 repFromThenTo :: Core M.Expr -> Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
971 repFromThenTo (MkC x) (MkC y) (MkC z) = rep2 fromThenToName [x,y,z]
973 ------------ Match and Clause Tuples -----------
974 repMatch :: Core M.Patt -> Core M.Rihs -> Core [M.Decl] -> DsM (Core M.Mtch)
975 repMatch (MkC p) (MkC bod) (MkC ds) = rep2 matchName [p, bod, ds]
977 repClause :: Core [M.Patt] -> Core M.Rihs -> Core [M.Decl] -> DsM (Core M.Clse)
978 repClause (MkC ps) (MkC bod) (MkC ds) = rep2 clauseName [ps, bod, ds]
980 -------------- Dec -----------------------------
981 repVal :: Core M.Patt -> Core M.Rihs -> Core [M.Decl] -> DsM (Core M.Decl)
982 repVal (MkC p) (MkC b) (MkC ds) = rep2 valName [p, b, ds]
984 repFun :: Core String -> Core [M.Clse] -> DsM (Core M.Decl)
985 repFun (MkC nm) (MkC b) = rep2 funName [nm, b]
987 repData :: Core String -> Core [String] -> Core [M.Cons] -> Core [String] -> DsM (Core M.Decl)
988 repData (MkC nm) (MkC tvs) (MkC cons) (MkC derivs) = rep2 dataDName [nm, tvs, cons, derivs]
990 repTySyn :: Core String -> Core [String] -> Core M.Type -> DsM (Core M.Decl)
991 repTySyn (MkC nm) (MkC tvs) (MkC rhs) = rep2 tySynDName [nm, tvs, rhs]
993 repInst :: Core M.Ctxt -> Core M.Type -> Core [M.Decl] -> DsM (Core M.Decl)
994 repInst (MkC cxt) (MkC ty) (MkC ds) = rep2 instName [cxt, ty, ds]
996 repClass :: Core M.Ctxt -> Core String -> Core [String] -> Core [M.Decl] -> DsM (Core M.Decl)
997 repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC ds) = rep2 classDName [cxt, cls, tvs, ds]
999 repProto :: Core String -> Core M.Type -> DsM (Core M.Decl)
1000 repProto (MkC s) (MkC ty) = rep2 protoName [s, ty]
1002 repCtxt :: Core [M.Type] -> DsM (Core M.Ctxt)
1003 repCtxt (MkC tys) = rep2 ctxtName [tys]
1005 repConstr :: Core String -> HsConDetails Name (BangType Name)
1006 -> DsM (Core M.Cons)
1007 repConstr con (PrefixCon ps)
1008 = do arg_tys <- mapM repBangTy ps
1009 arg_tys1 <- coreList strTypeTyConName arg_tys
1010 rep2 constrName [unC con, unC arg_tys1]
1011 repConstr con (RecCon ips)
1012 = do arg_vs <- mapM lookupOcc (map fst ips)
1013 arg_tys <- mapM repBangTy (map snd ips)
1014 arg_vtys <- zipWithM (\x y -> rep2 varStrictTypeName [unC x, unC y])
1016 arg_vtys' <- coreList varStrTypeTyConName arg_vtys
1017 rep2 recConstrName [unC con, unC arg_vtys']
1018 repConstr con (InfixCon st1 st2)
1019 = do arg1 <- repBangTy st1
1020 arg2 <- repBangTy st2
1021 rep2 infixConstrName [unC arg1, unC con, unC arg2]
1023 ------------ Types -------------------
1025 repTForall :: Core [String] -> Core M.Ctxt -> Core M.Type -> DsM (Core M.Type)
1026 repTForall (MkC tvars) (MkC ctxt) (MkC ty) = rep2 tforallName [tvars, ctxt, ty]
1028 repTvar :: Core String -> DsM (Core M.Type)
1029 repTvar (MkC s) = rep2 tvarName [s]
1031 repTapp :: Core M.Type -> Core M.Type -> DsM (Core M.Type)
1032 repTapp (MkC t1) (MkC t2) = rep2 tappName [t1,t2]
1034 repTapps :: Core M.Type -> [Core M.Type] -> DsM (Core M.Type)
1035 repTapps f [] = return f
1036 repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
1038 --------- Type constructors --------------
1040 repNamedTyCon :: Core String -> DsM (Core M.Type)
1041 repNamedTyCon (MkC s) = rep2 namedTyConName [s]
1043 repTupleTyCon :: Int -> DsM (Core M.Type)
1044 -- Note: not Core Int; it's easier to be direct here
1045 repTupleTyCon i = rep2 tupleTyConName [mkIntExpr (fromIntegral i)]
1047 repArrowTyCon :: DsM (Core M.Type)
1048 repArrowTyCon = rep2 arrowTyConName []
1050 repListTyCon :: DsM (Core M.Type)
1051 repListTyCon = rep2 listTyConName []
1054 ----------------------------------------------------------
1057 repLiteral :: HsLit -> DsM (Core M.Lit)
1059 = do { lit_expr <- dsLit lit; rep2 lit_name [lit_expr] }
1061 lit_name = case lit of
1062 HsInteger _ -> integerLName
1063 HsChar _ -> charLName
1064 HsString _ -> stringLName
1065 HsRat _ _ -> rationalLName
1067 uh_oh = pprPanic "DsMeta.repLiteral: trying to represent exotic literal"
1070 repOverloadedLiteral :: HsOverLit -> DsM (Core M.Lit)
1071 repOverloadedLiteral (HsIntegral i _) = repLiteral (HsInteger i)
1072 repOverloadedLiteral (HsFractional f _) = do { rat_ty <- lookupType rationalTyConName ;
1073 repLiteral (HsRat f rat_ty) }
1074 -- The type Rational will be in the environment, becuase
1075 -- the smart constructor 'THSyntax.rationalL' uses it in its type,
1076 -- and rationalL is sucked in when any TH stuff is used
1078 --------------- Miscellaneous -------------------
1080 repLift :: Core e -> DsM (Core M.Expr)
1081 repLift (MkC x) = rep2 liftName [x]
1083 repGensym :: Core String -> DsM (Core (M.Q String))
1084 repGensym (MkC lit_str) = rep2 gensymName [lit_str]
1086 repBindQ :: Type -> Type -- a and b
1087 -> Core (M.Q a) -> Core (a -> M.Q b) -> DsM (Core (M.Q b))
1088 repBindQ ty_a ty_b (MkC x) (MkC y)
1089 = rep2 bindQName [Type ty_a, Type ty_b, x, y]
1091 repSequenceQ :: Type -> Core [M.Q a] -> DsM (Core (M.Q [a]))
1092 repSequenceQ ty_a (MkC list)
1093 = rep2 sequenceQName [Type ty_a, list]
1095 ------------ Lists and Tuples -------------------
1096 -- turn a list of patterns into a single pattern matching a list
1098 coreList :: Name -- Of the TyCon of the element type
1099 -> [Core a] -> DsM (Core [a])
1101 = do { elt_ty <- lookupType tc_name; return (coreList' elt_ty es) }
1103 coreList' :: Type -- The element type
1104 -> [Core a] -> Core [a]
1105 coreList' elt_ty es = MkC (mkListExpr elt_ty (map unC es ))
1107 nonEmptyCoreList :: [Core a] -> Core [a]
1108 -- The list must be non-empty so we can get the element type
1109 -- Otherwise use coreList
1110 nonEmptyCoreList [] = panic "coreList: empty argument"
1111 nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs))
1113 corePair :: (Core a, Core b) -> Core (a,b)
1114 corePair (MkC x, MkC y) = MkC (mkCoreTup [x,y])
1116 coreStringLit :: String -> DsM (Core String)
1117 coreStringLit s = do { z <- mkStringLit s; return(MkC z) }
1119 coreVar :: Id -> Core String -- The Id has type String
1120 coreVar id = MkC (Var id)
1124 -- %************************************************************************
1126 -- The known-key names for Template Haskell
1128 -- %************************************************************************
1130 -- To add a name, do three things
1132 -- 1) Allocate a key
1134 -- 3) Add the name to knownKeyNames
1136 templateHaskellNames :: NameSet
1137 -- The names that are implicitly mentioned by ``bracket''
1138 -- Should stay in sync with the import list of DsMeta
1139 templateHaskellNames
1140 = mkNameSet [ integerLName,charLName, stringLName, rationalLName,
1141 plitName, pvarName, ptupName,
1142 pconName, ptildeName, paspatName, pwildName,
1143 varName, conName, litName, appName, infixEName, lamName,
1144 tupName, doEName, compName,
1145 listExpName, sigExpName, condName, letEName, caseEName,
1146 infixAppName, sectionLName, sectionRName,
1147 guardedName, normalName,
1148 bindStName, letStName, noBindStName, parStName,
1149 fromName, fromThenName, fromToName, fromThenToName,
1150 funName, valName, liftName,
1151 gensymName, returnQName, bindQName, sequenceQName,
1152 matchName, clauseName, funName, valName, tySynDName, dataDName, classDName,
1153 instName, protoName, tforallName, tvarName, tconName, tappName,
1154 arrowTyConName, tupleTyConName, listTyConName, namedTyConName,
1155 ctxtName, constrName, recConstrName, infixConstrName,
1156 exprTyConName, declTyConName, pattTyConName, mtchTyConName,
1157 clseTyConName, stmtTyConName, consTyConName, typeTyConName,
1158 strTypeTyConName, varStrTypeTyConName,
1159 qTyConName, expTyConName, matTyConName, clsTyConName,
1160 decTyConName, typTyConName, strictTypeName, varStrictTypeName,
1161 strictName, nonstrictName ]
1164 varQual = mk_known_key_name OccName.varName
1165 tcQual = mk_known_key_name OccName.tcName
1168 -- NB: the THSyntax module comes from the "haskell-src" package
1169 thModule = mkThPkgModule mETA_META_Name
1171 mk_known_key_name space str uniq
1172 = mkKnownKeyExternalName thModule (mkOccFS space str) uniq
1174 integerLName = varQual FSLIT("integerL") integerLIdKey
1175 charLName = varQual FSLIT("charL") charLIdKey
1176 stringLName = varQual FSLIT("stringL") stringLIdKey
1177 rationalLName = varQual FSLIT("rationalL") rationalLIdKey
1178 plitName = varQual FSLIT("plit") plitIdKey
1179 pvarName = varQual FSLIT("pvar") pvarIdKey
1180 ptupName = varQual FSLIT("ptup") ptupIdKey
1181 pconName = varQual FSLIT("pcon") pconIdKey
1182 ptildeName = varQual FSLIT("ptilde") ptildeIdKey
1183 paspatName = varQual FSLIT("paspat") paspatIdKey
1184 pwildName = varQual FSLIT("pwild") pwildIdKey
1185 varName = varQual FSLIT("var") varIdKey
1186 conName = varQual FSLIT("con") conIdKey
1187 litName = varQual FSLIT("lit") litIdKey
1188 appName = varQual FSLIT("app") appIdKey
1189 infixEName = varQual FSLIT("infixE") infixEIdKey
1190 lamName = varQual FSLIT("lam") lamIdKey
1191 tupName = varQual FSLIT("tup") tupIdKey
1192 doEName = varQual FSLIT("doE") doEIdKey
1193 compName = varQual FSLIT("comp") compIdKey
1194 listExpName = varQual FSLIT("listExp") listExpIdKey
1195 sigExpName = varQual FSLIT("sigExp") sigExpIdKey
1196 condName = varQual FSLIT("cond") condIdKey
1197 letEName = varQual FSLIT("letE") letEIdKey
1198 caseEName = varQual FSLIT("caseE") caseEIdKey
1199 infixAppName = varQual FSLIT("infixApp") infixAppIdKey
1200 sectionLName = varQual FSLIT("sectionL") sectionLIdKey
1201 sectionRName = varQual FSLIT("sectionR") sectionRIdKey
1202 guardedName = varQual FSLIT("guarded") guardedIdKey
1203 normalName = varQual FSLIT("normal") normalIdKey
1204 bindStName = varQual FSLIT("bindSt") bindStIdKey
1205 letStName = varQual FSLIT("letSt") letStIdKey
1206 noBindStName = varQual FSLIT("noBindSt") noBindStIdKey
1207 parStName = varQual FSLIT("parSt") parStIdKey
1208 fromName = varQual FSLIT("from") fromIdKey
1209 fromThenName = varQual FSLIT("fromThen") fromThenIdKey
1210 fromToName = varQual FSLIT("fromTo") fromToIdKey
1211 fromThenToName = varQual FSLIT("fromThenTo") fromThenToIdKey
1212 liftName = varQual FSLIT("lift") liftIdKey
1213 gensymName = varQual FSLIT("gensym") gensymIdKey
1214 returnQName = varQual FSLIT("returnQ") returnQIdKey
1215 bindQName = varQual FSLIT("bindQ") bindQIdKey
1216 sequenceQName = varQual FSLIT("sequenceQ") sequenceQIdKey
1219 matchName = varQual FSLIT("match") matchIdKey
1222 clauseName = varQual FSLIT("clause") clauseIdKey
1225 funName = varQual FSLIT("fun") funIdKey
1226 valName = varQual FSLIT("val") valIdKey
1227 dataDName = varQual FSLIT("dataD") dataDIdKey
1228 tySynDName = varQual FSLIT("tySynD") tySynDIdKey
1229 classDName = varQual FSLIT("classD") classDIdKey
1230 instName = varQual FSLIT("inst") instIdKey
1231 protoName = varQual FSLIT("proto") protoIdKey
1234 tforallName = varQual FSLIT("tforall") tforallIdKey
1235 tvarName = varQual FSLIT("tvar") tvarIdKey
1236 tconName = varQual FSLIT("tcon") tconIdKey
1237 tappName = varQual FSLIT("tapp") tappIdKey
1240 arrowTyConName = varQual FSLIT("arrowTyCon") arrowIdKey
1241 tupleTyConName = varQual FSLIT("tupleTyCon") tupleIdKey
1242 listTyConName = varQual FSLIT("listTyCon") listIdKey
1243 namedTyConName = varQual FSLIT("namedTyCon") namedTyConIdKey
1246 ctxtName = varQual FSLIT("ctxt") ctxtIdKey
1249 constrName = varQual FSLIT("constr") constrIdKey
1250 recConstrName = varQual FSLIT("recConstr") recConstrIdKey
1251 infixConstrName = varQual FSLIT("infixConstr") infixConstrIdKey
1253 exprTyConName = tcQual FSLIT("Expr") exprTyConKey
1254 declTyConName = tcQual FSLIT("Decl") declTyConKey
1255 pattTyConName = tcQual FSLIT("Patt") pattTyConKey
1256 mtchTyConName = tcQual FSLIT("Mtch") mtchTyConKey
1257 clseTyConName = tcQual FSLIT("Clse") clseTyConKey
1258 stmtTyConName = tcQual FSLIT("Stmt") stmtTyConKey
1259 consTyConName = tcQual FSLIT("Cons") consTyConKey
1260 typeTyConName = tcQual FSLIT("Type") typeTyConKey
1261 strTypeTyConName = tcQual FSLIT("StrType") strTypeTyConKey
1262 varStrTypeTyConName = tcQual FSLIT("VarStrType") varStrTypeTyConKey
1264 qTyConName = tcQual FSLIT("Q") qTyConKey
1265 expTyConName = tcQual FSLIT("Exp") expTyConKey
1266 decTyConName = tcQual FSLIT("Dec") decTyConKey
1267 typTyConName = tcQual FSLIT("Typ") typTyConKey
1268 matTyConName = tcQual FSLIT("Mat") matTyConKey
1269 clsTyConName = tcQual FSLIT("Cls") clsTyConKey
1271 strictTypeName = varQual FSLIT("strictType") strictTypeKey
1272 varStrictTypeName = varQual FSLIT("varStrictType") varStrictTypeKey
1273 strictName = varQual FSLIT("strict") strictKey
1274 nonstrictName = varQual FSLIT("nonstrict") nonstrictKey
1276 -- TyConUniques available: 100-119
1277 -- Check in PrelNames if you want to change this
1279 expTyConKey = mkPreludeTyConUnique 100
1280 matTyConKey = mkPreludeTyConUnique 101
1281 clsTyConKey = mkPreludeTyConUnique 102
1282 qTyConKey = mkPreludeTyConUnique 103
1283 exprTyConKey = mkPreludeTyConUnique 104
1284 declTyConKey = mkPreludeTyConUnique 105
1285 pattTyConKey = mkPreludeTyConUnique 106
1286 mtchTyConKey = mkPreludeTyConUnique 107
1287 clseTyConKey = mkPreludeTyConUnique 108
1288 stmtTyConKey = mkPreludeTyConUnique 109
1289 consTyConKey = mkPreludeTyConUnique 110
1290 typeTyConKey = mkPreludeTyConUnique 111
1291 typTyConKey = mkPreludeTyConUnique 112
1292 decTyConKey = mkPreludeTyConUnique 113
1293 varStrTypeTyConKey = mkPreludeTyConUnique 114
1294 strTypeTyConKey = mkPreludeTyConUnique 115
1298 -- IdUniques available: 200-299
1299 -- If you want to change this, make sure you check in PrelNames
1300 fromIdKey = mkPreludeMiscIdUnique 200
1301 fromThenIdKey = mkPreludeMiscIdUnique 201
1302 fromToIdKey = mkPreludeMiscIdUnique 202
1303 fromThenToIdKey = mkPreludeMiscIdUnique 203
1304 liftIdKey = mkPreludeMiscIdUnique 204
1305 gensymIdKey = mkPreludeMiscIdUnique 205
1306 returnQIdKey = mkPreludeMiscIdUnique 206
1307 bindQIdKey = mkPreludeMiscIdUnique 207
1308 funIdKey = mkPreludeMiscIdUnique 208
1309 valIdKey = mkPreludeMiscIdUnique 209
1310 protoIdKey = mkPreludeMiscIdUnique 210
1311 matchIdKey = mkPreludeMiscIdUnique 211
1312 clauseIdKey = mkPreludeMiscIdUnique 212
1313 integerLIdKey = mkPreludeMiscIdUnique 213
1314 charLIdKey = mkPreludeMiscIdUnique 214
1316 classDIdKey = mkPreludeMiscIdUnique 215
1317 instIdKey = mkPreludeMiscIdUnique 216
1318 dataDIdKey = mkPreludeMiscIdUnique 217
1320 sequenceQIdKey = mkPreludeMiscIdUnique 218
1321 tySynDIdKey = mkPreludeMiscIdUnique 219
1323 plitIdKey = mkPreludeMiscIdUnique 220
1324 pvarIdKey = mkPreludeMiscIdUnique 221
1325 ptupIdKey = mkPreludeMiscIdUnique 222
1326 pconIdKey = mkPreludeMiscIdUnique 223
1327 ptildeIdKey = mkPreludeMiscIdUnique 224
1328 paspatIdKey = mkPreludeMiscIdUnique 225
1329 pwildIdKey = mkPreludeMiscIdUnique 226
1330 varIdKey = mkPreludeMiscIdUnique 227
1331 conIdKey = mkPreludeMiscIdUnique 228
1332 litIdKey = mkPreludeMiscIdUnique 229
1333 appIdKey = mkPreludeMiscIdUnique 230
1334 infixEIdKey = mkPreludeMiscIdUnique 231
1335 lamIdKey = mkPreludeMiscIdUnique 232
1336 tupIdKey = mkPreludeMiscIdUnique 233
1337 doEIdKey = mkPreludeMiscIdUnique 234
1338 compIdKey = mkPreludeMiscIdUnique 235
1339 listExpIdKey = mkPreludeMiscIdUnique 237
1340 condIdKey = mkPreludeMiscIdUnique 238
1341 letEIdKey = mkPreludeMiscIdUnique 239
1342 caseEIdKey = mkPreludeMiscIdUnique 240
1343 infixAppIdKey = mkPreludeMiscIdUnique 241
1345 sectionLIdKey = mkPreludeMiscIdUnique 243
1346 sectionRIdKey = mkPreludeMiscIdUnique 244
1347 guardedIdKey = mkPreludeMiscIdUnique 245
1348 normalIdKey = mkPreludeMiscIdUnique 246
1349 bindStIdKey = mkPreludeMiscIdUnique 247
1350 letStIdKey = mkPreludeMiscIdUnique 248
1351 noBindStIdKey = mkPreludeMiscIdUnique 249
1352 parStIdKey = mkPreludeMiscIdUnique 250
1354 tforallIdKey = mkPreludeMiscIdUnique 251
1355 tvarIdKey = mkPreludeMiscIdUnique 252
1356 tconIdKey = mkPreludeMiscIdUnique 253
1357 tappIdKey = mkPreludeMiscIdUnique 254
1359 arrowIdKey = mkPreludeMiscIdUnique 255
1360 tupleIdKey = mkPreludeMiscIdUnique 256
1361 listIdKey = mkPreludeMiscIdUnique 257
1362 namedTyConIdKey = mkPreludeMiscIdUnique 258
1364 ctxtIdKey = mkPreludeMiscIdUnique 259
1366 constrIdKey = mkPreludeMiscIdUnique 260
1368 stringLIdKey = mkPreludeMiscIdUnique 261
1369 rationalLIdKey = mkPreludeMiscIdUnique 262
1371 sigExpIdKey = mkPreludeMiscIdUnique 263
1373 strictTypeKey = mkPreludeMiscIdUnique 264
1374 strictKey = mkPreludeMiscIdUnique 265
1375 nonstrictKey = mkPreludeMiscIdUnique 266
1376 varStrictTypeKey = mkPreludeMiscIdUnique 267
1378 recConstrIdKey = mkPreludeMiscIdUnique 268
1379 infixConstrIdKey = mkPreludeMiscIdUnique 269
1381 -- %************************************************************************
1385 -- %************************************************************************
1387 -- It is rather usatisfactory that we don't have a SrcLoc
1388 addDsWarn :: SDoc -> DsM ()
1389 addDsWarn msg = dsWarn (noSrcLoc, msg)