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 } ;
162 dec_ty <- lookupType decTyConName ;
163 q_decs <- repSequenceQ dec_ty core_list ;
165 wrapNongenSyms ss q_decs
166 -- Do *not* gensym top-level binders
169 groupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
170 hs_fords = foreign_decls })
171 -- Collect the binders of a Group
172 = collectHsBinders val_decls ++
173 [n | d <- tycl_decls, (n,_) <- tyClDeclNames d] ++
174 [n | ForeignImport n _ _ _ _ <- foreign_decls]
177 {- Note [Binders and occurrences]
178 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
179 When we desugar [d| data T = MkT |]
181 Data "T" [] [Con "MkT" []] []
183 Data "Foo:T" [] [Con "Foo:MkT" []] []
184 That is, the new data decl should fit into whatever new module it is
185 asked to fit in. We do *not* clone, though; no need for this:
192 then we must desugar to
193 foo = Data "Foo:T" [] [Con "Foo:MkT" []] []
195 So in repTopDs we bring the binders into scope with mkGenSyms and addBinds,
196 but in dsReify we do not. And we use lookupOcc, rather than lookupBinder
197 in repTyClD and repC.
201 repTyClD :: TyClDecl Name -> DsM (Maybe (Core M.Decl))
203 repTyClD (TyData { tcdND = DataType, tcdCtxt = [],
204 tcdName = tc, tcdTyVars = tvs,
205 tcdCons = DataCons cons, tcdDerivs = mb_derivs })
206 = do { tc1 <- lookupOcc tc ; -- See note [Binders and occurrences]
207 dec <- addTyVarBinds tvs $ \bndrs -> do {
208 cons1 <- mapM repC cons ;
209 cons2 <- coreList consTyConName cons1 ;
210 derivs1 <- repDerivs mb_derivs ;
211 repData tc1 (coreList' stringTy bndrs) cons2 derivs1 } ;
214 repTyClD (TySynonym { tcdName = tc, tcdTyVars = tvs, tcdSynRhs = ty })
215 = do { tc1 <- lookupOcc tc ; -- See note [Binders and occurrences]
216 dec <- addTyVarBinds tvs $ \bndrs -> do {
218 repTySyn tc1 (coreList' stringTy bndrs) ty1 } ;
221 repTyClD (ClassDecl { tcdCtxt = cxt, tcdName = cls,
223 tcdFDs = [], -- We don't understand functional dependencies
224 tcdSigs = sigs, tcdMeths = mb_meth_binds })
225 = do { cls1 <- lookupOcc cls ; -- See note [Binders and occurrences]
226 dec <- addTyVarBinds tvs $ \bndrs -> do {
227 cxt1 <- repContext cxt ;
228 sigs1 <- rep_sigs sigs ;
229 binds1 <- rep_monobind meth_binds ;
230 decls1 <- coreList declTyConName (sigs1 ++ binds1) ;
231 repClass cxt1 cls1 (coreList' stringTy bndrs) decls1 } ;
234 -- If the user quotes a class decl, it'll have default-method
235 -- bindings; but if we (reifyDecl C) where C is a class, we
236 -- won't be given the default methods (a definite infelicity).
237 meth_binds = mb_meth_binds `orElse` EmptyMonoBinds
240 repTyClD d = do { addDsWarn (hang msg 4 (ppr d)) ;
244 msg = ptext SLIT("Cannot desugar this Template Haskell declaration:")
246 repInstD (InstDecl ty binds _ _ loc)
247 -- Ignore user pragmas for now
248 = do { cxt1 <- repContext cxt ;
249 inst_ty1 <- repPred (HsClassP cls tys) ;
250 binds1 <- rep_monobind binds ;
251 decls1 <- coreList declTyConName binds1 ;
252 repInst cxt1 inst_ty1 decls1 }
254 (tvs, cxt, cls, tys) = splitHsInstDeclTy ty
257 -------------------------------------------------------
259 -------------------------------------------------------
261 repC :: ConDecl Name -> DsM (Core M.Cons)
262 repC (ConDecl con [] [] details loc)
263 = do { con1 <- lookupOcc con ; -- See note [Binders and occurrences]
264 repConstr con1 details }
266 repBangTy :: BangType Name -> DsM (Core (M.Q (M.Strictness, M.Typ)))
267 repBangTy (BangType str ty) = do MkC s <- rep2 strName []
269 rep2 strictTypeName [s, t]
270 where strName = case str of
271 NotMarkedStrict -> nonstrictName
274 -------------------------------------------------------
276 -------------------------------------------------------
278 repDerivs :: Maybe (HsContext Name) -> DsM (Core [String])
279 repDerivs Nothing = return (coreList' stringTy [])
280 repDerivs (Just ctxt)
281 = do { strs <- mapM rep_deriv ctxt ;
282 return (coreList' stringTy strs) }
284 rep_deriv :: HsPred Name -> DsM (Core String)
285 -- Deriving clauses must have the simple H98 form
286 rep_deriv (HsClassP cls []) = lookupOcc cls
287 rep_deriv other = panic "rep_deriv"
290 -------------------------------------------------------
291 -- Signatures in a class decl, or a group of bindings
292 -------------------------------------------------------
294 rep_sigs :: [Sig Name] -> DsM [Core M.Decl]
295 -- We silently ignore ones we don't recognise
296 rep_sigs sigs = do { sigs1 <- mapM rep_sig sigs ;
297 return (concat sigs1) }
299 rep_sig :: Sig Name -> DsM [Core M.Decl]
301 -- Empty => Too hard, signature ignored
302 rep_sig (ClassOpSig nm _ ty _) = rep_proto nm ty
303 rep_sig (Sig nm ty _) = rep_proto nm ty
304 rep_sig other = return []
306 rep_proto nm ty = do { nm1 <- lookupOcc nm ;
308 sig <- repProto nm1 ty1 ;
312 -------------------------------------------------------
314 -------------------------------------------------------
316 -- gensym a list of type variables and enter them into the meta environment;
317 -- the computations passed as the second argument is executed in that extended
318 -- meta environment and gets the *new* names on Core-level as an argument
320 addTyVarBinds :: [HsTyVarBndr Name] -- the binders to be added
321 -> ([Core String] -> DsM (Core (M.Q a))) -- action in the ext env
322 -> DsM (Core (M.Q a))
323 addTyVarBinds tvs m =
325 let names = map hsTyVarName tvs
326 freshNames <- mkGenSyms names
327 term <- addBinds freshNames $ do
328 bndrs <- mapM lookupBinder names
330 wrapGenSyns freshNames term
332 -- represent a type context
334 repContext :: HsContext Name -> DsM (Core M.Ctxt)
336 preds <- mapM repPred ctxt
337 predList <- coreList typeTyConName preds
340 -- represent a type predicate
342 repPred :: HsPred Name -> DsM (Core M.Type)
343 repPred (HsClassP cls tys) = do
344 tcon <- repTy (HsTyVar cls)
347 repPred (HsIParam _ _) =
348 panic "DsMeta.repTy: Can't represent predicates with implicit parameters"
350 -- yield the representation of a list of types
352 repTys :: [HsType Name] -> DsM [Core M.Type]
353 repTys tys = mapM repTy tys
357 repTy :: HsType Name -> DsM (Core M.Type)
358 repTy (HsForAllTy bndrs ctxt ty) =
359 addTyVarBinds (fromMaybe [] bndrs) $ \bndrs' -> do
360 ctxt' <- repContext ctxt
362 repTForall (coreList' stringTy bndrs') ctxt' ty'
365 | isTvOcc (nameOccName n) = do
366 tv1 <- lookupBinder n
371 repTy (HsAppTy f a) = do
375 repTy (HsFunTy f a) = do
378 tcon <- repArrowTyCon
379 repTapps tcon [f1, a1]
380 repTy (HsListTy t) = do
384 repTy (HsPArrTy t) = do
386 tcon <- repTy (HsTyVar parrTyConName)
388 repTy (HsTupleTy tc tys) = do
390 tcon <- repTupleTyCon (length tys)
392 repTy (HsOpTy ty1 HsArrow ty2) = repTy (HsFunTy ty1 ty2)
393 repTy (HsOpTy ty1 (HsTyOp n) ty2) = repTy ((HsTyVar n `HsAppTy` ty1)
395 repTy (HsParTy t) = repTy t
397 panic "DsMeta.repTy: Can't represent number types (for generics)"
398 repTy (HsPredTy pred) = repPred pred
399 repTy (HsKindSig ty kind) =
400 panic "DsMeta.repTy: Can't represent explicit kind signatures yet"
403 -----------------------------------------------------------------------------
405 -----------------------------------------------------------------------------
407 repEs :: [HsExpr Name] -> DsM (Core [M.Expr])
408 repEs es = do { es' <- mapM repE es ;
409 coreList exprTyConName es' }
411 -- FIXME: some of these panics should be converted into proper error messages
412 -- unless we can make sure that constructs, which are plainly not
413 -- supported in TH already lead to error messages at an earlier stage
414 repE :: HsExpr Name -> DsM (Core M.Expr)
416 do { mb_val <- dsLookupMetaEnv x
418 Nothing -> do { str <- globalVar x
419 ; repVarOrCon x str }
420 Just (Bound y) -> repVarOrCon x (coreVar y)
421 Just (Splice e) -> do { e' <- dsExpr e
422 ; return (MkC e') } }
423 repE (HsIPVar x) = panic "DsMeta.repE: Can't represent implicit parameters"
425 -- Remember, we're desugaring renamer output here, so
426 -- HsOverlit can definitely occur
427 repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
428 repE (HsLit l) = do { a <- repLiteral l; repLit a }
429 repE (HsLam m) = repLambda m
430 repE (HsApp x y) = do {a <- repE x; b <- repE y; repApp a b}
432 repE (OpApp e1 op fix e2) =
433 do { arg1 <- repE e1;
436 repInfixApp arg1 the_op arg2 }
437 repE (NegApp x nm) = do
439 negateVar <- lookupOcc negateName >>= repVar
441 repE (HsPar x) = repE x
442 repE (SectionL x y) = do { a <- repE x; b <- repE y; repSectionL a b }
443 repE (SectionR x y) = do { a <- repE x; b <- repE y; repSectionR a b }
444 repE (HsCase e ms loc) = do { arg <- repE e
445 ; ms2 <- mapM repMatchTup ms
446 ; repCaseE arg (nonEmptyCoreList ms2) }
447 repE (HsIf x y z loc) = do
452 repE (HsLet bs e) = do { (ss,ds) <- repBinds bs
453 ; e2 <- addBinds ss (repE e)
456 -- FIXME: I haven't got the types here right yet
457 repE (HsDo DoExpr sts _ ty loc)
458 = do { (ss,zs) <- repSts sts;
459 e <- repDoE (nonEmptyCoreList zs);
461 repE (HsDo ListComp sts _ ty loc)
462 = do { (ss,zs) <- repSts sts;
463 e <- repComp (nonEmptyCoreList zs);
465 repE (HsDo _ _ _ _ _) = panic "DsMeta.repE: Can't represent mdo and [: :] yet"
466 repE (ExplicitList ty es) = do { xs <- repEs es; repListExp xs }
467 repE (ExplicitPArr ty es) =
468 panic "DsMeta.repE: No explicit parallel arrays yet"
469 repE (ExplicitTuple es boxed)
470 | isBoxed boxed = do { xs <- repEs es; repTup xs }
471 | otherwise = panic "DsMeta.repE: Can't represent unboxed tuples"
472 repE (RecordConOut _ _ _) = panic "DsMeta.repE: No record construction yet"
473 repE (RecordUpdOut _ _ _ _) = panic "DsMeta.repE: No record update yet"
475 repE (ExprWithTySig e ty) = do { e1 <- repE e; t1 <- repTy ty; repSigExp e1 t1 }
476 repE (ArithSeqIn aseq) =
478 From e -> do { ds1 <- repE e; repFrom ds1 }
487 FromThenTo e1 e2 e3 -> do
491 repFromThenTo ds1 ds2 ds3
492 repE (PArrSeqOut _ aseq) = panic "DsMeta.repE: parallel array seq.s missing"
493 repE (HsCoreAnn _ _) = panic "DsMeta.repE: Can't represent CoreAnn" -- hdaume: core annotations
494 repE (HsCCall _ _ _ _ _) = panic "DsMeta.repE: Can't represent __ccall__"
495 repE (HsSCC _ _) = panic "DsMeta.repE: Can't represent SCC"
496 repE (HsBracketOut _ _) =
497 panic "DsMeta.repE: Can't represent Oxford brackets"
498 repE (HsSplice n e loc) = do { mb_val <- dsLookupMetaEnv n
500 Just (Splice e) -> do { e' <- dsExpr e
502 other -> pprPanic "HsSplice" (ppr n) }
503 repE (HsReify _) = panic "DsMeta.repE: Can't represent reification"
505 pprPanic "DsMeta.repE: Illegal expression form" (ppr e)
507 -----------------------------------------------------------------------------
508 -- Building representations of auxillary structures like Match, Clause, Stmt,
510 repMatchTup :: Match Name -> DsM (Core M.Mtch)
511 repMatchTup (Match [p] ty (GRHSs guards wheres ty2)) =
512 do { ss1 <- mkGenSyms (collectPatBinders p)
513 ; addBinds ss1 $ do {
515 ; (ss2,ds) <- repBinds wheres
516 ; addBinds ss2 $ do {
517 ; gs <- repGuards guards
518 ; match <- repMatch p1 gs ds
519 ; wrapGenSyns (ss1++ss2) match }}}
521 repClauseTup :: Match Name -> DsM (Core M.Clse)
522 repClauseTup (Match ps ty (GRHSs guards wheres ty2)) =
523 do { ss1 <- mkGenSyms (collectPatsBinders ps)
524 ; addBinds ss1 $ do {
526 ; (ss2,ds) <- repBinds wheres
527 ; addBinds ss2 $ do {
528 gs <- repGuards guards
529 ; clause <- repClause ps1 gs ds
530 ; wrapGenSyns (ss1++ss2) clause }}}
532 repGuards :: [GRHS Name] -> DsM (Core M.Rihs)
533 repGuards [GRHS [ResultStmt e loc] loc2]
534 = do {a <- repE e; repNormal a }
536 = do { zs <- mapM process other;
537 repGuarded (nonEmptyCoreList (map corePair zs)) }
539 process (GRHS [ExprStmt e1 ty loc,ResultStmt e2 _] _)
540 = do { x <- repE e1; y <- repE e2; return (x, y) }
541 process other = panic "Non Haskell 98 guarded body"
544 -----------------------------------------------------------------------------
545 -- Representing Stmt's is tricky, especially if bound variables
546 -- shaddow each other. Consider: [| do { x <- f 1; x <- f x; g x } |]
547 -- First gensym new names for every variable in any of the patterns.
548 -- both static (x'1 and x'2), and dynamic ((gensym "x") and (gensym "y"))
549 -- if variables didn't shaddow, the static gensym wouldn't be necessary
550 -- and we could reuse the original names (x and x).
552 -- do { x'1 <- gensym "x"
553 -- ; x'2 <- gensym "x"
554 -- ; doE [ BindSt (pvar x'1) [| f 1 |]
555 -- , BindSt (pvar x'2) [| f x |]
556 -- , NoBindSt [| g x |]
560 -- The strategy is to translate a whole list of do-bindings by building a
561 -- bigger environment, and a bigger set of meta bindings
562 -- (like: x'1 <- gensym "x" ) and then combining these with the translations
563 -- of the expressions within the Do
565 -----------------------------------------------------------------------------
566 -- The helper function repSts computes the translation of each sub expression
567 -- and a bunch of prefix bindings denoting the dynamic renaming.
569 repSts :: [Stmt Name] -> DsM ([GenSymBind], [Core M.Stmt])
570 repSts [ResultStmt e loc] =
572 ; e1 <- repNoBindSt a
573 ; return ([], [e1]) }
574 repSts (BindStmt p e loc : ss) =
576 ; ss1 <- mkGenSyms (collectPatBinders p)
577 ; addBinds ss1 $ do {
579 ; (ss2,zs) <- repSts ss
580 ; z <- repBindSt p1 e2
581 ; return (ss1++ss2, z : zs) }}
582 repSts (LetStmt bs : ss) =
583 do { (ss1,ds) <- repBinds bs
585 ; (ss2,zs) <- addBinds ss1 (repSts ss)
586 ; return (ss1++ss2, z : zs) }
587 repSts (ExprStmt e ty loc : ss) =
589 ; z <- repNoBindSt e2
590 ; (ss2,zs) <- repSts ss
591 ; return (ss2, z : zs) }
592 repSts other = panic "Exotic Stmt in meta brackets"
595 -----------------------------------------------------------
597 -----------------------------------------------------------
599 repBinds :: HsBinds Name -> DsM ([GenSymBind], Core [M.Decl])
601 = do { let { bndrs = collectHsBinders decs } ;
602 ss <- mkGenSyms bndrs ;
603 core <- addBinds ss (rep_binds decs) ;
604 core_list <- coreList declTyConName core ;
605 return (ss, core_list) }
607 rep_binds :: HsBinds Name -> DsM [Core M.Decl]
608 rep_binds EmptyBinds = return []
609 rep_binds (ThenBinds x y)
610 = do { core1 <- rep_binds x
611 ; core2 <- rep_binds y
612 ; return (core1 ++ core2) }
613 rep_binds (MonoBind bs sigs _)
614 = do { core1 <- rep_monobind bs
615 ; core2 <- rep_sigs sigs
616 ; return (core1 ++ core2) }
617 rep_binds (IPBinds _ _)
618 = panic "DsMeta:repBinds: can't do implicit parameters"
620 rep_monobind :: MonoBinds Name -> DsM [Core M.Decl]
621 rep_monobind EmptyMonoBinds = return []
622 rep_monobind (AndMonoBinds x y) = do { x1 <- rep_monobind x;
623 y1 <- rep_monobind y;
626 -- Note GHC treats declarations of a variable (not a pattern)
627 -- e.g. x = g 5 as a Fun MonoBinds. This is indicated by a single match
628 -- with an empty list of patterns
629 rep_monobind (FunMonoBind fn infx [Match [] ty (GRHSs guards wheres ty2)] loc)
630 = do { (ss,wherecore) <- repBinds wheres
631 ; guardcore <- addBinds ss (repGuards guards)
632 ; fn' <- lookupBinder fn
634 ; ans <- repVal p guardcore wherecore
637 rep_monobind (FunMonoBind fn infx ms loc)
638 = do { ms1 <- mapM repClauseTup ms
639 ; fn' <- lookupBinder fn
640 ; ans <- repFun fn' (nonEmptyCoreList ms1)
643 rep_monobind (PatMonoBind pat (GRHSs guards wheres ty2) loc)
644 = do { patcore <- repP pat
645 ; (ss,wherecore) <- repBinds wheres
646 ; guardcore <- addBinds ss (repGuards guards)
647 ; ans <- repVal patcore guardcore wherecore
650 rep_monobind (VarMonoBind v e)
651 = do { v' <- lookupBinder v
654 ; patcore <- repPvar v'
655 ; empty_decls <- coreList declTyConName []
656 ; ans <- repVal patcore x empty_decls
659 -----------------------------------------------------------------------------
660 -- Since everything in a MonoBind is mutually recursive we need rename all
661 -- all the variables simultaneously. For example:
662 -- [| AndMonoBinds (f x = x + g 2) (g x = f 1 + 2) |] would translate to
663 -- do { f'1 <- gensym "f"
664 -- ; g'2 <- gensym "g"
665 -- ; [ do { x'3 <- gensym "x"; fun f'1 [pvar x'3] [| x + g2 |]},
666 -- do { x'4 <- gensym "x"; fun g'2 [pvar x'4] [| f 1 + 2 |]}
668 -- This requires collecting the bindings (f'1 <- gensym "f"), and the
669 -- environment ( f |-> f'1 ) from each binding, and then unioning them
670 -- together. As we do this we collect GenSymBinds's which represent the renamed
671 -- variables bound by the Bindings. In order not to lose track of these
672 -- representations we build a shadow datatype MB with the same structure as
673 -- MonoBinds, but which has slots for the representations
676 -----------------------------------------------------------------------------
677 -- GHC allows a more general form of lambda abstraction than specified
678 -- by Haskell 98. In particular it allows guarded lambda's like :
679 -- (\ x | even x -> 0 | odd x -> 1) at the moment we can't represent this in
680 -- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like
681 -- (\ p1 .. pn -> exp) by causing an error.
683 repLambda :: Match Name -> DsM (Core M.Expr)
684 repLambda (Match ps _ (GRHSs [GRHS [ResultStmt e _ ] _ ]
686 = do { let bndrs = collectPatsBinders ps ;
687 ; ss <- mkGenSyms bndrs
688 ; lam <- addBinds ss (
689 do { xs <- repPs ps; body <- repE e; repLam xs body })
690 ; wrapGenSyns ss lam }
692 repLambda z = panic "Can't represent a guarded lambda in Template Haskell"
695 -----------------------------------------------------------------------------
697 -- repP deals with patterns. It assumes that we have already
698 -- walked over the pattern(s) once to collect the binders, and
699 -- have extended the environment. So every pattern-bound
700 -- variable should already appear in the environment.
702 -- Process a list of patterns
703 repPs :: [Pat Name] -> DsM (Core [M.Patt])
704 repPs ps = do { ps' <- mapM repP ps ;
705 coreList pattTyConName ps' }
707 repP :: Pat Name -> DsM (Core M.Patt)
708 repP (WildPat _) = repPwild
709 repP (LitPat l) = do { l2 <- repLiteral l; repPlit l2 }
710 repP (VarPat x) = do { x' <- lookupBinder x; repPvar x' }
711 repP (LazyPat p) = do { p1 <- repP p; repPtilde p1 }
712 repP (AsPat x p) = do { x' <- lookupBinder x; p1 <- repP p; repPaspat x' p1 }
713 repP (ParPat p) = repP p
714 repP (ListPat ps _) = repListPat ps
715 repP (TuplePat ps _) = do { qs <- repPs ps; repPtup qs }
716 repP (ConPatIn dc details)
717 = do { con_str <- lookupOcc dc
719 PrefixCon ps -> do { qs <- repPs ps; repPcon con_str qs }
720 RecCon pairs -> error "No records in template haskell yet"
721 InfixCon p1 p2 -> do { qs <- repPs [p1,p2]; repPcon con_str qs }
723 repP (NPatIn l (Just _)) = panic "Can't cope with negative overloaded patterns yet (repP (NPatIn _ (Just _)))"
724 repP (NPatIn l Nothing) = do { a <- repOverloadedLiteral l; repPlit a }
725 repP other = panic "Exotic pattern inside meta brackets"
727 repListPat :: [Pat Name] -> DsM (Core M.Patt)
728 repListPat [] = do { nil_con <- coreStringLit "[]"
729 ; nil_args <- coreList pattTyConName []
730 ; repPcon nil_con nil_args }
731 repListPat (p:ps) = do { p2 <- repP p
732 ; ps2 <- repListPat ps
733 ; cons_con <- coreStringLit ":"
734 ; repPcon cons_con (nonEmptyCoreList [p2,ps2]) }
737 ----------------------------------------------------------
738 -- The meta-environment
740 -- A name/identifier association for fresh names of locally bound entities
742 type GenSymBind = (Name, Id) -- Gensym the string and bind it to the Id
743 -- I.e. (x, x_id) means
744 -- let x_id = gensym "x" in ...
746 -- Generate a fresh name for a locally bound entity
748 mkGenSym :: Name -> DsM GenSymBind
749 mkGenSym nm = do { id <- newUniqueId nm stringTy; return (nm,id) }
751 -- Ditto for a list of names
753 mkGenSyms :: [Name] -> DsM [GenSymBind]
754 mkGenSyms ns = mapM mkGenSym ns
756 -- Add a list of fresh names for locally bound entities to the meta
757 -- environment (which is part of the state carried around by the desugarer
760 addBinds :: [GenSymBind] -> DsM a -> DsM a
761 addBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,Bound id) | (n,id) <- bs]) m
763 -- Look up a locally bound name
765 lookupBinder :: Name -> DsM (Core String)
767 = do { mb_val <- dsLookupMetaEnv n;
769 Just (Bound x) -> return (coreVar x)
770 other -> pprPanic "Failed binder lookup:" (ppr n) }
772 -- Look up a name that is either locally bound or a global name
774 -- * If it is a global name, generate the "original name" representation (ie,
775 -- the <module>:<name> form) for the associated entity
777 lookupOcc :: Name -> DsM (Core String)
778 -- Lookup an occurrence; it can't be a splice.
779 -- Use the in-scope bindings if they exist
781 = do { mb_val <- dsLookupMetaEnv n ;
783 Nothing -> globalVar n
784 Just (Bound x) -> return (coreVar x)
785 Just (Splice _) -> pprPanic "repE:lookupOcc" (ppr n)
788 globalVar :: Name -> DsM (Core String)
789 globalVar n = coreStringLit (name_mod ++ ":" ++ name_occ)
791 name_mod = moduleUserString (nameModule n)
792 name_occ = occNameUserString (nameOccName n)
794 localVar :: Name -> DsM (Core String)
795 localVar n = coreStringLit (occNameUserString (nameOccName n))
797 lookupType :: Name -- Name of type constructor (e.g. M.Expr)
798 -> DsM Type -- The type
799 lookupType tc_name = do { tc <- dsLookupTyCon tc_name ;
800 return (mkGenTyConApp tc []) }
802 -- wrapGenSyns [(nm1,id1), (nm2,id2)] y
803 -- --> bindQ (gensym nm1) (\ id1 ->
804 -- bindQ (gensym nm2 (\ id2 ->
807 wrapGenSyns :: [GenSymBind]
808 -> Core (M.Q a) -> DsM (Core (M.Q a))
809 wrapGenSyns binds body@(MkC b)
812 [elt_ty] = tcTyConAppArgs (exprType b)
813 -- b :: Q a, so we can get the type 'a' by looking at the
814 -- argument type. NB: this relies on Q being a data/newtype,
815 -- not a type synonym
818 go ((name,id) : binds)
819 = do { MkC body' <- go binds
820 ; lit_str <- localVar name
821 ; gensym_app <- repGensym lit_str
822 ; repBindQ stringTy elt_ty
823 gensym_app (MkC (Lam id body')) }
825 -- Just like wrapGenSym, but don't actually do the gensym
826 -- Instead use the existing name
827 -- Only used for [Decl]
828 wrapNongenSyms :: [GenSymBind] -> Core a -> DsM (Core a)
829 wrapNongenSyms binds (MkC body)
830 = do { binds' <- mapM do_one binds ;
831 return (MkC (mkLets binds' body)) }
834 = do { MkC lit_str <- localVar name -- No gensym
835 ; return (NonRec id lit_str) }
837 void = placeHolderType
839 string :: String -> HsExpr Id
840 string s = HsLit (HsString (mkFastString s))
843 -- %*********************************************************************
847 -- %*********************************************************************
849 -----------------------------------------------------------------------------
850 -- PHANTOM TYPES for consistency. In order to make sure we do this correct
851 -- we invent a new datatype which uses phantom types.
853 newtype Core a = MkC CoreExpr
856 rep2 :: Name -> [ CoreExpr ] -> DsM (Core a)
857 rep2 n xs = do { id <- dsLookupGlobalId n
858 ; return (MkC (foldl App (Var id) xs)) }
860 -- Then we make "repConstructors" which use the phantom types for each of the
861 -- smart constructors of the Meta.Meta datatypes.
864 -- %*********************************************************************
866 -- The 'smart constructors'
868 -- %*********************************************************************
870 --------------- Patterns -----------------
871 repPlit :: Core M.Lit -> DsM (Core M.Patt)
872 repPlit (MkC l) = rep2 plitName [l]
874 repPvar :: Core String -> DsM (Core M.Patt)
875 repPvar (MkC s) = rep2 pvarName [s]
877 repPtup :: Core [M.Patt] -> DsM (Core M.Patt)
878 repPtup (MkC ps) = rep2 ptupName [ps]
880 repPcon :: Core String -> Core [M.Patt] -> DsM (Core M.Patt)
881 repPcon (MkC s) (MkC ps) = rep2 pconName [s, ps]
883 repPtilde :: Core M.Patt -> DsM (Core M.Patt)
884 repPtilde (MkC p) = rep2 ptildeName [p]
886 repPaspat :: Core String -> Core M.Patt -> DsM (Core M.Patt)
887 repPaspat (MkC s) (MkC p) = rep2 paspatName [s, p]
889 repPwild :: DsM (Core M.Patt)
890 repPwild = rep2 pwildName []
892 --------------- Expressions -----------------
893 repVarOrCon :: Name -> Core String -> DsM (Core M.Expr)
894 repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
895 | otherwise = repVar str
897 repVar :: Core String -> DsM (Core M.Expr)
898 repVar (MkC s) = rep2 varName [s]
900 repCon :: Core String -> DsM (Core M.Expr)
901 repCon (MkC s) = rep2 conName [s]
903 repLit :: Core M.Lit -> DsM (Core M.Expr)
904 repLit (MkC c) = rep2 litName [c]
906 repApp :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
907 repApp (MkC x) (MkC y) = rep2 appName [x,y]
909 repLam :: Core [M.Patt] -> Core M.Expr -> DsM (Core M.Expr)
910 repLam (MkC ps) (MkC e) = rep2 lamName [ps, e]
912 repTup :: Core [M.Expr] -> DsM (Core M.Expr)
913 repTup (MkC es) = rep2 tupName [es]
915 repCond :: Core M.Expr -> Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
916 repCond (MkC x) (MkC y) (MkC z) = rep2 condName [x,y,z]
918 repLetE :: Core [M.Decl] -> Core M.Expr -> DsM (Core M.Expr)
919 repLetE (MkC ds) (MkC e) = rep2 letEName [ds, e]
921 repCaseE :: Core M.Expr -> Core [M.Mtch] -> DsM( Core M.Expr)
922 repCaseE (MkC e) (MkC ms) = rep2 caseEName [e, ms]
924 repDoE :: Core [M.Stmt] -> DsM (Core M.Expr)
925 repDoE (MkC ss) = rep2 doEName [ss]
927 repComp :: Core [M.Stmt] -> DsM (Core M.Expr)
928 repComp (MkC ss) = rep2 compName [ss]
930 repListExp :: Core [M.Expr] -> DsM (Core M.Expr)
931 repListExp (MkC es) = rep2 listExpName [es]
933 repSigExp :: Core M.Expr -> Core M.Type -> DsM (Core M.Expr)
934 repSigExp (MkC e) (MkC t) = rep2 sigExpName [e,t]
936 repInfixApp :: Core M.Expr -> Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
937 repInfixApp (MkC x) (MkC y) (MkC z) = rep2 infixAppName [x,y,z]
939 repSectionL :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
940 repSectionL (MkC x) (MkC y) = rep2 sectionLName [x,y]
942 repSectionR :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
943 repSectionR (MkC x) (MkC y) = rep2 sectionRName [x,y]
945 ------------ Right hand sides (guarded expressions) ----
946 repGuarded :: Core [(M.Expr, M.Expr)] -> DsM (Core M.Rihs)
947 repGuarded (MkC pairs) = rep2 guardedName [pairs]
949 repNormal :: Core M.Expr -> DsM (Core M.Rihs)
950 repNormal (MkC e) = rep2 normalName [e]
952 ------------- Statements -------------------
953 repBindSt :: Core M.Patt -> Core M.Expr -> DsM (Core M.Stmt)
954 repBindSt (MkC p) (MkC e) = rep2 bindStName [p,e]
956 repLetSt :: Core [M.Decl] -> DsM (Core M.Stmt)
957 repLetSt (MkC ds) = rep2 letStName [ds]
959 repNoBindSt :: Core M.Expr -> DsM (Core M.Stmt)
960 repNoBindSt (MkC e) = rep2 noBindStName [e]
962 -------------- DotDot (Arithmetic sequences) -----------
963 repFrom :: Core M.Expr -> DsM (Core M.Expr)
964 repFrom (MkC x) = rep2 fromName [x]
966 repFromThen :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
967 repFromThen (MkC x) (MkC y) = rep2 fromThenName [x,y]
969 repFromTo :: Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
970 repFromTo (MkC x) (MkC y) = rep2 fromToName [x,y]
972 repFromThenTo :: Core M.Expr -> Core M.Expr -> Core M.Expr -> DsM (Core M.Expr)
973 repFromThenTo (MkC x) (MkC y) (MkC z) = rep2 fromThenToName [x,y,z]
975 ------------ Match and Clause Tuples -----------
976 repMatch :: Core M.Patt -> Core M.Rihs -> Core [M.Decl] -> DsM (Core M.Mtch)
977 repMatch (MkC p) (MkC bod) (MkC ds) = rep2 matchName [p, bod, ds]
979 repClause :: Core [M.Patt] -> Core M.Rihs -> Core [M.Decl] -> DsM (Core M.Clse)
980 repClause (MkC ps) (MkC bod) (MkC ds) = rep2 clauseName [ps, bod, ds]
982 -------------- Dec -----------------------------
983 repVal :: Core M.Patt -> Core M.Rihs -> Core [M.Decl] -> DsM (Core M.Decl)
984 repVal (MkC p) (MkC b) (MkC ds) = rep2 valName [p, b, ds]
986 repFun :: Core String -> Core [M.Clse] -> DsM (Core M.Decl)
987 repFun (MkC nm) (MkC b) = rep2 funName [nm, b]
989 repData :: Core String -> Core [String] -> Core [M.Cons] -> Core [String] -> DsM (Core M.Decl)
990 repData (MkC nm) (MkC tvs) (MkC cons) (MkC derivs) = rep2 dataDName [nm, tvs, cons, derivs]
992 repTySyn :: Core String -> Core [String] -> Core M.Type -> DsM (Core M.Decl)
993 repTySyn (MkC nm) (MkC tvs) (MkC rhs) = rep2 tySynDName [nm, tvs, rhs]
995 repInst :: Core M.Ctxt -> Core M.Type -> Core [M.Decl] -> DsM (Core M.Decl)
996 repInst (MkC cxt) (MkC ty) (MkC ds) = rep2 instName [cxt, ty, ds]
998 repClass :: Core M.Ctxt -> Core String -> Core [String] -> Core [M.Decl] -> DsM (Core M.Decl)
999 repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC ds) = rep2 classDName [cxt, cls, tvs, ds]
1001 repProto :: Core String -> Core M.Type -> DsM (Core M.Decl)
1002 repProto (MkC s) (MkC ty) = rep2 protoName [s, ty]
1004 repCtxt :: Core [M.Type] -> DsM (Core M.Ctxt)
1005 repCtxt (MkC tys) = rep2 ctxtName [tys]
1007 repConstr :: Core String -> HsConDetails Name (BangType Name)
1008 -> DsM (Core M.Cons)
1009 repConstr con (PrefixCon ps)
1010 = do arg_tys <- mapM repBangTy ps
1011 arg_tys1 <- coreList strTypeTyConName arg_tys
1012 rep2 constrName [unC con, unC arg_tys1]
1013 repConstr con (RecCon ips)
1014 = do arg_vs <- mapM lookupOcc (map fst ips)
1015 arg_tys <- mapM repBangTy (map snd ips)
1016 arg_vtys <- zipWithM (\x y -> rep2 varStrictTypeName [unC x, unC y])
1018 arg_vtys' <- coreList varStrTypeTyConName arg_vtys
1019 rep2 recConstrName [unC con, unC arg_vtys']
1020 repConstr con (InfixCon st1 st2)
1021 = do arg1 <- repBangTy st1
1022 arg2 <- repBangTy st2
1023 rep2 infixConstrName [unC arg1, unC con, unC arg2]
1025 ------------ Types -------------------
1027 repTForall :: Core [String] -> Core M.Ctxt -> Core M.Type -> DsM (Core M.Type)
1028 repTForall (MkC tvars) (MkC ctxt) (MkC ty) = rep2 tforallName [tvars, ctxt, ty]
1030 repTvar :: Core String -> DsM (Core M.Type)
1031 repTvar (MkC s) = rep2 tvarName [s]
1033 repTapp :: Core M.Type -> Core M.Type -> DsM (Core M.Type)
1034 repTapp (MkC t1) (MkC t2) = rep2 tappName [t1,t2]
1036 repTapps :: Core M.Type -> [Core M.Type] -> DsM (Core M.Type)
1037 repTapps f [] = return f
1038 repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
1040 --------- Type constructors --------------
1042 repNamedTyCon :: Core String -> DsM (Core M.Type)
1043 repNamedTyCon (MkC s) = rep2 namedTyConName [s]
1045 repTupleTyCon :: Int -> DsM (Core M.Type)
1046 -- Note: not Core Int; it's easier to be direct here
1047 repTupleTyCon i = rep2 tupleTyConName [mkIntExpr (fromIntegral i)]
1049 repArrowTyCon :: DsM (Core M.Type)
1050 repArrowTyCon = rep2 arrowTyConName []
1052 repListTyCon :: DsM (Core M.Type)
1053 repListTyCon = rep2 listTyConName []
1056 ----------------------------------------------------------
1059 repLiteral :: HsLit -> DsM (Core M.Lit)
1061 = do { lit_expr <- dsLit lit; rep2 lit_name [lit_expr] }
1063 lit_name = case lit of
1064 HsInteger _ -> integerLName
1065 HsChar _ -> charLName
1066 HsString _ -> stringLName
1067 HsRat _ _ -> rationalLName
1069 uh_oh = pprPanic "DsMeta.repLiteral: trying to represent exotic literal"
1072 repOverloadedLiteral :: HsOverLit -> DsM (Core M.Lit)
1073 repOverloadedLiteral (HsIntegral i _) = repLiteral (HsInteger i)
1074 repOverloadedLiteral (HsFractional f _) = do { rat_ty <- lookupType rationalTyConName ;
1075 repLiteral (HsRat f rat_ty) }
1076 -- The type Rational will be in the environment, becuase
1077 -- the smart constructor 'THSyntax.rationalL' uses it in its type,
1078 -- and rationalL is sucked in when any TH stuff is used
1080 --------------- Miscellaneous -------------------
1082 repLift :: Core e -> DsM (Core M.Expr)
1083 repLift (MkC x) = rep2 liftName [x]
1085 repGensym :: Core String -> DsM (Core (M.Q String))
1086 repGensym (MkC lit_str) = rep2 gensymName [lit_str]
1088 repBindQ :: Type -> Type -- a and b
1089 -> Core (M.Q a) -> Core (a -> M.Q b) -> DsM (Core (M.Q b))
1090 repBindQ ty_a ty_b (MkC x) (MkC y)
1091 = rep2 bindQName [Type ty_a, Type ty_b, x, y]
1093 repSequenceQ :: Type -> Core [M.Q a] -> DsM (Core (M.Q [a]))
1094 repSequenceQ ty_a (MkC list)
1095 = rep2 sequenceQName [Type ty_a, list]
1097 ------------ Lists and Tuples -------------------
1098 -- turn a list of patterns into a single pattern matching a list
1100 coreList :: Name -- Of the TyCon of the element type
1101 -> [Core a] -> DsM (Core [a])
1103 = do { elt_ty <- lookupType tc_name; return (coreList' elt_ty es) }
1105 coreList' :: Type -- The element type
1106 -> [Core a] -> Core [a]
1107 coreList' elt_ty es = MkC (mkListExpr elt_ty (map unC es ))
1109 nonEmptyCoreList :: [Core a] -> Core [a]
1110 -- The list must be non-empty so we can get the element type
1111 -- Otherwise use coreList
1112 nonEmptyCoreList [] = panic "coreList: empty argument"
1113 nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs))
1115 corePair :: (Core a, Core b) -> Core (a,b)
1116 corePair (MkC x, MkC y) = MkC (mkCoreTup [x,y])
1118 coreStringLit :: String -> DsM (Core String)
1119 coreStringLit s = do { z <- mkStringLit s; return(MkC z) }
1121 coreVar :: Id -> Core String -- The Id has type String
1122 coreVar id = MkC (Var id)
1126 -- %************************************************************************
1128 -- The known-key names for Template Haskell
1130 -- %************************************************************************
1132 -- To add a name, do three things
1134 -- 1) Allocate a key
1136 -- 3) Add the name to knownKeyNames
1138 templateHaskellNames :: NameSet
1139 -- The names that are implicitly mentioned by ``bracket''
1140 -- Should stay in sync with the import list of DsMeta
1141 templateHaskellNames
1142 = mkNameSet [ integerLName,charLName, stringLName, rationalLName,
1143 plitName, pvarName, ptupName,
1144 pconName, ptildeName, paspatName, pwildName,
1145 varName, conName, litName, appName, infixEName, lamName,
1146 tupName, doEName, compName,
1147 listExpName, sigExpName, condName, letEName, caseEName,
1148 infixAppName, sectionLName, sectionRName,
1149 guardedName, normalName,
1150 bindStName, letStName, noBindStName, parStName,
1151 fromName, fromThenName, fromToName, fromThenToName,
1152 funName, valName, liftName,
1153 gensymName, returnQName, bindQName, sequenceQName,
1154 matchName, clauseName, funName, valName, tySynDName, dataDName, classDName,
1155 instName, protoName, tforallName, tvarName, tconName, tappName,
1156 arrowTyConName, tupleTyConName, listTyConName, namedTyConName,
1157 ctxtName, constrName, recConstrName, infixConstrName,
1158 exprTyConName, declTyConName, pattTyConName, mtchTyConName,
1159 clseTyConName, stmtTyConName, consTyConName, typeTyConName,
1160 strTypeTyConName, varStrTypeTyConName,
1161 qTyConName, expTyConName, matTyConName, clsTyConName,
1162 decTyConName, typTyConName, strictTypeName, varStrictTypeName,
1163 strictName, nonstrictName ]
1166 varQual = mk_known_key_name OccName.varName
1167 tcQual = mk_known_key_name OccName.tcName
1170 -- NB: the THSyntax module comes from the "haskell-src" package
1171 thModule = mkThPkgModule mETA_META_Name
1173 mk_known_key_name space str uniq
1174 = mkKnownKeyExternalName thModule (mkOccFS space str) uniq
1176 integerLName = varQual FSLIT("integerL") integerLIdKey
1177 charLName = varQual FSLIT("charL") charLIdKey
1178 stringLName = varQual FSLIT("stringL") stringLIdKey
1179 rationalLName = varQual FSLIT("rationalL") rationalLIdKey
1180 plitName = varQual FSLIT("plit") plitIdKey
1181 pvarName = varQual FSLIT("pvar") pvarIdKey
1182 ptupName = varQual FSLIT("ptup") ptupIdKey
1183 pconName = varQual FSLIT("pcon") pconIdKey
1184 ptildeName = varQual FSLIT("ptilde") ptildeIdKey
1185 paspatName = varQual FSLIT("paspat") paspatIdKey
1186 pwildName = varQual FSLIT("pwild") pwildIdKey
1187 varName = varQual FSLIT("var") varIdKey
1188 conName = varQual FSLIT("con") conIdKey
1189 litName = varQual FSLIT("lit") litIdKey
1190 appName = varQual FSLIT("app") appIdKey
1191 infixEName = varQual FSLIT("infixE") infixEIdKey
1192 lamName = varQual FSLIT("lam") lamIdKey
1193 tupName = varQual FSLIT("tup") tupIdKey
1194 doEName = varQual FSLIT("doE") doEIdKey
1195 compName = varQual FSLIT("comp") compIdKey
1196 listExpName = varQual FSLIT("listExp") listExpIdKey
1197 sigExpName = varQual FSLIT("sigExp") sigExpIdKey
1198 condName = varQual FSLIT("cond") condIdKey
1199 letEName = varQual FSLIT("letE") letEIdKey
1200 caseEName = varQual FSLIT("caseE") caseEIdKey
1201 infixAppName = varQual FSLIT("infixApp") infixAppIdKey
1202 sectionLName = varQual FSLIT("sectionL") sectionLIdKey
1203 sectionRName = varQual FSLIT("sectionR") sectionRIdKey
1204 guardedName = varQual FSLIT("guarded") guardedIdKey
1205 normalName = varQual FSLIT("normal") normalIdKey
1206 bindStName = varQual FSLIT("bindSt") bindStIdKey
1207 letStName = varQual FSLIT("letSt") letStIdKey
1208 noBindStName = varQual FSLIT("noBindSt") noBindStIdKey
1209 parStName = varQual FSLIT("parSt") parStIdKey
1210 fromName = varQual FSLIT("from") fromIdKey
1211 fromThenName = varQual FSLIT("fromThen") fromThenIdKey
1212 fromToName = varQual FSLIT("fromTo") fromToIdKey
1213 fromThenToName = varQual FSLIT("fromThenTo") fromThenToIdKey
1214 liftName = varQual FSLIT("lift") liftIdKey
1215 gensymName = varQual FSLIT("gensym") gensymIdKey
1216 returnQName = varQual FSLIT("returnQ") returnQIdKey
1217 bindQName = varQual FSLIT("bindQ") bindQIdKey
1218 sequenceQName = varQual FSLIT("sequenceQ") sequenceQIdKey
1221 matchName = varQual FSLIT("match") matchIdKey
1224 clauseName = varQual FSLIT("clause") clauseIdKey
1227 funName = varQual FSLIT("fun") funIdKey
1228 valName = varQual FSLIT("val") valIdKey
1229 dataDName = varQual FSLIT("dataD") dataDIdKey
1230 tySynDName = varQual FSLIT("tySynD") tySynDIdKey
1231 classDName = varQual FSLIT("classD") classDIdKey
1232 instName = varQual FSLIT("inst") instIdKey
1233 protoName = varQual FSLIT("proto") protoIdKey
1236 tforallName = varQual FSLIT("tforall") tforallIdKey
1237 tvarName = varQual FSLIT("tvar") tvarIdKey
1238 tconName = varQual FSLIT("tcon") tconIdKey
1239 tappName = varQual FSLIT("tapp") tappIdKey
1242 arrowTyConName = varQual FSLIT("arrowTyCon") arrowIdKey
1243 tupleTyConName = varQual FSLIT("tupleTyCon") tupleIdKey
1244 listTyConName = varQual FSLIT("listTyCon") listIdKey
1245 namedTyConName = varQual FSLIT("namedTyCon") namedTyConIdKey
1248 ctxtName = varQual FSLIT("ctxt") ctxtIdKey
1251 constrName = varQual FSLIT("constr") constrIdKey
1252 recConstrName = varQual FSLIT("recConstr") recConstrIdKey
1253 infixConstrName = varQual FSLIT("infixConstr") infixConstrIdKey
1255 exprTyConName = tcQual FSLIT("Expr") exprTyConKey
1256 declTyConName = tcQual FSLIT("Decl") declTyConKey
1257 pattTyConName = tcQual FSLIT("Patt") pattTyConKey
1258 mtchTyConName = tcQual FSLIT("Mtch") mtchTyConKey
1259 clseTyConName = tcQual FSLIT("Clse") clseTyConKey
1260 stmtTyConName = tcQual FSLIT("Stmt") stmtTyConKey
1261 consTyConName = tcQual FSLIT("Cons") consTyConKey
1262 typeTyConName = tcQual FSLIT("Type") typeTyConKey
1263 strTypeTyConName = tcQual FSLIT("StrType") strTypeTyConKey
1264 varStrTypeTyConName = tcQual FSLIT("VarStrType") varStrTypeTyConKey
1266 qTyConName = tcQual FSLIT("Q") qTyConKey
1267 expTyConName = tcQual FSLIT("Exp") expTyConKey
1268 decTyConName = tcQual FSLIT("Dec") decTyConKey
1269 typTyConName = tcQual FSLIT("Typ") typTyConKey
1270 matTyConName = tcQual FSLIT("Mat") matTyConKey
1271 clsTyConName = tcQual FSLIT("Cls") clsTyConKey
1273 strictTypeName = varQual FSLIT("strictType") strictTypeKey
1274 varStrictTypeName = varQual FSLIT("varStrictType") varStrictTypeKey
1275 strictName = varQual FSLIT("strict") strictKey
1276 nonstrictName = varQual FSLIT("nonstrict") nonstrictKey
1278 -- TyConUniques available: 100-119
1279 -- Check in PrelNames if you want to change this
1281 expTyConKey = mkPreludeTyConUnique 100
1282 matTyConKey = mkPreludeTyConUnique 101
1283 clsTyConKey = mkPreludeTyConUnique 102
1284 qTyConKey = mkPreludeTyConUnique 103
1285 exprTyConKey = mkPreludeTyConUnique 104
1286 declTyConKey = mkPreludeTyConUnique 105
1287 pattTyConKey = mkPreludeTyConUnique 106
1288 mtchTyConKey = mkPreludeTyConUnique 107
1289 clseTyConKey = mkPreludeTyConUnique 108
1290 stmtTyConKey = mkPreludeTyConUnique 109
1291 consTyConKey = mkPreludeTyConUnique 110
1292 typeTyConKey = mkPreludeTyConUnique 111
1293 typTyConKey = mkPreludeTyConUnique 112
1294 decTyConKey = mkPreludeTyConUnique 113
1295 varStrTypeTyConKey = mkPreludeTyConUnique 114
1296 strTypeTyConKey = mkPreludeTyConUnique 115
1300 -- IdUniques available: 200-299
1301 -- If you want to change this, make sure you check in PrelNames
1302 fromIdKey = mkPreludeMiscIdUnique 200
1303 fromThenIdKey = mkPreludeMiscIdUnique 201
1304 fromToIdKey = mkPreludeMiscIdUnique 202
1305 fromThenToIdKey = mkPreludeMiscIdUnique 203
1306 liftIdKey = mkPreludeMiscIdUnique 204
1307 gensymIdKey = mkPreludeMiscIdUnique 205
1308 returnQIdKey = mkPreludeMiscIdUnique 206
1309 bindQIdKey = mkPreludeMiscIdUnique 207
1310 funIdKey = mkPreludeMiscIdUnique 208
1311 valIdKey = mkPreludeMiscIdUnique 209
1312 protoIdKey = mkPreludeMiscIdUnique 210
1313 matchIdKey = mkPreludeMiscIdUnique 211
1314 clauseIdKey = mkPreludeMiscIdUnique 212
1315 integerLIdKey = mkPreludeMiscIdUnique 213
1316 charLIdKey = mkPreludeMiscIdUnique 214
1318 classDIdKey = mkPreludeMiscIdUnique 215
1319 instIdKey = mkPreludeMiscIdUnique 216
1320 dataDIdKey = mkPreludeMiscIdUnique 217
1322 sequenceQIdKey = mkPreludeMiscIdUnique 218
1323 tySynDIdKey = mkPreludeMiscIdUnique 219
1325 plitIdKey = mkPreludeMiscIdUnique 220
1326 pvarIdKey = mkPreludeMiscIdUnique 221
1327 ptupIdKey = mkPreludeMiscIdUnique 222
1328 pconIdKey = mkPreludeMiscIdUnique 223
1329 ptildeIdKey = mkPreludeMiscIdUnique 224
1330 paspatIdKey = mkPreludeMiscIdUnique 225
1331 pwildIdKey = mkPreludeMiscIdUnique 226
1332 varIdKey = mkPreludeMiscIdUnique 227
1333 conIdKey = mkPreludeMiscIdUnique 228
1334 litIdKey = mkPreludeMiscIdUnique 229
1335 appIdKey = mkPreludeMiscIdUnique 230
1336 infixEIdKey = mkPreludeMiscIdUnique 231
1337 lamIdKey = mkPreludeMiscIdUnique 232
1338 tupIdKey = mkPreludeMiscIdUnique 233
1339 doEIdKey = mkPreludeMiscIdUnique 234
1340 compIdKey = mkPreludeMiscIdUnique 235
1341 listExpIdKey = mkPreludeMiscIdUnique 237
1342 condIdKey = mkPreludeMiscIdUnique 238
1343 letEIdKey = mkPreludeMiscIdUnique 239
1344 caseEIdKey = mkPreludeMiscIdUnique 240
1345 infixAppIdKey = mkPreludeMiscIdUnique 241
1347 sectionLIdKey = mkPreludeMiscIdUnique 243
1348 sectionRIdKey = mkPreludeMiscIdUnique 244
1349 guardedIdKey = mkPreludeMiscIdUnique 245
1350 normalIdKey = mkPreludeMiscIdUnique 246
1351 bindStIdKey = mkPreludeMiscIdUnique 247
1352 letStIdKey = mkPreludeMiscIdUnique 248
1353 noBindStIdKey = mkPreludeMiscIdUnique 249
1354 parStIdKey = mkPreludeMiscIdUnique 250
1356 tforallIdKey = mkPreludeMiscIdUnique 251
1357 tvarIdKey = mkPreludeMiscIdUnique 252
1358 tconIdKey = mkPreludeMiscIdUnique 253
1359 tappIdKey = mkPreludeMiscIdUnique 254
1361 arrowIdKey = mkPreludeMiscIdUnique 255
1362 tupleIdKey = mkPreludeMiscIdUnique 256
1363 listIdKey = mkPreludeMiscIdUnique 257
1364 namedTyConIdKey = mkPreludeMiscIdUnique 258
1366 ctxtIdKey = mkPreludeMiscIdUnique 259
1368 constrIdKey = mkPreludeMiscIdUnique 260
1370 stringLIdKey = mkPreludeMiscIdUnique 261
1371 rationalLIdKey = mkPreludeMiscIdUnique 262
1373 sigExpIdKey = mkPreludeMiscIdUnique 263
1375 strictTypeKey = mkPreludeMiscIdUnique 264
1376 strictKey = mkPreludeMiscIdUnique 265
1377 nonstrictKey = mkPreludeMiscIdUnique 266
1378 varStrictTypeKey = mkPreludeMiscIdUnique 267
1380 recConstrIdKey = mkPreludeMiscIdUnique 268
1381 infixConstrIdKey = mkPreludeMiscIdUnique 269
1383 -- %************************************************************************
1387 -- %************************************************************************
1389 -- It is rather usatisfactory that we don't have a SrcLoc
1390 addDsWarn :: SDoc -> DsM ()
1391 addDsWarn msg = dsWarn (noSrcLoc, msg)