1 -----------------------------------------------------------------------------
3 -- (c) The University of Glasgow 2006
5 -- The purpose of this module is to transform an HsExpr into a CoreExpr which
6 -- when evaluated, returns a (Meta.Q Meta.Exp) computation analogous to the
7 -- input HsExpr. We do this in the DsM monad, which supplies access to
8 -- CoreExpr's of the "smart constructors" of the Meta.Exp datatype.
10 -- It also defines a bunch of knownKeyNames, in the same way as is done
11 -- in prelude/PrelNames. It's much more convenient to do it here, becuase
12 -- otherwise we have to recompile PrelNames whenever we add a Name, which is
13 -- a Royal Pain (triggers other recompilation).
14 -----------------------------------------------------------------------------
16 module DsMeta( dsBracket,
17 templateHaskellNames, qTyConName, nameTyConName,
18 liftName, liftStringName, expQTyConName, patQTyConName, decQTyConName, typeQTyConName,
19 decTyConName, typeTyConName, mkNameG_dName, mkNameG_vName, mkNameG_tcName,
20 quoteExpName, quotePatName
23 #include "HsVersions.h"
25 import {-# SOURCE #-} DsExpr ( dsExpr )
31 import qualified Language.Haskell.TH as TH
36 -- To avoid clashes with DsMeta.varName we must make a local alias for
37 -- OccName.varName we do this by removing varName from the import of
38 -- OccName above, making a qualified instance of OccName and using
39 -- OccNameAlias.varName where varName ws previously used in this file.
40 import qualified OccName
65 -----------------------------------------------------------------------------
66 dsBracket :: HsBracket Name -> [PendingSplice] -> DsM CoreExpr
67 -- Returns a CoreExpr of type TH.ExpQ
68 -- The quoted thing is parameterised over Name, even though it has
69 -- been type checked. We don't want all those type decorations!
71 dsBracket brack splices
72 = dsExtendMetaEnv new_bit (do_brack brack)
74 new_bit = mkNameEnv [(n, Splice (unLoc e)) | (n,e) <- splices]
76 do_brack (VarBr n) = do { MkC e1 <- lookupOcc n ; return e1 }
77 do_brack (ExpBr e) = do { MkC e1 <- repLE e ; return e1 }
78 do_brack (PatBr p) = do { MkC p1 <- repLP p ; return p1 }
79 do_brack (TypBr t) = do { MkC t1 <- repLTy t ; return t1 }
80 do_brack (DecBr ds) = do { MkC ds1 <- repTopDs ds ; return ds1 }
82 {- -------------- Examples --------------------
86 gensym (unpackString "x"#) `bindQ` \ x1::String ->
87 lam (pvar x1) (var x1)
90 [| \x -> $(f [| x |]) |]
92 gensym (unpackString "x"#) `bindQ` \ x1::String ->
93 lam (pvar x1) (f (var x1))
97 -------------------------------------------------------
99 -------------------------------------------------------
101 repTopDs :: HsGroup Name -> DsM (Core (TH.Q [TH.Dec]))
103 = do { let { bndrs = map unLoc (groupBinders group) } ;
104 ss <- mkGenSyms bndrs ;
106 -- Bind all the names mainly to avoid repeated use of explicit strings.
108 -- do { t :: String <- genSym "T" ;
109 -- return (Data t [] ...more t's... }
110 -- The other important reason is that the output must mention
111 -- only "T", not "Foo:T" where Foo is the current module
114 decls <- addBinds ss (do {
115 val_ds <- rep_val_binds (hs_valds group) ;
116 tycl_ds <- mapM repTyClD (hs_tyclds group) ;
117 inst_ds <- mapM repInstD' (hs_instds group) ;
118 for_ds <- mapM repForD (hs_fords group) ;
120 return (de_loc $ sort_by_loc $ val_ds ++ catMaybes tycl_ds ++ inst_ds ++ for_ds) }) ;
122 decl_ty <- lookupType decQTyConName ;
123 let { core_list = coreList' decl_ty decls } ;
125 dec_ty <- lookupType decTyConName ;
126 q_decs <- repSequenceQ dec_ty core_list ;
128 wrapNongenSyms ss q_decs
129 -- Do *not* gensym top-level binders
132 groupBinders :: HsGroup Name -> [Located Name]
133 groupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
134 hs_instds = inst_decls, hs_fords = foreign_decls })
135 -- Collect the binders of a Group
136 = collectHsValBinders val_decls ++
137 [n | d <- tycl_decls ++ assoc_tycl_decls, n <- tyClDeclNames (unLoc d)] ++
138 [n | L _ (ForeignImport n _ _) <- foreign_decls]
140 assoc_tycl_decls = concat [ats | L _ (InstDecl _ _ _ ats) <- inst_decls]
143 {- Note [Binders and occurrences]
144 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
145 When we desugar [d| data T = MkT |]
147 Data "T" [] [Con "MkT" []] []
149 Data "Foo:T" [] [Con "Foo:MkT" []] []
150 That is, the new data decl should fit into whatever new module it is
151 asked to fit in. We do *not* clone, though; no need for this:
158 then we must desugar to
159 foo = Data "Foo:T" [] [Con "Foo:MkT" []] []
161 So in repTopDs we bring the binders into scope with mkGenSyms and addBinds.
162 And we use lookupOcc, rather than lookupBinder
163 in repTyClD and repC.
167 repTyClD :: LTyClDecl Name -> DsM (Maybe (SrcSpan, Core TH.DecQ))
169 repTyClD tydecl@(L _ (TyFamily {}))
170 = repTyFamily tydecl addTyVarBinds
172 repTyClD (L loc (TyData { tcdND = DataType, tcdCtxt = cxt,
173 tcdLName = tc, tcdTyVars = tvs, tcdTyPats = opt_tys,
174 tcdCons = cons, tcdDerivs = mb_derivs }))
175 = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences]
176 ; dec <- addTyVarBinds tvs $ \bndrs ->
177 do { cxt1 <- repLContext cxt
178 ; opt_tys1 <- maybeMapM repLTys opt_tys -- only for family insts
179 ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1
180 ; cons1 <- mapM repC cons
181 ; cons2 <- coreList conQTyConName cons1
182 ; derivs1 <- repDerivs mb_derivs
183 ; bndrs1 <- coreList tyVarBndrTyConName bndrs
184 ; repData cxt1 tc1 bndrs1 opt_tys2 cons2 derivs1
186 ; return $ Just (loc, dec)
189 repTyClD (L loc (TyData { tcdND = NewType, tcdCtxt = cxt,
190 tcdLName = tc, tcdTyVars = tvs, tcdTyPats = opt_tys,
191 tcdCons = [con], tcdDerivs = mb_derivs }))
192 = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences]
193 ; dec <- addTyVarBinds tvs $ \bndrs ->
194 do { cxt1 <- repLContext cxt
195 ; opt_tys1 <- maybeMapM repLTys opt_tys -- only for family insts
196 ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1
198 ; derivs1 <- repDerivs mb_derivs
199 ; bndrs1 <- coreList tyVarBndrTyConName bndrs
200 ; repNewtype cxt1 tc1 bndrs1 opt_tys2 con1 derivs1
202 ; return $ Just (loc, dec)
205 repTyClD (L loc (TySynonym { tcdLName = tc, tcdTyVars = tvs, tcdTyPats = opt_tys,
207 = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences]
208 ; dec <- addTyVarBinds tvs $ \bndrs ->
209 do { opt_tys1 <- maybeMapM repLTys opt_tys -- only for family insts
210 ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1
212 ; bndrs1 <- coreList tyVarBndrTyConName bndrs
213 ; repTySyn tc1 bndrs1 opt_tys2 ty1
215 ; return (Just (loc, dec))
218 repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
219 tcdTyVars = tvs, tcdFDs = fds,
220 tcdSigs = sigs, tcdMeths = meth_binds,
222 = do { cls1 <- lookupLOcc cls -- See note [Binders and occurrences]
223 ; dec <- addTyVarBinds tvs $ \bndrs ->
224 do { cxt1 <- repLContext cxt
225 ; sigs1 <- rep_sigs sigs
226 ; binds1 <- rep_binds meth_binds
227 ; fds1 <- repLFunDeps fds
228 ; ats1 <- repLAssocFamilys ats
229 ; decls1 <- coreList decQTyConName (ats1 ++ sigs1 ++ binds1)
230 ; bndrs1 <- coreList tyVarBndrTyConName bndrs
231 ; repClass cxt1 cls1 bndrs1 fds1 decls1
233 ; return $ Just (loc, dec)
237 repTyClD (L loc d) = putSrcSpanDs loc $
238 do { warnDs (hang ds_msg 4 (ppr d))
241 -- The type variables in the head of families are treated differently when the
242 -- family declaration is associated. In that case, they are usage, not binding
245 repTyFamily :: LTyClDecl Name
246 -> ProcessTyVarBinds TH.Dec
247 -> DsM (Maybe (SrcSpan, Core TH.DecQ))
248 repTyFamily (L loc (TyFamily { tcdFlavour = flavour,
249 tcdLName = tc, tcdTyVars = tvs,
250 tcdKind = opt_kind }))
252 = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences]
253 ; dec <- tyVarBinds tvs $ \bndrs ->
254 do { flav <- repFamilyFlavour flavour
255 ; bndrs1 <- coreList tyVarBndrTyConName bndrs
257 Nothing -> repFamilyNoKind flav tc1 bndrs1
258 Just ki -> do { ki1 <- repKind ki
259 ; repFamilyKind flav tc1 bndrs1 ki1
262 ; return $ Just (loc, dec)
264 repTyFamily _ _ = panic "DsMeta.repTyFamily: internal error"
268 repLFunDeps :: [Located (FunDep Name)] -> DsM (Core [TH.FunDep])
269 repLFunDeps fds = do fds' <- mapM repLFunDep fds
270 fdList <- coreList funDepTyConName fds'
273 repLFunDep :: Located (FunDep Name) -> DsM (Core TH.FunDep)
274 repLFunDep (L _ (xs, ys)) = do xs' <- mapM lookupBinder xs
275 ys' <- mapM lookupBinder ys
276 xs_list <- coreList nameTyConName xs'
277 ys_list <- coreList nameTyConName ys'
278 repFunDep xs_list ys_list
280 -- represent family declaration flavours
282 repFamilyFlavour :: FamilyFlavour -> DsM (Core TH.FamFlavour)
283 repFamilyFlavour TypeFamily = rep2 typeFamName []
284 repFamilyFlavour DataFamily = rep2 dataFamName []
286 -- represent associated family declarations
288 repLAssocFamilys :: [LTyClDecl Name] -> DsM [Core TH.DecQ]
289 repLAssocFamilys = mapM repLAssocFamily
291 repLAssocFamily tydecl@(L _ (TyFamily {}))
292 = liftM (snd . fromJust) $ repTyFamily tydecl lookupTyVarBinds
293 repLAssocFamily tydecl
296 msg = ptext (sLit "Illegal associated declaration in class:") <+>
299 -- represent associated family instances
301 repLAssocFamInst :: [LTyClDecl Name] -> DsM [Core TH.DecQ]
302 repLAssocFamInst = liftM de_loc . mapMaybeM repTyClD
304 -- represent instance declarations
306 repInstD' :: LInstDecl Name -> DsM (SrcSpan, Core TH.DecQ)
307 repInstD' (L loc (InstDecl ty binds _ ats)) -- Ignore user pragmas for now
308 = do { i <- addTyVarBinds tvs $ \_ ->
309 -- We must bring the type variables into scope, so their
310 -- occurrences don't fail, even though the binders don't
311 -- appear in the resulting data structure
312 do { cxt1 <- repContext cxt
313 ; inst_ty1 <- repPredTy (HsClassP cls tys)
314 ; ss <- mkGenSyms (collectHsBindBinders binds)
315 ; binds1 <- addBinds ss (rep_binds binds)
316 ; ats1 <- repLAssocFamInst ats
317 ; decls1 <- coreList decQTyConName (ats1 ++ binds1)
318 ; decls2 <- wrapNongenSyms ss decls1
319 -- wrapNongenSyms: do not clone the class op names!
320 -- They must be called 'op' etc, not 'op34'
321 ; repInst cxt1 inst_ty1 (decls2)
325 (tvs, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
327 repForD :: Located (ForeignDecl Name) -> DsM (SrcSpan, Core TH.DecQ)
328 repForD (L loc (ForeignImport name typ (CImport cc s ch cis)))
329 = do MkC name' <- lookupLOcc name
330 MkC typ' <- repLTy typ
331 MkC cc' <- repCCallConv cc
332 MkC s' <- repSafety s
333 cis' <- conv_cimportspec cis
334 MkC str <- coreStringLit $ static
335 ++ unpackFS ch ++ " "
337 dec <- rep2 forImpDName [cc', s', str, name', typ']
340 conv_cimportspec (CLabel cls) = notHandled "Foreign label" (doubleQuotes (ppr cls))
341 conv_cimportspec (CFunction DynamicTarget) = return "dynamic"
342 conv_cimportspec (CFunction (StaticTarget fs)) = return (unpackFS fs)
343 conv_cimportspec CWrapper = return "wrapper"
345 CFunction (StaticTarget _) -> "static "
347 repForD decl = notHandled "Foreign declaration" (ppr decl)
349 repCCallConv :: CCallConv -> DsM (Core TH.Callconv)
350 repCCallConv CCallConv = rep2 cCallName []
351 repCCallConv StdCallConv = rep2 stdCallName []
352 repCCallConv callConv = notHandled "repCCallConv" (ppr callConv)
354 repSafety :: Safety -> DsM (Core TH.Safety)
355 repSafety PlayRisky = rep2 unsafeName []
356 repSafety (PlaySafe False) = rep2 safeName []
357 repSafety (PlaySafe True) = rep2 threadsafeName []
360 ds_msg = ptext (sLit "Cannot desugar this Template Haskell declaration:")
362 -------------------------------------------------------
364 -------------------------------------------------------
366 repC :: LConDecl Name -> DsM (Core TH.ConQ)
367 repC (L _ (ConDecl { con_name = con, con_qvars = [], con_cxt = L _ []
368 , con_details = details, con_res = ResTyH98 }))
369 = do { con1 <- lookupLOcc con -- See note [Binders and occurrences]
370 ; repConstr con1 details
372 repC (L loc con_decl@(ConDecl { con_qvars = tvs, con_cxt = L cloc ctxt, con_res = ResTyH98 }))
373 = addTyVarBinds tvs $ \bndrs ->
374 do { c' <- repC (L loc (con_decl { con_qvars = [], con_cxt = L cloc [] }))
375 ; ctxt' <- repContext ctxt
376 ; bndrs' <- coreList tyVarBndrTyConName bndrs
377 ; rep2 forallCName [unC bndrs', unC ctxt', unC c']
379 repC (L loc con_decl) -- GADTs
381 notHandled "GADT declaration" (ppr con_decl)
383 repBangTy :: LBangType Name -> DsM (Core (TH.StrictTypeQ))
387 rep2 strictTypeName [s, t]
389 (str, ty') = case ty of
390 L _ (HsBangTy _ ty) -> (isStrictName, ty)
391 _ -> (notStrictName, ty)
393 -------------------------------------------------------
395 -------------------------------------------------------
397 repDerivs :: Maybe [LHsType Name] -> DsM (Core [TH.Name])
398 repDerivs Nothing = coreList nameTyConName []
399 repDerivs (Just ctxt)
400 = do { strs <- mapM rep_deriv ctxt ;
401 coreList nameTyConName strs }
403 rep_deriv :: LHsType Name -> DsM (Core TH.Name)
404 -- Deriving clauses must have the simple H98 form
405 rep_deriv (L _ (HsPredTy (HsClassP cls []))) = lookupOcc cls
406 rep_deriv other = notHandled "Non-H98 deriving clause" (ppr other)
409 -------------------------------------------------------
410 -- Signatures in a class decl, or a group of bindings
411 -------------------------------------------------------
413 rep_sigs :: [LSig Name] -> DsM [Core TH.DecQ]
414 rep_sigs sigs = do locs_cores <- rep_sigs' sigs
415 return $ de_loc $ sort_by_loc locs_cores
417 rep_sigs' :: [LSig Name] -> DsM [(SrcSpan, Core TH.DecQ)]
418 -- We silently ignore ones we don't recognise
419 rep_sigs' sigs = do { sigs1 <- mapM rep_sig sigs ;
420 return (concat sigs1) }
422 rep_sig :: LSig Name -> DsM [(SrcSpan, Core TH.DecQ)]
424 -- Empty => Too hard, signature ignored
425 rep_sig (L loc (TypeSig nm ty)) = rep_proto nm ty loc
426 rep_sig (L loc (InlineSig nm ispec)) = rep_inline nm ispec loc
427 rep_sig (L loc (SpecSig nm ty ispec)) = rep_specialise nm ty ispec loc
428 rep_sig _ = return []
430 rep_proto :: Located Name -> LHsType Name -> SrcSpan
431 -> DsM [(SrcSpan, Core TH.DecQ)]
433 = do { nm1 <- lookupLOcc nm
435 ; sig <- repProto nm1 ty1
436 ; return [(loc, sig)]
439 rep_inline :: Located Name -> InlineSpec -> SrcSpan
440 -> DsM [(SrcSpan, Core TH.DecQ)]
441 rep_inline nm ispec loc
442 = do { nm1 <- lookupLOcc nm
443 ; (_, ispec1) <- rep_InlineSpec ispec
444 ; pragma <- repPragInl nm1 ispec1
445 ; return [(loc, pragma)]
448 rep_specialise :: Located Name -> LHsType Name -> InlineSpec -> SrcSpan
449 -> DsM [(SrcSpan, Core TH.DecQ)]
450 rep_specialise nm ty ispec loc
451 = do { nm1 <- lookupLOcc nm
453 ; (hasSpec, ispec1) <- rep_InlineSpec ispec
454 ; pragma <- if hasSpec
455 then repPragSpecInl nm1 ty1 ispec1
456 else repPragSpec nm1 ty1
457 ; return [(loc, pragma)]
460 -- extract all the information needed to build a TH.InlineSpec
462 rep_InlineSpec :: InlineSpec -> DsM (Bool, Core TH.InlineSpecQ)
463 rep_InlineSpec (Inline (InlinePragma activation match) inline)
464 | Nothing <- activation1
465 = liftM ((,) False) $ repInlineSpecNoPhase inline1 match1
466 | Just (flag, phase) <- activation1
467 = liftM ((,) True) $ repInlineSpecPhase inline1 match1 flag phase
468 | otherwise = {- unreachable, but shuts up -W -} panic "rep_InlineSpec"
470 match1 = coreBool (rep_RuleMatchInfo match)
471 activation1 = rep_Activation activation
472 inline1 = coreBool inline
474 rep_RuleMatchInfo FunLike = False
475 rep_RuleMatchInfo ConLike = True
477 rep_Activation NeverActive = Nothing
478 rep_Activation AlwaysActive = Nothing
479 rep_Activation (ActiveBefore phase) = Just (coreBool False,
480 MkC $ mkIntExprInt phase)
481 rep_Activation (ActiveAfter phase) = Just (coreBool True,
482 MkC $ mkIntExprInt phase)
485 -------------------------------------------------------
487 -------------------------------------------------------
489 -- We process type variable bindings in two ways, either by generating fresh
490 -- names or looking up existing names. The difference is crucial for type
491 -- families, depending on whether they are associated or not.
493 type ProcessTyVarBinds a =
494 [LHsTyVarBndr Name] -- the binders to be added
495 -> ([Core TH.TyVarBndr] -> DsM (Core (TH.Q a))) -- action in the ext env
496 -> DsM (Core (TH.Q a))
498 -- gensym a list of type variables and enter them into the meta environment;
499 -- the computations passed as the second argument is executed in that extended
500 -- meta environment and gets the *new* names on Core-level as an argument
502 addTyVarBinds :: ProcessTyVarBinds a
503 addTyVarBinds tvs m =
505 let names = hsLTyVarNames tvs
506 mkWithKinds = map repTyVarBndrWithKind tvs
507 freshNames <- mkGenSyms names
508 term <- addBinds freshNames $ do
509 bndrs <- mapM lookupBinder names
510 kindedBndrs <- zipWithM ($) mkWithKinds bndrs
512 wrapGenSyns freshNames term
514 -- Look up a list of type variables; the computations passed as the second
515 -- argument gets the *new* names on Core-level as an argument
517 lookupTyVarBinds :: ProcessTyVarBinds a
518 lookupTyVarBinds tvs m =
520 let names = hsLTyVarNames tvs
521 mkWithKinds = map repTyVarBndrWithKind tvs
522 bndrs <- mapM lookupBinder names
523 kindedBndrs <- zipWithM ($) mkWithKinds bndrs
526 -- Produce kinded binder constructors from the Haskell tyvar binders
528 repTyVarBndrWithKind :: LHsTyVarBndr Name
529 -> Core TH.Name -> DsM (Core TH.TyVarBndr)
530 repTyVarBndrWithKind (L _ (UserTyVar _)) = repPlainTV
531 repTyVarBndrWithKind (L _ (KindedTyVar _ ki)) =
532 \nm -> repKind ki >>= repKindedTV nm
534 -- represent a type context
536 repLContext :: LHsContext Name -> DsM (Core TH.CxtQ)
537 repLContext (L _ ctxt) = repContext ctxt
539 repContext :: HsContext Name -> DsM (Core TH.CxtQ)
541 preds <- mapM repLPred ctxt
542 predList <- coreList predQTyConName preds
545 -- represent a type predicate
547 repLPred :: LHsPred Name -> DsM (Core TH.PredQ)
548 repLPred (L _ p) = repPred p
550 repPred :: HsPred Name -> DsM (Core TH.PredQ)
551 repPred (HsClassP cls tys)
553 cls1 <- lookupOcc cls
555 tys2 <- coreList typeQTyConName tys1
557 repPred (HsEqualP tyleft tyright)
559 tyleft1 <- repLTy tyleft
560 tyright1 <- repLTy tyright
561 repEqualP tyleft1 tyright1
562 repPred p@(HsIParam _ _) = notHandled "Implicit parameter constraint" (ppr p)
564 repPredTy :: HsPred Name -> DsM (Core TH.TypeQ)
565 repPredTy (HsClassP cls tys)
567 tcon <- repTy (HsTyVar cls)
570 repPredTy _ = panic "DsMeta.repPredTy: unexpected equality: internal error"
572 -- yield the representation of a list of types
574 repLTys :: [LHsType Name] -> DsM [Core TH.TypeQ]
575 repLTys tys = mapM repLTy tys
579 repLTy :: LHsType Name -> DsM (Core TH.TypeQ)
580 repLTy (L _ ty) = repTy ty
582 repTy :: HsType Name -> DsM (Core TH.TypeQ)
583 repTy (HsForAllTy _ tvs ctxt ty) =
584 addTyVarBinds tvs $ \bndrs -> do
585 ctxt1 <- repLContext ctxt
587 bndrs1 <- coreList tyVarBndrTyConName bndrs
588 repTForall bndrs1 ctxt1 ty1
591 | isTvOcc (nameOccName n) = do
597 repTy (HsAppTy f a) = do
601 repTy (HsFunTy f a) = do
604 tcon <- repArrowTyCon
605 repTapps tcon [f1, a1]
606 repTy (HsListTy t) = do
610 repTy (HsPArrTy t) = do
612 tcon <- repTy (HsTyVar (tyConName parrTyCon))
614 repTy (HsTupleTy _ tys) = do
616 tcon <- repTupleTyCon (length tys)
618 repTy (HsOpTy ty1 n ty2) = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1)
620 repTy (HsParTy t) = repLTy t
621 repTy (HsPredTy pred) = repPredTy pred
622 repTy (HsKindSig t k) = do
626 repTy ty@(HsNumTy _) = notHandled "Number types (for generics)" (ppr ty)
627 repTy ty = notHandled "Exotic form of type" (ppr ty)
631 repKind :: Kind -> DsM (Core TH.Kind)
633 = do { let (kis, ki') = splitKindFunTys ki
634 ; kis_rep <- mapM repKind kis
635 ; ki'_rep <- repNonArrowKind ki'
636 ; foldlM repArrowK ki'_rep kis_rep
639 repNonArrowKind k | isLiftedTypeKind k = repStarK
640 | otherwise = notHandled "Exotic form of kind"
643 -----------------------------------------------------------------------------
645 -----------------------------------------------------------------------------
647 repLEs :: [LHsExpr Name] -> DsM (Core [TH.ExpQ])
648 repLEs es = do { es' <- mapM repLE es ;
649 coreList expQTyConName es' }
651 -- FIXME: some of these panics should be converted into proper error messages
652 -- unless we can make sure that constructs, which are plainly not
653 -- supported in TH already lead to error messages at an earlier stage
654 repLE :: LHsExpr Name -> DsM (Core TH.ExpQ)
655 repLE (L loc e) = putSrcSpanDs loc (repE e)
657 repE :: HsExpr Name -> DsM (Core TH.ExpQ)
659 do { mb_val <- dsLookupMetaEnv x
661 Nothing -> do { str <- globalVar x
662 ; repVarOrCon x str }
663 Just (Bound y) -> repVarOrCon x (coreVar y)
664 Just (Splice e) -> do { e' <- dsExpr e
665 ; return (MkC e') } }
666 repE e@(HsIPVar _) = notHandled "Implicit parameters" (ppr e)
668 -- Remember, we're desugaring renamer output here, so
669 -- HsOverlit can definitely occur
670 repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
671 repE (HsLit l) = do { a <- repLiteral l; repLit a }
672 repE (HsLam (MatchGroup [m] _)) = repLambda m
673 repE (HsApp x y) = do {a <- repLE x; b <- repLE y; repApp a b}
675 repE (OpApp e1 op _ e2) =
676 do { arg1 <- repLE e1;
679 repInfixApp arg1 the_op arg2 }
680 repE (NegApp x _) = do
682 negateVar <- lookupOcc negateName >>= repVar
684 repE (HsPar x) = repLE x
685 repE (SectionL x y) = do { a <- repLE x; b <- repLE y; repSectionL a b }
686 repE (SectionR x y) = do { a <- repLE x; b <- repLE y; repSectionR a b }
687 repE (HsCase e (MatchGroup ms _)) = do { arg <- repLE e
688 ; ms2 <- mapM repMatchTup ms
689 ; repCaseE arg (nonEmptyCoreList ms2) }
690 repE (HsIf x y z) = do
695 repE (HsLet bs e) = do { (ss,ds) <- repBinds bs
696 ; e2 <- addBinds ss (repLE e)
699 -- FIXME: I haven't got the types here right yet
700 repE (HsDo DoExpr sts body _)
701 = do { (ss,zs) <- repLSts sts;
702 body' <- addBinds ss $ repLE body;
703 ret <- repNoBindSt body';
704 e <- repDoE (nonEmptyCoreList (zs ++ [ret]));
706 repE (HsDo ListComp sts body _)
707 = do { (ss,zs) <- repLSts sts;
708 body' <- addBinds ss $ repLE body;
709 ret <- repNoBindSt body';
710 e <- repComp (nonEmptyCoreList (zs ++ [ret]));
712 repE e@(HsDo _ _ _ _) = notHandled "mdo and [: :]" (ppr e)
713 repE (ExplicitList _ es) = do { xs <- repLEs es; repListExp xs }
714 repE e@(ExplicitPArr _ _) = notHandled "Parallel arrays" (ppr e)
715 repE e@(ExplicitTuple es boxed)
716 | isBoxed boxed = do { xs <- repLEs es; repTup xs }
717 | otherwise = notHandled "Unboxed tuples" (ppr e)
718 repE (RecordCon c _ flds)
719 = do { x <- lookupLOcc c;
720 fs <- repFields flds;
722 repE (RecordUpd e flds _ _ _)
724 fs <- repFields flds;
727 repE (ExprWithTySig e ty) = do { e1 <- repLE e; t1 <- repLTy ty; repSigExp e1 t1 }
728 repE (ArithSeq _ aseq) =
730 From e -> do { ds1 <- repLE e; repFrom ds1 }
739 FromThenTo e1 e2 e3 -> do
743 repFromThenTo ds1 ds2 ds3
744 repE (HsSpliceE (HsSplice n _))
745 = do { mb_val <- dsLookupMetaEnv n
747 Just (Splice e) -> do { e' <- dsExpr e
749 _ -> pprPanic "HsSplice" (ppr n) }
750 -- Should not happen; statically checked
752 repE e@(PArrSeq {}) = notHandled "Parallel arrays" (ppr e)
753 repE e@(HsCoreAnn {}) = notHandled "Core annotations" (ppr e)
754 repE e@(HsSCC {}) = notHandled "Cost centres" (ppr e)
755 repE e@(HsTickPragma {}) = notHandled "Tick Pragma" (ppr e)
756 repE e@(HsBracketOut {}) = notHandled "TH brackets" (ppr e)
757 repE e = notHandled "Expression form" (ppr e)
759 -----------------------------------------------------------------------------
760 -- Building representations of auxillary structures like Match, Clause, Stmt,
762 repMatchTup :: LMatch Name -> DsM (Core TH.MatchQ)
763 repMatchTup (L _ (Match [p] _ (GRHSs guards wheres))) =
764 do { ss1 <- mkGenSyms (collectPatBinders p)
765 ; addBinds ss1 $ do {
767 ; (ss2,ds) <- repBinds wheres
768 ; addBinds ss2 $ do {
769 ; gs <- repGuards guards
770 ; match <- repMatch p1 gs ds
771 ; wrapGenSyns (ss1++ss2) match }}}
772 repMatchTup _ = panic "repMatchTup: case alt with more than one arg"
774 repClauseTup :: LMatch Name -> DsM (Core TH.ClauseQ)
775 repClauseTup (L _ (Match ps _ (GRHSs guards wheres))) =
776 do { ss1 <- mkGenSyms (collectPatsBinders ps)
777 ; addBinds ss1 $ do {
779 ; (ss2,ds) <- repBinds wheres
780 ; addBinds ss2 $ do {
781 gs <- repGuards guards
782 ; clause <- repClause ps1 gs ds
783 ; wrapGenSyns (ss1++ss2) clause }}}
785 repGuards :: [LGRHS Name] -> DsM (Core TH.BodyQ)
786 repGuards [L _ (GRHS [] e)]
787 = do {a <- repLE e; repNormal a }
789 = do { zs <- mapM process other;
790 let {(xs, ys) = unzip zs};
791 gd <- repGuarded (nonEmptyCoreList ys);
792 wrapGenSyns (concat xs) gd }
794 process :: LGRHS Name -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp))))
795 process (L _ (GRHS [L _ (ExprStmt e1 _ _)] e2))
796 = do { x <- repLNormalGE e1 e2;
798 process (L _ (GRHS ss rhs))
799 = do (gs, ss') <- repLSts ss
800 rhs' <- addBinds gs $ repLE rhs
801 g <- repPatGE (nonEmptyCoreList ss') rhs'
804 repFields :: HsRecordBinds Name -> DsM (Core [TH.Q TH.FieldExp])
805 repFields (HsRecFields { rec_flds = flds })
806 = do { fnames <- mapM lookupLOcc (map hsRecFieldId flds)
807 ; es <- mapM repLE (map hsRecFieldArg flds)
808 ; fs <- zipWithM repFieldExp fnames es
809 ; coreList fieldExpQTyConName fs }
812 -----------------------------------------------------------------------------
813 -- Representing Stmt's is tricky, especially if bound variables
814 -- shadow each other. Consider: [| do { x <- f 1; x <- f x; g x } |]
815 -- First gensym new names for every variable in any of the patterns.
816 -- both static (x'1 and x'2), and dynamic ((gensym "x") and (gensym "y"))
817 -- if variables didn't shaddow, the static gensym wouldn't be necessary
818 -- and we could reuse the original names (x and x).
820 -- do { x'1 <- gensym "x"
821 -- ; x'2 <- gensym "x"
822 -- ; doE [ BindSt (pvar x'1) [| f 1 |]
823 -- , BindSt (pvar x'2) [| f x |]
824 -- , NoBindSt [| g x |]
828 -- The strategy is to translate a whole list of do-bindings by building a
829 -- bigger environment, and a bigger set of meta bindings
830 -- (like: x'1 <- gensym "x" ) and then combining these with the translations
831 -- of the expressions within the Do
833 -----------------------------------------------------------------------------
834 -- The helper function repSts computes the translation of each sub expression
835 -- and a bunch of prefix bindings denoting the dynamic renaming.
837 repLSts :: [LStmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
838 repLSts stmts = repSts (map unLoc stmts)
840 repSts :: [Stmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
841 repSts (BindStmt p e _ _ : ss) =
843 ; ss1 <- mkGenSyms (collectPatBinders p)
844 ; addBinds ss1 $ do {
846 ; (ss2,zs) <- repSts ss
847 ; z <- repBindSt p1 e2
848 ; return (ss1++ss2, z : zs) }}
849 repSts (LetStmt bs : ss) =
850 do { (ss1,ds) <- repBinds bs
852 ; (ss2,zs) <- addBinds ss1 (repSts ss)
853 ; return (ss1++ss2, z : zs) }
854 repSts (ExprStmt e _ _ : ss) =
856 ; z <- repNoBindSt e2
857 ; (ss2,zs) <- repSts ss
858 ; return (ss2, z : zs) }
859 repSts [] = return ([],[])
860 repSts other = notHandled "Exotic statement" (ppr other)
863 -----------------------------------------------------------
865 -----------------------------------------------------------
867 repBinds :: HsLocalBinds Name -> DsM ([GenSymBind], Core [TH.DecQ])
868 repBinds EmptyLocalBinds
869 = do { core_list <- coreList decQTyConName []
870 ; return ([], core_list) }
872 repBinds b@(HsIPBinds _) = notHandled "Implicit parameters" (ppr b)
874 repBinds (HsValBinds decs)
875 = do { let { bndrs = map unLoc (collectHsValBinders decs) }
876 -- No need to worrry about detailed scopes within
877 -- the binding group, because we are talking Names
878 -- here, so we can safely treat it as a mutually
880 ; ss <- mkGenSyms bndrs
881 ; prs <- addBinds ss (rep_val_binds decs)
882 ; core_list <- coreList decQTyConName
883 (de_loc (sort_by_loc prs))
884 ; return (ss, core_list) }
886 rep_val_binds :: HsValBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
887 -- Assumes: all the binders of the binding are alrady in the meta-env
888 rep_val_binds (ValBindsOut binds sigs)
889 = do { core1 <- rep_binds' (unionManyBags (map snd binds))
890 ; core2 <- rep_sigs' sigs
891 ; return (core1 ++ core2) }
892 rep_val_binds (ValBindsIn _ _)
893 = panic "rep_val_binds: ValBindsIn"
895 rep_binds :: LHsBinds Name -> DsM [Core TH.DecQ]
896 rep_binds binds = do { binds_w_locs <- rep_binds' binds
897 ; return (de_loc (sort_by_loc binds_w_locs)) }
899 rep_binds' :: LHsBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
900 rep_binds' binds = mapM rep_bind (bagToList binds)
902 rep_bind :: LHsBind Name -> DsM (SrcSpan, Core TH.DecQ)
903 -- Assumes: all the binders of the binding are alrady in the meta-env
905 -- Note GHC treats declarations of a variable (not a pattern)
906 -- e.g. x = g 5 as a Fun MonoBinds. This is indicated by a single match
907 -- with an empty list of patterns
908 rep_bind (L loc (FunBind { fun_id = fn,
909 fun_matches = MatchGroup [L _ (Match [] _ (GRHSs guards wheres))] _ }))
910 = do { (ss,wherecore) <- repBinds wheres
911 ; guardcore <- addBinds ss (repGuards guards)
912 ; fn' <- lookupLBinder fn
914 ; ans <- repVal p guardcore wherecore
915 ; ans' <- wrapGenSyns ss ans
916 ; return (loc, ans') }
918 rep_bind (L loc (FunBind { fun_id = fn, fun_matches = MatchGroup ms _ }))
919 = do { ms1 <- mapM repClauseTup ms
920 ; fn' <- lookupLBinder fn
921 ; ans <- repFun fn' (nonEmptyCoreList ms1)
922 ; return (loc, ans) }
924 rep_bind (L loc (PatBind { pat_lhs = pat, pat_rhs = GRHSs guards wheres }))
925 = do { patcore <- repLP pat
926 ; (ss,wherecore) <- repBinds wheres
927 ; guardcore <- addBinds ss (repGuards guards)
928 ; ans <- repVal patcore guardcore wherecore
929 ; ans' <- wrapGenSyns ss ans
930 ; return (loc, ans') }
932 rep_bind (L _ (VarBind { var_id = v, var_rhs = e}))
933 = do { v' <- lookupBinder v
936 ; patcore <- repPvar v'
937 ; empty_decls <- coreList decQTyConName []
938 ; ans <- repVal patcore x empty_decls
939 ; return (srcLocSpan (getSrcLoc v), ans) }
941 rep_bind (L _ (AbsBinds {})) = panic "rep_bind: AbsBinds"
943 -----------------------------------------------------------------------------
944 -- Since everything in a Bind is mutually recursive we need rename all
945 -- all the variables simultaneously. For example:
946 -- [| AndMonoBinds (f x = x + g 2) (g x = f 1 + 2) |] would translate to
947 -- do { f'1 <- gensym "f"
948 -- ; g'2 <- gensym "g"
949 -- ; [ do { x'3 <- gensym "x"; fun f'1 [pvar x'3] [| x + g2 |]},
950 -- do { x'4 <- gensym "x"; fun g'2 [pvar x'4] [| f 1 + 2 |]}
952 -- This requires collecting the bindings (f'1 <- gensym "f"), and the
953 -- environment ( f |-> f'1 ) from each binding, and then unioning them
954 -- together. As we do this we collect GenSymBinds's which represent the renamed
955 -- variables bound by the Bindings. In order not to lose track of these
956 -- representations we build a shadow datatype MB with the same structure as
957 -- MonoBinds, but which has slots for the representations
960 -----------------------------------------------------------------------------
961 -- GHC allows a more general form of lambda abstraction than specified
962 -- by Haskell 98. In particular it allows guarded lambda's like :
963 -- (\ x | even x -> 0 | odd x -> 1) at the moment we can't represent this in
964 -- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like
965 -- (\ p1 .. pn -> exp) by causing an error.
967 repLambda :: LMatch Name -> DsM (Core TH.ExpQ)
968 repLambda (L _ (Match ps _ (GRHSs [L _ (GRHS [] e)] EmptyLocalBinds)))
969 = do { let bndrs = collectPatsBinders ps ;
970 ; ss <- mkGenSyms bndrs
971 ; lam <- addBinds ss (
972 do { xs <- repLPs ps; body <- repLE e; repLam xs body })
973 ; wrapGenSyns ss lam }
975 repLambda (L _ m) = notHandled "Guarded labmdas" (pprMatch (LambdaExpr :: HsMatchContext Name) m)
978 -----------------------------------------------------------------------------
980 -- repP deals with patterns. It assumes that we have already
981 -- walked over the pattern(s) once to collect the binders, and
982 -- have extended the environment. So every pattern-bound
983 -- variable should already appear in the environment.
985 -- Process a list of patterns
986 repLPs :: [LPat Name] -> DsM (Core [TH.PatQ])
987 repLPs ps = do { ps' <- mapM repLP ps ;
988 coreList patQTyConName ps' }
990 repLP :: LPat Name -> DsM (Core TH.PatQ)
991 repLP (L _ p) = repP p
993 repP :: Pat Name -> DsM (Core TH.PatQ)
994 repP (WildPat _) = repPwild
995 repP (LitPat l) = do { l2 <- repLiteral l; repPlit l2 }
996 repP (VarPat x) = do { x' <- lookupBinder x; repPvar x' }
997 repP (LazyPat p) = do { p1 <- repLP p; repPtilde p1 }
998 repP (BangPat p) = do { p1 <- repLP p; repPbang p1 }
999 repP (AsPat x p) = do { x' <- lookupLBinder x; p1 <- repLP p; repPaspat x' p1 }
1000 repP (ParPat p) = repLP p
1001 repP (ListPat ps _) = do { qs <- repLPs ps; repPlist qs }
1002 repP (TuplePat ps _ _) = do { qs <- repLPs ps; repPtup qs }
1003 repP (ConPatIn dc details)
1004 = do { con_str <- lookupLOcc dc
1006 PrefixCon ps -> do { qs <- repLPs ps; repPcon con_str qs }
1007 RecCon rec -> do { let flds = rec_flds rec
1008 ; vs <- sequence $ map lookupLOcc (map hsRecFieldId flds)
1009 ; ps <- sequence $ map repLP (map hsRecFieldArg flds)
1010 ; fps <- zipWithM (\x y -> rep2 fieldPatName [unC x,unC y]) vs ps
1011 ; fps' <- coreList fieldPatQTyConName fps
1012 ; repPrec con_str fps' }
1013 InfixCon p1 p2 -> do { p1' <- repLP p1;
1015 repPinfix p1' con_str p2' }
1017 repP (NPat l Nothing _) = do { a <- repOverloadedLiteral l; repPlit a }
1018 repP p@(NPat _ (Just _) _) = notHandled "Negative overloaded patterns" (ppr p)
1019 repP p@(SigPatIn {}) = notHandled "Type signatures in patterns" (ppr p)
1020 -- The problem is to do with scoped type variables.
1021 -- To implement them, we have to implement the scoping rules
1022 -- here in DsMeta, and I don't want to do that today!
1023 -- do { p' <- repLP p; t' <- repLTy t; repPsig p' t' }
1024 -- repPsig :: Core TH.PatQ -> Core TH.TypeQ -> DsM (Core TH.PatQ)
1025 -- repPsig (MkC p) (MkC t) = rep2 sigPName [p, t]
1027 repP other = notHandled "Exotic pattern" (ppr other)
1029 ----------------------------------------------------------
1030 -- Declaration ordering helpers
1032 sort_by_loc :: [(SrcSpan, a)] -> [(SrcSpan, a)]
1033 sort_by_loc xs = sortBy comp xs
1034 where comp x y = compare (fst x) (fst y)
1036 de_loc :: [(a, b)] -> [b]
1039 ----------------------------------------------------------
1040 -- The meta-environment
1042 -- A name/identifier association for fresh names of locally bound entities
1043 type GenSymBind = (Name, Id) -- Gensym the string and bind it to the Id
1044 -- I.e. (x, x_id) means
1045 -- let x_id = gensym "x" in ...
1047 -- Generate a fresh name for a locally bound entity
1049 mkGenSyms :: [Name] -> DsM [GenSymBind]
1050 -- We can use the existing name. For example:
1051 -- [| \x_77 -> x_77 + x_77 |]
1053 -- do { x_77 <- genSym "x"; .... }
1054 -- We use the same x_77 in the desugared program, but with the type Bndr
1057 -- We do make it an Internal name, though (hence localiseName)
1059 -- Nevertheless, it's monadic because we have to generate nameTy
1060 mkGenSyms ns = do { var_ty <- lookupType nameTyConName
1061 ; return [(nm, mkLocalId (localiseName nm) var_ty) | nm <- ns] }
1064 addBinds :: [GenSymBind] -> DsM a -> DsM a
1065 -- Add a list of fresh names for locally bound entities to the
1066 -- meta environment (which is part of the state carried around
1067 -- by the desugarer monad)
1068 addBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,Bound id) | (n,id) <- bs]) m
1070 -- Look up a locally bound name
1072 lookupLBinder :: Located Name -> DsM (Core TH.Name)
1073 lookupLBinder (L _ n) = lookupBinder n
1075 lookupBinder :: Name -> DsM (Core TH.Name)
1077 = do { mb_val <- dsLookupMetaEnv n;
1079 Just (Bound x) -> return (coreVar x)
1080 _ -> failWithDs msg }
1082 msg = ptext (sLit "DsMeta: failed binder lookup when desugaring a TH bracket:") <+> ppr n
1084 -- Look up a name that is either locally bound or a global name
1086 -- * If it is a global name, generate the "original name" representation (ie,
1087 -- the <module>:<name> form) for the associated entity
1089 lookupLOcc :: Located Name -> DsM (Core TH.Name)
1090 -- Lookup an occurrence; it can't be a splice.
1091 -- Use the in-scope bindings if they exist
1092 lookupLOcc (L _ n) = lookupOcc n
1094 lookupOcc :: Name -> DsM (Core TH.Name)
1096 = do { mb_val <- dsLookupMetaEnv n ;
1098 Nothing -> globalVar n
1099 Just (Bound x) -> return (coreVar x)
1100 Just (Splice _) -> pprPanic "repE:lookupOcc" (ppr n)
1103 lookupTvOcc :: Name -> DsM (Core TH.Name)
1104 -- Type variables can't be staged and are not lexically scoped in TH
1106 = do { mb_val <- dsLookupMetaEnv n ;
1108 Just (Bound x) -> return (coreVar x)
1112 msg = vcat [ ptext (sLit "Illegal lexically-scoped type variable") <+> quotes (ppr n)
1113 , ptext (sLit "Lexically scoped type variables are not supported by Template Haskell") ]
1115 globalVar :: Name -> DsM (Core TH.Name)
1116 -- Not bound by the meta-env
1117 -- Could be top-level; or could be local
1118 -- f x = $(g [| x |])
1119 -- Here the x will be local
1121 | isExternalName name
1122 = do { MkC mod <- coreStringLit name_mod
1123 ; MkC pkg <- coreStringLit name_pkg
1124 ; MkC occ <- occNameLit name
1125 ; rep2 mk_varg [pkg,mod,occ] }
1127 = do { MkC occ <- occNameLit name
1128 ; MkC uni <- coreIntLit (getKey (getUnique name))
1129 ; rep2 mkNameLName [occ,uni] }
1131 mod = ASSERT( isExternalName name) nameModule name
1132 name_mod = moduleNameString (moduleName mod)
1133 name_pkg = packageIdString (modulePackageId mod)
1134 name_occ = nameOccName name
1135 mk_varg | OccName.isDataOcc name_occ = mkNameG_dName
1136 | OccName.isVarOcc name_occ = mkNameG_vName
1137 | OccName.isTcOcc name_occ = mkNameG_tcName
1138 | otherwise = pprPanic "DsMeta.globalVar" (ppr name)
1140 lookupType :: Name -- Name of type constructor (e.g. TH.ExpQ)
1141 -> DsM Type -- The type
1142 lookupType tc_name = do { tc <- dsLookupTyCon tc_name ;
1143 return (mkTyConApp tc []) }
1145 wrapGenSyns :: [GenSymBind]
1146 -> Core (TH.Q a) -> DsM (Core (TH.Q a))
1147 -- wrapGenSyns [(nm1,id1), (nm2,id2)] y
1148 -- --> bindQ (gensym nm1) (\ id1 ->
1149 -- bindQ (gensym nm2 (\ id2 ->
1152 wrapGenSyns binds body@(MkC b)
1153 = do { var_ty <- lookupType nameTyConName
1156 [elt_ty] = tcTyConAppArgs (exprType b)
1157 -- b :: Q a, so we can get the type 'a' by looking at the
1158 -- argument type. NB: this relies on Q being a data/newtype,
1159 -- not a type synonym
1161 go _ [] = return body
1162 go var_ty ((name,id) : binds)
1163 = do { MkC body' <- go var_ty binds
1164 ; lit_str <- occNameLit name
1165 ; gensym_app <- repGensym lit_str
1166 ; repBindQ var_ty elt_ty
1167 gensym_app (MkC (Lam id body')) }
1169 -- Just like wrapGenSym, but don't actually do the gensym
1170 -- Instead use the existing name:
1171 -- let x = "x" in ...
1172 -- Only used for [Decl], and for the class ops in class
1173 -- and instance decls
1174 wrapNongenSyms :: [GenSymBind] -> Core a -> DsM (Core a)
1175 wrapNongenSyms binds (MkC body)
1176 = do { binds' <- mapM do_one binds ;
1177 return (MkC (mkLets binds' body)) }
1180 = do { MkC lit_str <- occNameLit name
1181 ; MkC var <- rep2 mkNameName [lit_str]
1182 ; return (NonRec id var) }
1184 occNameLit :: Name -> DsM (Core String)
1185 occNameLit n = coreStringLit (occNameString (nameOccName n))
1188 -- %*********************************************************************
1190 -- Constructing code
1192 -- %*********************************************************************
1194 -----------------------------------------------------------------------------
1195 -- PHANTOM TYPES for consistency. In order to make sure we do this correct
1196 -- we invent a new datatype which uses phantom types.
1198 newtype Core a = MkC CoreExpr
1199 unC :: Core a -> CoreExpr
1202 rep2 :: Name -> [ CoreExpr ] -> DsM (Core a)
1203 rep2 n xs = do { id <- dsLookupGlobalId n
1204 ; return (MkC (foldl App (Var id) xs)) }
1206 -- Then we make "repConstructors" which use the phantom types for each of the
1207 -- smart constructors of the Meta.Meta datatypes.
1210 -- %*********************************************************************
1212 -- The 'smart constructors'
1214 -- %*********************************************************************
1216 --------------- Patterns -----------------
1217 repPlit :: Core TH.Lit -> DsM (Core TH.PatQ)
1218 repPlit (MkC l) = rep2 litPName [l]
1220 repPvar :: Core TH.Name -> DsM (Core TH.PatQ)
1221 repPvar (MkC s) = rep2 varPName [s]
1223 repPtup :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
1224 repPtup (MkC ps) = rep2 tupPName [ps]
1226 repPcon :: Core TH.Name -> Core [TH.PatQ] -> DsM (Core TH.PatQ)
1227 repPcon (MkC s) (MkC ps) = rep2 conPName [s, ps]
1229 repPrec :: Core TH.Name -> Core [(TH.Name,TH.PatQ)] -> DsM (Core TH.PatQ)
1230 repPrec (MkC c) (MkC rps) = rep2 recPName [c,rps]
1232 repPinfix :: Core TH.PatQ -> Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
1233 repPinfix (MkC p1) (MkC n) (MkC p2) = rep2 infixPName [p1, n, p2]
1235 repPtilde :: Core TH.PatQ -> DsM (Core TH.PatQ)
1236 repPtilde (MkC p) = rep2 tildePName [p]
1238 repPbang :: Core TH.PatQ -> DsM (Core TH.PatQ)
1239 repPbang (MkC p) = rep2 bangPName [p]
1241 repPaspat :: Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
1242 repPaspat (MkC s) (MkC p) = rep2 asPName [s, p]
1244 repPwild :: DsM (Core TH.PatQ)
1245 repPwild = rep2 wildPName []
1247 repPlist :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
1248 repPlist (MkC ps) = rep2 listPName [ps]
1250 --------------- Expressions -----------------
1251 repVarOrCon :: Name -> Core TH.Name -> DsM (Core TH.ExpQ)
1252 repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
1253 | otherwise = repVar str
1255 repVar :: Core TH.Name -> DsM (Core TH.ExpQ)
1256 repVar (MkC s) = rep2 varEName [s]
1258 repCon :: Core TH.Name -> DsM (Core TH.ExpQ)
1259 repCon (MkC s) = rep2 conEName [s]
1261 repLit :: Core TH.Lit -> DsM (Core TH.ExpQ)
1262 repLit (MkC c) = rep2 litEName [c]
1264 repApp :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1265 repApp (MkC x) (MkC y) = rep2 appEName [x,y]
1267 repLam :: Core [TH.PatQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1268 repLam (MkC ps) (MkC e) = rep2 lamEName [ps, e]
1270 repTup :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
1271 repTup (MkC es) = rep2 tupEName [es]
1273 repCond :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1274 repCond (MkC x) (MkC y) (MkC z) = rep2 condEName [x,y,z]
1276 repLetE :: Core [TH.DecQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1277 repLetE (MkC ds) (MkC e) = rep2 letEName [ds, e]
1279 repCaseE :: Core TH.ExpQ -> Core [TH.MatchQ] -> DsM( Core TH.ExpQ)
1280 repCaseE (MkC e) (MkC ms) = rep2 caseEName [e, ms]
1282 repDoE :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
1283 repDoE (MkC ss) = rep2 doEName [ss]
1285 repComp :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
1286 repComp (MkC ss) = rep2 compEName [ss]
1288 repListExp :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
1289 repListExp (MkC es) = rep2 listEName [es]
1291 repSigExp :: Core TH.ExpQ -> Core TH.TypeQ -> DsM (Core TH.ExpQ)
1292 repSigExp (MkC e) (MkC t) = rep2 sigEName [e,t]
1294 repRecCon :: Core TH.Name -> Core [TH.Q TH.FieldExp]-> DsM (Core TH.ExpQ)
1295 repRecCon (MkC c) (MkC fs) = rep2 recConEName [c,fs]
1297 repRecUpd :: Core TH.ExpQ -> Core [TH.Q TH.FieldExp] -> DsM (Core TH.ExpQ)
1298 repRecUpd (MkC e) (MkC fs) = rep2 recUpdEName [e,fs]
1300 repFieldExp :: Core TH.Name -> Core TH.ExpQ -> DsM (Core (TH.Q TH.FieldExp))
1301 repFieldExp (MkC n) (MkC x) = rep2 fieldExpName [n,x]
1303 repInfixApp :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1304 repInfixApp (MkC x) (MkC y) (MkC z) = rep2 infixAppName [x,y,z]
1306 repSectionL :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1307 repSectionL (MkC x) (MkC y) = rep2 sectionLName [x,y]
1309 repSectionR :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1310 repSectionR (MkC x) (MkC y) = rep2 sectionRName [x,y]
1312 ------------ Right hand sides (guarded expressions) ----
1313 repGuarded :: Core [TH.Q (TH.Guard, TH.Exp)] -> DsM (Core TH.BodyQ)
1314 repGuarded (MkC pairs) = rep2 guardedBName [pairs]
1316 repNormal :: Core TH.ExpQ -> DsM (Core TH.BodyQ)
1317 repNormal (MkC e) = rep2 normalBName [e]
1319 ------------ Guards ----
1320 repLNormalGE :: LHsExpr Name -> LHsExpr Name -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1321 repLNormalGE g e = do g' <- repLE g
1325 repNormalGE :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1326 repNormalGE (MkC g) (MkC e) = rep2 normalGEName [g, e]
1328 repPatGE :: Core [TH.StmtQ] -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1329 repPatGE (MkC ss) (MkC e) = rep2 patGEName [ss, e]
1331 ------------- Stmts -------------------
1332 repBindSt :: Core TH.PatQ -> Core TH.ExpQ -> DsM (Core TH.StmtQ)
1333 repBindSt (MkC p) (MkC e) = rep2 bindSName [p,e]
1335 repLetSt :: Core [TH.DecQ] -> DsM (Core TH.StmtQ)
1336 repLetSt (MkC ds) = rep2 letSName [ds]
1338 repNoBindSt :: Core TH.ExpQ -> DsM (Core TH.StmtQ)
1339 repNoBindSt (MkC e) = rep2 noBindSName [e]
1341 -------------- Range (Arithmetic sequences) -----------
1342 repFrom :: Core TH.ExpQ -> DsM (Core TH.ExpQ)
1343 repFrom (MkC x) = rep2 fromEName [x]
1345 repFromThen :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1346 repFromThen (MkC x) (MkC y) = rep2 fromThenEName [x,y]
1348 repFromTo :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1349 repFromTo (MkC x) (MkC y) = rep2 fromToEName [x,y]
1351 repFromThenTo :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1352 repFromThenTo (MkC x) (MkC y) (MkC z) = rep2 fromThenToEName [x,y,z]
1354 ------------ Match and Clause Tuples -----------
1355 repMatch :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.MatchQ)
1356 repMatch (MkC p) (MkC bod) (MkC ds) = rep2 matchName [p, bod, ds]
1358 repClause :: Core [TH.PatQ] -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.ClauseQ)
1359 repClause (MkC ps) (MkC bod) (MkC ds) = rep2 clauseName [ps, bod, ds]
1361 -------------- Dec -----------------------------
1362 repVal :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1363 repVal (MkC p) (MkC b) (MkC ds) = rep2 valDName [p, b, ds]
1365 repFun :: Core TH.Name -> Core [TH.ClauseQ] -> DsM (Core TH.DecQ)
1366 repFun (MkC nm) (MkC b) = rep2 funDName [nm, b]
1368 repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr]
1369 -> Maybe (Core [TH.TypeQ])
1370 -> Core [TH.ConQ] -> Core [TH.Name] -> DsM (Core TH.DecQ)
1371 repData (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC cons) (MkC derivs)
1372 = rep2 dataDName [cxt, nm, tvs, cons, derivs]
1373 repData (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC cons) (MkC derivs)
1374 = rep2 dataInstDName [cxt, nm, tys, cons, derivs]
1376 repNewtype :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr]
1377 -> Maybe (Core [TH.TypeQ])
1378 -> Core TH.ConQ -> Core [TH.Name] -> DsM (Core TH.DecQ)
1379 repNewtype (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC con) (MkC derivs)
1380 = rep2 newtypeDName [cxt, nm, tvs, con, derivs]
1381 repNewtype (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC con) (MkC derivs)
1382 = rep2 newtypeInstDName [cxt, nm, tys, con, derivs]
1384 repTySyn :: Core TH.Name -> Core [TH.TyVarBndr]
1385 -> Maybe (Core [TH.TypeQ])
1386 -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1387 repTySyn (MkC nm) (MkC tvs) Nothing (MkC rhs)
1388 = rep2 tySynDName [nm, tvs, rhs]
1389 repTySyn (MkC nm) (MkC _) (Just (MkC tys)) (MkC rhs)
1390 = rep2 tySynInstDName [nm, tys, rhs]
1392 repInst :: Core TH.CxtQ -> Core TH.TypeQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1393 repInst (MkC cxt) (MkC ty) (MkC ds) = rep2 instanceDName [cxt, ty, ds]
1395 repClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr]
1396 -> Core [TH.FunDep] -> Core [TH.DecQ]
1397 -> DsM (Core TH.DecQ)
1398 repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds)
1399 = rep2 classDName [cxt, cls, tvs, fds, ds]
1401 repPragInl :: Core TH.Name -> Core TH.InlineSpecQ -> DsM (Core TH.DecQ)
1402 repPragInl (MkC nm) (MkC ispec) = rep2 pragInlDName [nm, ispec]
1404 repPragSpec :: Core TH.Name -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1405 repPragSpec (MkC nm) (MkC ty) = rep2 pragSpecDName [nm, ty]
1407 repPragSpecInl :: Core TH.Name -> Core TH.TypeQ -> Core TH.InlineSpecQ
1408 -> DsM (Core TH.DecQ)
1409 repPragSpecInl (MkC nm) (MkC ty) (MkC ispec)
1410 = rep2 pragSpecInlDName [nm, ty, ispec]
1412 repFamilyNoKind :: Core TH.FamFlavour -> Core TH.Name -> Core [TH.TyVarBndr]
1413 -> DsM (Core TH.DecQ)
1414 repFamilyNoKind (MkC flav) (MkC nm) (MkC tvs)
1415 = rep2 familyNoKindDName [flav, nm, tvs]
1417 repFamilyKind :: Core TH.FamFlavour -> Core TH.Name -> Core [TH.TyVarBndr]
1419 -> DsM (Core TH.DecQ)
1420 repFamilyKind (MkC flav) (MkC nm) (MkC tvs) (MkC ki)
1421 = rep2 familyKindDName [flav, nm, tvs, ki]
1423 repInlineSpecNoPhase :: Core Bool -> Core Bool -> DsM (Core TH.InlineSpecQ)
1424 repInlineSpecNoPhase (MkC inline) (MkC conlike)
1425 = rep2 inlineSpecNoPhaseName [inline, conlike]
1427 repInlineSpecPhase :: Core Bool -> Core Bool -> Core Bool -> Core Int
1428 -> DsM (Core TH.InlineSpecQ)
1429 repInlineSpecPhase (MkC inline) (MkC conlike) (MkC beforeFrom) (MkC phase)
1430 = rep2 inlineSpecPhaseName [inline, conlike, beforeFrom, phase]
1432 repFunDep :: Core [TH.Name] -> Core [TH.Name] -> DsM (Core TH.FunDep)
1433 repFunDep (MkC xs) (MkC ys) = rep2 funDepName [xs, ys]
1435 repProto :: Core TH.Name -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1436 repProto (MkC s) (MkC ty) = rep2 sigDName [s, ty]
1438 repCtxt :: Core [TH.PredQ] -> DsM (Core TH.CxtQ)
1439 repCtxt (MkC tys) = rep2 cxtName [tys]
1441 repClassP :: Core TH.Name -> Core [TH.TypeQ] -> DsM (Core TH.PredQ)
1442 repClassP (MkC cla) (MkC tys) = rep2 classPName [cla, tys]
1444 repEqualP :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.PredQ)
1445 repEqualP (MkC ty1) (MkC ty2) = rep2 equalPName [ty1, ty2]
1447 repConstr :: Core TH.Name -> HsConDeclDetails Name
1448 -> DsM (Core TH.ConQ)
1449 repConstr con (PrefixCon ps)
1450 = do arg_tys <- mapM repBangTy ps
1451 arg_tys1 <- coreList strictTypeQTyConName arg_tys
1452 rep2 normalCName [unC con, unC arg_tys1]
1453 repConstr con (RecCon ips)
1454 = do arg_vs <- mapM lookupLOcc (map cd_fld_name ips)
1455 arg_tys <- mapM repBangTy (map cd_fld_type ips)
1456 arg_vtys <- zipWithM (\x y -> rep2 varStrictTypeName [unC x, unC y])
1458 arg_vtys' <- coreList varStrictTypeQTyConName arg_vtys
1459 rep2 recCName [unC con, unC arg_vtys']
1460 repConstr con (InfixCon st1 st2)
1461 = do arg1 <- repBangTy st1
1462 arg2 <- repBangTy st2
1463 rep2 infixCName [unC arg1, unC con, unC arg2]
1465 ------------ Types -------------------
1467 repTForall :: Core [TH.TyVarBndr] -> Core TH.CxtQ -> Core TH.TypeQ
1468 -> DsM (Core TH.TypeQ)
1469 repTForall (MkC tvars) (MkC ctxt) (MkC ty)
1470 = rep2 forallTName [tvars, ctxt, ty]
1472 repTvar :: Core TH.Name -> DsM (Core TH.TypeQ)
1473 repTvar (MkC s) = rep2 varTName [s]
1475 repTapp :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)
1476 repTapp (MkC t1) (MkC t2) = rep2 appTName [t1, t2]
1478 repTapps :: Core TH.TypeQ -> [Core TH.TypeQ] -> DsM (Core TH.TypeQ)
1479 repTapps f [] = return f
1480 repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
1482 repTSig :: Core TH.TypeQ -> Core TH.Kind -> DsM (Core TH.TypeQ)
1483 repTSig (MkC ty) (MkC ki) = rep2 sigTName [ty, ki]
1485 --------- Type constructors --------------
1487 repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
1488 repNamedTyCon (MkC s) = rep2 conTName [s]
1490 repTupleTyCon :: Int -> DsM (Core TH.TypeQ)
1491 -- Note: not Core Int; it's easier to be direct here
1492 repTupleTyCon i = rep2 tupleTName [mkIntExprInt i]
1494 repArrowTyCon :: DsM (Core TH.TypeQ)
1495 repArrowTyCon = rep2 arrowTName []
1497 repListTyCon :: DsM (Core TH.TypeQ)
1498 repListTyCon = rep2 listTName []
1500 ------------ Kinds -------------------
1502 repPlainTV :: Core TH.Name -> DsM (Core TH.TyVarBndr)
1503 repPlainTV (MkC nm) = rep2 plainTVName [nm]
1505 repKindedTV :: Core TH.Name -> Core TH.Kind -> DsM (Core TH.TyVarBndr)
1506 repKindedTV (MkC nm) (MkC ki) = rep2 kindedTVName [nm, ki]
1508 repStarK :: DsM (Core TH.Kind)
1509 repStarK = rep2 starKName []
1511 repArrowK :: Core TH.Kind -> Core TH.Kind -> DsM (Core TH.Kind)
1512 repArrowK (MkC ki1) (MkC ki2) = rep2 arrowKName [ki1, ki2]
1514 ----------------------------------------------------------
1517 repLiteral :: HsLit -> DsM (Core TH.Lit)
1519 = do lit' <- case lit of
1520 HsIntPrim i -> mk_integer i
1521 HsWordPrim w -> mk_integer w
1522 HsInt i -> mk_integer i
1523 HsFloatPrim r -> mk_rational r
1524 HsDoublePrim r -> mk_rational r
1526 lit_expr <- dsLit lit'
1528 Just lit_name -> rep2 lit_name [lit_expr]
1529 Nothing -> notHandled "Exotic literal" (ppr lit)
1531 mb_lit_name = case lit of
1532 HsInteger _ _ -> Just integerLName
1533 HsInt _ -> Just integerLName
1534 HsIntPrim _ -> Just intPrimLName
1535 HsWordPrim _ -> Just wordPrimLName
1536 HsFloatPrim _ -> Just floatPrimLName
1537 HsDoublePrim _ -> Just doublePrimLName
1538 HsChar _ -> Just charLName
1539 HsString _ -> Just stringLName
1540 HsRat _ _ -> Just rationalLName
1543 mk_integer :: Integer -> DsM HsLit
1544 mk_integer i = do integer_ty <- lookupType integerTyConName
1545 return $ HsInteger i integer_ty
1546 mk_rational :: Rational -> DsM HsLit
1547 mk_rational r = do rat_ty <- lookupType rationalTyConName
1548 return $ HsRat r rat_ty
1549 mk_string :: FastString -> DsM HsLit
1550 mk_string s = return $ HsString s
1552 repOverloadedLiteral :: HsOverLit Name -> DsM (Core TH.Lit)
1553 repOverloadedLiteral (OverLit { ol_val = val})
1554 = do { lit <- mk_lit val; repLiteral lit }
1555 -- The type Rational will be in the environment, becuase
1556 -- the smart constructor 'TH.Syntax.rationalL' uses it in its type,
1557 -- and rationalL is sucked in when any TH stuff is used
1559 mk_lit :: OverLitVal -> DsM HsLit
1560 mk_lit (HsIntegral i) = mk_integer i
1561 mk_lit (HsFractional f) = mk_rational f
1562 mk_lit (HsIsString s) = mk_string s
1564 --------------- Miscellaneous -------------------
1566 repGensym :: Core String -> DsM (Core (TH.Q TH.Name))
1567 repGensym (MkC lit_str) = rep2 newNameName [lit_str]
1569 repBindQ :: Type -> Type -- a and b
1570 -> Core (TH.Q a) -> Core (a -> TH.Q b) -> DsM (Core (TH.Q b))
1571 repBindQ ty_a ty_b (MkC x) (MkC y)
1572 = rep2 bindQName [Type ty_a, Type ty_b, x, y]
1574 repSequenceQ :: Type -> Core [TH.Q a] -> DsM (Core (TH.Q [a]))
1575 repSequenceQ ty_a (MkC list)
1576 = rep2 sequenceQName [Type ty_a, list]
1578 ------------ Lists and Tuples -------------------
1579 -- turn a list of patterns into a single pattern matching a list
1581 coreList :: Name -- Of the TyCon of the element type
1582 -> [Core a] -> DsM (Core [a])
1584 = do { elt_ty <- lookupType tc_name; return (coreList' elt_ty es) }
1586 coreList' :: Type -- The element type
1587 -> [Core a] -> Core [a]
1588 coreList' elt_ty es = MkC (mkListExpr elt_ty (map unC es ))
1590 nonEmptyCoreList :: [Core a] -> Core [a]
1591 -- The list must be non-empty so we can get the element type
1592 -- Otherwise use coreList
1593 nonEmptyCoreList [] = panic "coreList: empty argument"
1594 nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs))
1596 coreStringLit :: String -> DsM (Core String)
1597 coreStringLit s = do { z <- mkStringExpr s; return(MkC z) }
1599 ------------ Bool, Literals & Variables -------------------
1601 coreBool :: Bool -> Core Bool
1602 coreBool False = MkC $ mkConApp falseDataCon []
1603 coreBool True = MkC $ mkConApp trueDataCon []
1605 coreIntLit :: Int -> DsM (Core Int)
1606 coreIntLit i = return (MkC (mkIntExprInt i))
1608 coreVar :: Id -> Core TH.Name -- The Id has type Name
1609 coreVar id = MkC (Var id)
1611 ----------------- Failure -----------------------
1612 notHandled :: String -> SDoc -> DsM a
1613 notHandled what doc = failWithDs msg
1615 msg = hang (text what <+> ptext (sLit "not (yet) handled by Template Haskell"))
1619 -- %************************************************************************
1621 -- The known-key names for Template Haskell
1623 -- %************************************************************************
1625 -- To add a name, do three things
1627 -- 1) Allocate a key
1629 -- 3) Add the name to knownKeyNames
1631 templateHaskellNames :: [Name]
1632 -- The names that are implicitly mentioned by ``bracket''
1633 -- Should stay in sync with the import list of DsMeta
1635 templateHaskellNames = [
1636 returnQName, bindQName, sequenceQName, newNameName, liftName,
1637 mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
1640 charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
1641 floatPrimLName, doublePrimLName, rationalLName,
1643 litPName, varPName, tupPName, conPName, tildePName, bangPName, infixPName,
1644 asPName, wildPName, recPName, listPName, sigPName,
1652 varEName, conEName, litEName, appEName, infixEName,
1653 infixAppName, sectionLName, sectionRName, lamEName, tupEName,
1654 condEName, letEName, caseEName, doEName, compEName,
1655 fromEName, fromThenEName, fromToEName, fromThenToEName,
1656 listEName, sigEName, recConEName, recUpdEName,
1660 guardedBName, normalBName,
1662 normalGEName, patGEName,
1664 bindSName, letSName, noBindSName, parSName,
1666 funDName, valDName, dataDName, newtypeDName, tySynDName,
1667 classDName, instanceDName, sigDName, forImpDName,
1668 pragInlDName, pragSpecDName, pragSpecInlDName,
1669 familyNoKindDName, familyKindDName, dataInstDName, newtypeInstDName,
1674 classPName, equalPName,
1676 isStrictName, notStrictName,
1678 normalCName, recCName, infixCName, forallCName,
1684 forallTName, varTName, conTName, appTName,
1685 tupleTName, arrowTName, listTName, sigTName,
1687 plainTVName, kindedTVName,
1689 starKName, arrowKName,
1691 cCallName, stdCallName,
1697 inlineSpecNoPhaseName, inlineSpecPhaseName,
1701 typeFamName, dataFamName,
1704 qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchQTyConName,
1705 clauseQTyConName, expQTyConName, fieldExpTyConName, predTyConName,
1706 stmtQTyConName, decQTyConName, conQTyConName, strictTypeQTyConName,
1707 varStrictTypeQTyConName, typeQTyConName, expTyConName, decTyConName,
1708 typeTyConName, tyVarBndrTyConName, matchTyConName, clauseTyConName,
1709 patQTyConName, fieldPatQTyConName, fieldExpQTyConName, funDepTyConName,
1713 quoteExpName, quotePatName]
1715 thSyn, thLib, qqLib :: Module
1716 thSyn = mkTHModule (fsLit "Language.Haskell.TH.Syntax")
1717 thLib = mkTHModule (fsLit "Language.Haskell.TH.Lib")
1718 qqLib = mkTHModule (fsLit "Language.Haskell.TH.Quote")
1720 mkTHModule :: FastString -> Module
1721 mkTHModule m = mkModule thPackageId (mkModuleNameFS m)
1723 libFun, libTc, thFun, thTc, qqFun :: FastString -> Unique -> Name
1724 libFun = mk_known_key_name OccName.varName thLib
1725 libTc = mk_known_key_name OccName.tcName thLib
1726 thFun = mk_known_key_name OccName.varName thSyn
1727 thTc = mk_known_key_name OccName.tcName thSyn
1728 qqFun = mk_known_key_name OccName.varName qqLib
1730 -------------------- TH.Syntax -----------------------
1731 qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
1732 fieldPatTyConName, expTyConName, decTyConName, typeTyConName,
1733 tyVarBndrTyConName, matchTyConName, clauseTyConName, funDepTyConName,
1734 predTyConName :: Name
1735 qTyConName = thTc (fsLit "Q") qTyConKey
1736 nameTyConName = thTc (fsLit "Name") nameTyConKey
1737 fieldExpTyConName = thTc (fsLit "FieldExp") fieldExpTyConKey
1738 patTyConName = thTc (fsLit "Pat") patTyConKey
1739 fieldPatTyConName = thTc (fsLit "FieldPat") fieldPatTyConKey
1740 expTyConName = thTc (fsLit "Exp") expTyConKey
1741 decTyConName = thTc (fsLit "Dec") decTyConKey
1742 typeTyConName = thTc (fsLit "Type") typeTyConKey
1743 tyVarBndrTyConName= thTc (fsLit "TyVarBndr") tyVarBndrTyConKey
1744 matchTyConName = thTc (fsLit "Match") matchTyConKey
1745 clauseTyConName = thTc (fsLit "Clause") clauseTyConKey
1746 funDepTyConName = thTc (fsLit "FunDep") funDepTyConKey
1747 predTyConName = thTc (fsLit "Pred") predTyConKey
1749 returnQName, bindQName, sequenceQName, newNameName, liftName,
1750 mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName,
1751 mkNameLName, liftStringName :: Name
1752 returnQName = thFun (fsLit "returnQ") returnQIdKey
1753 bindQName = thFun (fsLit "bindQ") bindQIdKey
1754 sequenceQName = thFun (fsLit "sequenceQ") sequenceQIdKey
1755 newNameName = thFun (fsLit "newName") newNameIdKey
1756 liftName = thFun (fsLit "lift") liftIdKey
1757 liftStringName = thFun (fsLit "liftString") liftStringIdKey
1758 mkNameName = thFun (fsLit "mkName") mkNameIdKey
1759 mkNameG_vName = thFun (fsLit "mkNameG_v") mkNameG_vIdKey
1760 mkNameG_dName = thFun (fsLit "mkNameG_d") mkNameG_dIdKey
1761 mkNameG_tcName = thFun (fsLit "mkNameG_tc") mkNameG_tcIdKey
1762 mkNameLName = thFun (fsLit "mkNameL") mkNameLIdKey
1765 -------------------- TH.Lib -----------------------
1767 charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
1768 floatPrimLName, doublePrimLName, rationalLName :: Name
1769 charLName = libFun (fsLit "charL") charLIdKey
1770 stringLName = libFun (fsLit "stringL") stringLIdKey
1771 integerLName = libFun (fsLit "integerL") integerLIdKey
1772 intPrimLName = libFun (fsLit "intPrimL") intPrimLIdKey
1773 wordPrimLName = libFun (fsLit "wordPrimL") wordPrimLIdKey
1774 floatPrimLName = libFun (fsLit "floatPrimL") floatPrimLIdKey
1775 doublePrimLName = libFun (fsLit "doublePrimL") doublePrimLIdKey
1776 rationalLName = libFun (fsLit "rationalL") rationalLIdKey
1779 litPName, varPName, tupPName, conPName, infixPName, tildePName, bangPName,
1780 asPName, wildPName, recPName, listPName, sigPName :: Name
1781 litPName = libFun (fsLit "litP") litPIdKey
1782 varPName = libFun (fsLit "varP") varPIdKey
1783 tupPName = libFun (fsLit "tupP") tupPIdKey
1784 conPName = libFun (fsLit "conP") conPIdKey
1785 infixPName = libFun (fsLit "infixP") infixPIdKey
1786 tildePName = libFun (fsLit "tildeP") tildePIdKey
1787 bangPName = libFun (fsLit "bangP") bangPIdKey
1788 asPName = libFun (fsLit "asP") asPIdKey
1789 wildPName = libFun (fsLit "wildP") wildPIdKey
1790 recPName = libFun (fsLit "recP") recPIdKey
1791 listPName = libFun (fsLit "listP") listPIdKey
1792 sigPName = libFun (fsLit "sigP") sigPIdKey
1794 -- type FieldPat = ...
1795 fieldPatName :: Name
1796 fieldPatName = libFun (fsLit "fieldPat") fieldPatIdKey
1800 matchName = libFun (fsLit "match") matchIdKey
1802 -- data Clause = ...
1804 clauseName = libFun (fsLit "clause") clauseIdKey
1807 varEName, conEName, litEName, appEName, infixEName, infixAppName,
1808 sectionLName, sectionRName, lamEName, tupEName, condEName,
1809 letEName, caseEName, doEName, compEName :: Name
1810 varEName = libFun (fsLit "varE") varEIdKey
1811 conEName = libFun (fsLit "conE") conEIdKey
1812 litEName = libFun (fsLit "litE") litEIdKey
1813 appEName = libFun (fsLit "appE") appEIdKey
1814 infixEName = libFun (fsLit "infixE") infixEIdKey
1815 infixAppName = libFun (fsLit "infixApp") infixAppIdKey
1816 sectionLName = libFun (fsLit "sectionL") sectionLIdKey
1817 sectionRName = libFun (fsLit "sectionR") sectionRIdKey
1818 lamEName = libFun (fsLit "lamE") lamEIdKey
1819 tupEName = libFun (fsLit "tupE") tupEIdKey
1820 condEName = libFun (fsLit "condE") condEIdKey
1821 letEName = libFun (fsLit "letE") letEIdKey
1822 caseEName = libFun (fsLit "caseE") caseEIdKey
1823 doEName = libFun (fsLit "doE") doEIdKey
1824 compEName = libFun (fsLit "compE") compEIdKey
1825 -- ArithSeq skips a level
1826 fromEName, fromThenEName, fromToEName, fromThenToEName :: Name
1827 fromEName = libFun (fsLit "fromE") fromEIdKey
1828 fromThenEName = libFun (fsLit "fromThenE") fromThenEIdKey
1829 fromToEName = libFun (fsLit "fromToE") fromToEIdKey
1830 fromThenToEName = libFun (fsLit "fromThenToE") fromThenToEIdKey
1832 listEName, sigEName, recConEName, recUpdEName :: Name
1833 listEName = libFun (fsLit "listE") listEIdKey
1834 sigEName = libFun (fsLit "sigE") sigEIdKey
1835 recConEName = libFun (fsLit "recConE") recConEIdKey
1836 recUpdEName = libFun (fsLit "recUpdE") recUpdEIdKey
1838 -- type FieldExp = ...
1839 fieldExpName :: Name
1840 fieldExpName = libFun (fsLit "fieldExp") fieldExpIdKey
1843 guardedBName, normalBName :: Name
1844 guardedBName = libFun (fsLit "guardedB") guardedBIdKey
1845 normalBName = libFun (fsLit "normalB") normalBIdKey
1848 normalGEName, patGEName :: Name
1849 normalGEName = libFun (fsLit "normalGE") normalGEIdKey
1850 patGEName = libFun (fsLit "patGE") patGEIdKey
1853 bindSName, letSName, noBindSName, parSName :: Name
1854 bindSName = libFun (fsLit "bindS") bindSIdKey
1855 letSName = libFun (fsLit "letS") letSIdKey
1856 noBindSName = libFun (fsLit "noBindS") noBindSIdKey
1857 parSName = libFun (fsLit "parS") parSIdKey
1860 funDName, valDName, dataDName, newtypeDName, tySynDName, classDName,
1861 instanceDName, sigDName, forImpDName, pragInlDName, pragSpecDName,
1862 pragSpecInlDName, familyNoKindDName, familyKindDName, dataInstDName,
1863 newtypeInstDName, tySynInstDName :: Name
1864 funDName = libFun (fsLit "funD") funDIdKey
1865 valDName = libFun (fsLit "valD") valDIdKey
1866 dataDName = libFun (fsLit "dataD") dataDIdKey
1867 newtypeDName = libFun (fsLit "newtypeD") newtypeDIdKey
1868 tySynDName = libFun (fsLit "tySynD") tySynDIdKey
1869 classDName = libFun (fsLit "classD") classDIdKey
1870 instanceDName = libFun (fsLit "instanceD") instanceDIdKey
1871 sigDName = libFun (fsLit "sigD") sigDIdKey
1872 forImpDName = libFun (fsLit "forImpD") forImpDIdKey
1873 pragInlDName = libFun (fsLit "pragInlD") pragInlDIdKey
1874 pragSpecDName = libFun (fsLit "pragSpecD") pragSpecDIdKey
1875 pragSpecInlDName = libFun (fsLit "pragSpecInlD") pragSpecInlDIdKey
1876 familyNoKindDName= libFun (fsLit "familyNoKindD")familyNoKindDIdKey
1877 familyKindDName = libFun (fsLit "familyKindD") familyKindDIdKey
1878 dataInstDName = libFun (fsLit "dataInstD") dataInstDIdKey
1879 newtypeInstDName = libFun (fsLit "newtypeInstD") newtypeInstDIdKey
1880 tySynInstDName = libFun (fsLit "tySynInstD") tySynInstDIdKey
1884 cxtName = libFun (fsLit "cxt") cxtIdKey
1887 classPName, equalPName :: Name
1888 classPName = libFun (fsLit "classP") classPIdKey
1889 equalPName = libFun (fsLit "equalP") equalPIdKey
1891 -- data Strict = ...
1892 isStrictName, notStrictName :: Name
1893 isStrictName = libFun (fsLit "isStrict") isStrictKey
1894 notStrictName = libFun (fsLit "notStrict") notStrictKey
1897 normalCName, recCName, infixCName, forallCName :: Name
1898 normalCName = libFun (fsLit "normalC") normalCIdKey
1899 recCName = libFun (fsLit "recC") recCIdKey
1900 infixCName = libFun (fsLit "infixC") infixCIdKey
1901 forallCName = libFun (fsLit "forallC") forallCIdKey
1903 -- type StrictType = ...
1904 strictTypeName :: Name
1905 strictTypeName = libFun (fsLit "strictType") strictTKey
1907 -- type VarStrictType = ...
1908 varStrictTypeName :: Name
1909 varStrictTypeName = libFun (fsLit "varStrictType") varStrictTKey
1912 forallTName, varTName, conTName, tupleTName, arrowTName,
1913 listTName, appTName, sigTName :: Name
1914 forallTName = libFun (fsLit "forallT") forallTIdKey
1915 varTName = libFun (fsLit "varT") varTIdKey
1916 conTName = libFun (fsLit "conT") conTIdKey
1917 tupleTName = libFun (fsLit "tupleT") tupleTIdKey
1918 arrowTName = libFun (fsLit "arrowT") arrowTIdKey
1919 listTName = libFun (fsLit "listT") listTIdKey
1920 appTName = libFun (fsLit "appT") appTIdKey
1921 sigTName = libFun (fsLit "sigT") sigTIdKey
1923 -- data TyVarBndr = ...
1924 plainTVName, kindedTVName :: Name
1925 plainTVName = libFun (fsLit "plainTV") plainTVIdKey
1926 kindedTVName = libFun (fsLit "kindedTV") kindedTVIdKey
1929 starKName, arrowKName :: Name
1930 starKName = libFun (fsLit "starK") starKIdKey
1931 arrowKName = libFun (fsLit "arrowK") arrowKIdKey
1933 -- data Callconv = ...
1934 cCallName, stdCallName :: Name
1935 cCallName = libFun (fsLit "cCall") cCallIdKey
1936 stdCallName = libFun (fsLit "stdCall") stdCallIdKey
1938 -- data Safety = ...
1939 unsafeName, safeName, threadsafeName :: Name
1940 unsafeName = libFun (fsLit "unsafe") unsafeIdKey
1941 safeName = libFun (fsLit "safe") safeIdKey
1942 threadsafeName = libFun (fsLit "threadsafe") threadsafeIdKey
1944 -- data InlineSpec = ...
1945 inlineSpecNoPhaseName, inlineSpecPhaseName :: Name
1946 inlineSpecNoPhaseName = libFun (fsLit "inlineSpecNoPhase") inlineSpecNoPhaseIdKey
1947 inlineSpecPhaseName = libFun (fsLit "inlineSpecPhase") inlineSpecPhaseIdKey
1949 -- data FunDep = ...
1951 funDepName = libFun (fsLit "funDep") funDepIdKey
1953 -- data FamFlavour = ...
1954 typeFamName, dataFamName :: Name
1955 typeFamName = libFun (fsLit "typeFam") typeFamIdKey
1956 dataFamName = libFun (fsLit "dataFam") dataFamIdKey
1958 matchQTyConName, clauseQTyConName, expQTyConName, stmtQTyConName,
1959 decQTyConName, conQTyConName, strictTypeQTyConName,
1960 varStrictTypeQTyConName, typeQTyConName, fieldExpQTyConName,
1961 patQTyConName, fieldPatQTyConName, predQTyConName :: Name
1962 matchQTyConName = libTc (fsLit "MatchQ") matchQTyConKey
1963 clauseQTyConName = libTc (fsLit "ClauseQ") clauseQTyConKey
1964 expQTyConName = libTc (fsLit "ExpQ") expQTyConKey
1965 stmtQTyConName = libTc (fsLit "StmtQ") stmtQTyConKey
1966 decQTyConName = libTc (fsLit "DecQ") decQTyConKey
1967 conQTyConName = libTc (fsLit "ConQ") conQTyConKey
1968 strictTypeQTyConName = libTc (fsLit "StrictTypeQ") strictTypeQTyConKey
1969 varStrictTypeQTyConName = libTc (fsLit "VarStrictTypeQ") varStrictTypeQTyConKey
1970 typeQTyConName = libTc (fsLit "TypeQ") typeQTyConKey
1971 fieldExpQTyConName = libTc (fsLit "FieldExpQ") fieldExpQTyConKey
1972 patQTyConName = libTc (fsLit "PatQ") patQTyConKey
1973 fieldPatQTyConName = libTc (fsLit "FieldPatQ") fieldPatQTyConKey
1974 predQTyConName = libTc (fsLit "PredQ") predQTyConKey
1977 quoteExpName, quotePatName :: Name
1978 quoteExpName = qqFun (fsLit "quoteExp") quoteExpKey
1979 quotePatName = qqFun (fsLit "quotePat") quotePatKey
1981 -- TyConUniques available: 100-129
1982 -- Check in PrelNames if you want to change this
1984 expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,
1985 decQTyConKey, patTyConKey, matchQTyConKey, clauseQTyConKey,
1986 stmtQTyConKey, conQTyConKey, typeQTyConKey, typeTyConKey, tyVarBndrTyConKey,
1987 decTyConKey, varStrictTypeQTyConKey, strictTypeQTyConKey,
1988 fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey,
1989 fieldPatQTyConKey, fieldExpQTyConKey, funDepTyConKey, predTyConKey,
1990 predQTyConKey :: Unique
1991 expTyConKey = mkPreludeTyConUnique 100
1992 matchTyConKey = mkPreludeTyConUnique 101
1993 clauseTyConKey = mkPreludeTyConUnique 102
1994 qTyConKey = mkPreludeTyConUnique 103
1995 expQTyConKey = mkPreludeTyConUnique 104
1996 decQTyConKey = mkPreludeTyConUnique 105
1997 patTyConKey = mkPreludeTyConUnique 106
1998 matchQTyConKey = mkPreludeTyConUnique 107
1999 clauseQTyConKey = mkPreludeTyConUnique 108
2000 stmtQTyConKey = mkPreludeTyConUnique 109
2001 conQTyConKey = mkPreludeTyConUnique 110
2002 typeQTyConKey = mkPreludeTyConUnique 111
2003 typeTyConKey = mkPreludeTyConUnique 112
2004 tyVarBndrTyConKey = mkPreludeTyConUnique 125
2005 decTyConKey = mkPreludeTyConUnique 113
2006 varStrictTypeQTyConKey = mkPreludeTyConUnique 114
2007 strictTypeQTyConKey = mkPreludeTyConUnique 115
2008 fieldExpTyConKey = mkPreludeTyConUnique 116
2009 fieldPatTyConKey = mkPreludeTyConUnique 117
2010 nameTyConKey = mkPreludeTyConUnique 118
2011 patQTyConKey = mkPreludeTyConUnique 119
2012 fieldPatQTyConKey = mkPreludeTyConUnique 120
2013 fieldExpQTyConKey = mkPreludeTyConUnique 121
2014 funDepTyConKey = mkPreludeTyConUnique 122
2015 predTyConKey = mkPreludeTyConUnique 123
2016 predQTyConKey = mkPreludeTyConUnique 124
2018 -- IdUniques available: 200-399
2019 -- If you want to change this, make sure you check in PrelNames
2021 returnQIdKey, bindQIdKey, sequenceQIdKey, liftIdKey, newNameIdKey,
2022 mkNameIdKey, mkNameG_vIdKey, mkNameG_dIdKey, mkNameG_tcIdKey,
2023 mkNameLIdKey :: Unique
2024 returnQIdKey = mkPreludeMiscIdUnique 200
2025 bindQIdKey = mkPreludeMiscIdUnique 201
2026 sequenceQIdKey = mkPreludeMiscIdUnique 202
2027 liftIdKey = mkPreludeMiscIdUnique 203
2028 newNameIdKey = mkPreludeMiscIdUnique 204
2029 mkNameIdKey = mkPreludeMiscIdUnique 205
2030 mkNameG_vIdKey = mkPreludeMiscIdUnique 206
2031 mkNameG_dIdKey = mkPreludeMiscIdUnique 207
2032 mkNameG_tcIdKey = mkPreludeMiscIdUnique 208
2033 mkNameLIdKey = mkPreludeMiscIdUnique 209
2037 charLIdKey, stringLIdKey, integerLIdKey, intPrimLIdKey, wordPrimLIdKey,
2038 floatPrimLIdKey, doublePrimLIdKey, rationalLIdKey :: Unique
2039 charLIdKey = mkPreludeMiscIdUnique 210
2040 stringLIdKey = mkPreludeMiscIdUnique 211
2041 integerLIdKey = mkPreludeMiscIdUnique 212
2042 intPrimLIdKey = mkPreludeMiscIdUnique 213
2043 wordPrimLIdKey = mkPreludeMiscIdUnique 214
2044 floatPrimLIdKey = mkPreludeMiscIdUnique 215
2045 doublePrimLIdKey = mkPreludeMiscIdUnique 216
2046 rationalLIdKey = mkPreludeMiscIdUnique 217
2048 liftStringIdKey :: Unique
2049 liftStringIdKey = mkPreludeMiscIdUnique 218
2052 litPIdKey, varPIdKey, tupPIdKey, conPIdKey, infixPIdKey, tildePIdKey, bangPIdKey,
2053 asPIdKey, wildPIdKey, recPIdKey, listPIdKey, sigPIdKey :: Unique
2054 litPIdKey = mkPreludeMiscIdUnique 220
2055 varPIdKey = mkPreludeMiscIdUnique 221
2056 tupPIdKey = mkPreludeMiscIdUnique 222
2057 conPIdKey = mkPreludeMiscIdUnique 223
2058 infixPIdKey = mkPreludeMiscIdUnique 312
2059 tildePIdKey = mkPreludeMiscIdUnique 224
2060 bangPIdKey = mkPreludeMiscIdUnique 359
2061 asPIdKey = mkPreludeMiscIdUnique 225
2062 wildPIdKey = mkPreludeMiscIdUnique 226
2063 recPIdKey = mkPreludeMiscIdUnique 227
2064 listPIdKey = mkPreludeMiscIdUnique 228
2065 sigPIdKey = mkPreludeMiscIdUnique 229
2067 -- type FieldPat = ...
2068 fieldPatIdKey :: Unique
2069 fieldPatIdKey = mkPreludeMiscIdUnique 230
2072 matchIdKey :: Unique
2073 matchIdKey = mkPreludeMiscIdUnique 231
2075 -- data Clause = ...
2076 clauseIdKey :: Unique
2077 clauseIdKey = mkPreludeMiscIdUnique 232
2081 varEIdKey, conEIdKey, litEIdKey, appEIdKey, infixEIdKey, infixAppIdKey,
2082 sectionLIdKey, sectionRIdKey, lamEIdKey, tupEIdKey, condEIdKey,
2083 letEIdKey, caseEIdKey, doEIdKey, compEIdKey,
2084 fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey,
2085 listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey :: Unique
2086 varEIdKey = mkPreludeMiscIdUnique 240
2087 conEIdKey = mkPreludeMiscIdUnique 241
2088 litEIdKey = mkPreludeMiscIdUnique 242
2089 appEIdKey = mkPreludeMiscIdUnique 243
2090 infixEIdKey = mkPreludeMiscIdUnique 244
2091 infixAppIdKey = mkPreludeMiscIdUnique 245
2092 sectionLIdKey = mkPreludeMiscIdUnique 246
2093 sectionRIdKey = mkPreludeMiscIdUnique 247
2094 lamEIdKey = mkPreludeMiscIdUnique 248
2095 tupEIdKey = mkPreludeMiscIdUnique 249
2096 condEIdKey = mkPreludeMiscIdUnique 250
2097 letEIdKey = mkPreludeMiscIdUnique 251
2098 caseEIdKey = mkPreludeMiscIdUnique 252
2099 doEIdKey = mkPreludeMiscIdUnique 253
2100 compEIdKey = mkPreludeMiscIdUnique 254
2101 fromEIdKey = mkPreludeMiscIdUnique 255
2102 fromThenEIdKey = mkPreludeMiscIdUnique 256
2103 fromToEIdKey = mkPreludeMiscIdUnique 257
2104 fromThenToEIdKey = mkPreludeMiscIdUnique 258
2105 listEIdKey = mkPreludeMiscIdUnique 259
2106 sigEIdKey = mkPreludeMiscIdUnique 260
2107 recConEIdKey = mkPreludeMiscIdUnique 261
2108 recUpdEIdKey = mkPreludeMiscIdUnique 262
2110 -- type FieldExp = ...
2111 fieldExpIdKey :: Unique
2112 fieldExpIdKey = mkPreludeMiscIdUnique 265
2115 guardedBIdKey, normalBIdKey :: Unique
2116 guardedBIdKey = mkPreludeMiscIdUnique 266
2117 normalBIdKey = mkPreludeMiscIdUnique 267
2120 normalGEIdKey, patGEIdKey :: Unique
2121 normalGEIdKey = mkPreludeMiscIdUnique 310
2122 patGEIdKey = mkPreludeMiscIdUnique 311
2125 bindSIdKey, letSIdKey, noBindSIdKey, parSIdKey :: Unique
2126 bindSIdKey = mkPreludeMiscIdUnique 268
2127 letSIdKey = mkPreludeMiscIdUnique 269
2128 noBindSIdKey = mkPreludeMiscIdUnique 270
2129 parSIdKey = mkPreludeMiscIdUnique 271
2132 funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey,
2133 classDIdKey, instanceDIdKey, sigDIdKey, forImpDIdKey, pragInlDIdKey,
2134 pragSpecDIdKey, pragSpecInlDIdKey, familyNoKindDIdKey, familyKindDIdKey,
2135 dataInstDIdKey, newtypeInstDIdKey, tySynInstDIdKey :: Unique
2136 funDIdKey = mkPreludeMiscIdUnique 272
2137 valDIdKey = mkPreludeMiscIdUnique 273
2138 dataDIdKey = mkPreludeMiscIdUnique 274
2139 newtypeDIdKey = mkPreludeMiscIdUnique 275
2140 tySynDIdKey = mkPreludeMiscIdUnique 276
2141 classDIdKey = mkPreludeMiscIdUnique 277
2142 instanceDIdKey = mkPreludeMiscIdUnique 278
2143 sigDIdKey = mkPreludeMiscIdUnique 279
2144 forImpDIdKey = mkPreludeMiscIdUnique 297
2145 pragInlDIdKey = mkPreludeMiscIdUnique 348
2146 pragSpecDIdKey = mkPreludeMiscIdUnique 349
2147 pragSpecInlDIdKey = mkPreludeMiscIdUnique 352
2148 familyNoKindDIdKey= mkPreludeMiscIdUnique 340
2149 familyKindDIdKey = mkPreludeMiscIdUnique 353
2150 dataInstDIdKey = mkPreludeMiscIdUnique 341
2151 newtypeInstDIdKey = mkPreludeMiscIdUnique 342
2152 tySynInstDIdKey = mkPreludeMiscIdUnique 343
2156 cxtIdKey = mkPreludeMiscIdUnique 280
2159 classPIdKey, equalPIdKey :: Unique
2160 classPIdKey = mkPreludeMiscIdUnique 346
2161 equalPIdKey = mkPreludeMiscIdUnique 347
2163 -- data Strict = ...
2164 isStrictKey, notStrictKey :: Unique
2165 isStrictKey = mkPreludeMiscIdUnique 281
2166 notStrictKey = mkPreludeMiscIdUnique 282
2169 normalCIdKey, recCIdKey, infixCIdKey, forallCIdKey :: Unique
2170 normalCIdKey = mkPreludeMiscIdUnique 283
2171 recCIdKey = mkPreludeMiscIdUnique 284
2172 infixCIdKey = mkPreludeMiscIdUnique 285
2173 forallCIdKey = mkPreludeMiscIdUnique 288
2175 -- type StrictType = ...
2176 strictTKey :: Unique
2177 strictTKey = mkPreludeMiscIdUnique 286
2179 -- type VarStrictType = ...
2180 varStrictTKey :: Unique
2181 varStrictTKey = mkPreludeMiscIdUnique 287
2184 forallTIdKey, varTIdKey, conTIdKey, tupleTIdKey, arrowTIdKey,
2185 listTIdKey, appTIdKey, sigTIdKey :: Unique
2186 forallTIdKey = mkPreludeMiscIdUnique 290
2187 varTIdKey = mkPreludeMiscIdUnique 291
2188 conTIdKey = mkPreludeMiscIdUnique 292
2189 tupleTIdKey = mkPreludeMiscIdUnique 294
2190 arrowTIdKey = mkPreludeMiscIdUnique 295
2191 listTIdKey = mkPreludeMiscIdUnique 296
2192 appTIdKey = mkPreludeMiscIdUnique 293
2193 sigTIdKey = mkPreludeMiscIdUnique 358
2195 -- data TyVarBndr = ...
2196 plainTVIdKey, kindedTVIdKey :: Unique
2197 plainTVIdKey = mkPreludeMiscIdUnique 354
2198 kindedTVIdKey = mkPreludeMiscIdUnique 355
2201 starKIdKey, arrowKIdKey :: Unique
2202 starKIdKey = mkPreludeMiscIdUnique 356
2203 arrowKIdKey = mkPreludeMiscIdUnique 357
2205 -- data Callconv = ...
2206 cCallIdKey, stdCallIdKey :: Unique
2207 cCallIdKey = mkPreludeMiscIdUnique 300
2208 stdCallIdKey = mkPreludeMiscIdUnique 301
2210 -- data Safety = ...
2211 unsafeIdKey, safeIdKey, threadsafeIdKey :: Unique
2212 unsafeIdKey = mkPreludeMiscIdUnique 305
2213 safeIdKey = mkPreludeMiscIdUnique 306
2214 threadsafeIdKey = mkPreludeMiscIdUnique 307
2216 -- data InlineSpec =
2217 inlineSpecNoPhaseIdKey, inlineSpecPhaseIdKey :: Unique
2218 inlineSpecNoPhaseIdKey = mkPreludeMiscIdUnique 350
2219 inlineSpecPhaseIdKey = mkPreludeMiscIdUnique 351
2221 -- data FunDep = ...
2222 funDepIdKey :: Unique
2223 funDepIdKey = mkPreludeMiscIdUnique 320
2225 -- data FamFlavour = ...
2226 typeFamIdKey, dataFamIdKey :: Unique
2227 typeFamIdKey = mkPreludeMiscIdUnique 344
2228 dataFamIdKey = mkPreludeMiscIdUnique 345
2231 quoteExpKey, quotePatKey :: Unique
2232 quoteExpKey = mkPreludeMiscIdUnique 321
2233 quotePatKey = mkPreludeMiscIdUnique 322