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 )
30 import qualified Language.Haskell.TH as TH
35 -- To avoid clashes with DsMeta.varName we must make a local alias for
36 -- OccName.varName we do this by removing varName from the import of
37 -- OccName above, making a qualified instance of OccName and using
38 -- OccNameAlias.varName where varName ws previously used in this file.
39 import qualified OccName
64 -----------------------------------------------------------------------------
65 dsBracket :: HsBracket Name -> [PendingSplice] -> DsM CoreExpr
66 -- Returns a CoreExpr of type TH.ExpQ
67 -- The quoted thing is parameterised over Name, even though it has
68 -- been type checked. We don't want all those type decorations!
70 dsBracket brack splices
71 = dsExtendMetaEnv new_bit (do_brack brack)
73 new_bit = mkNameEnv [(n, Splice (unLoc e)) | (n,e) <- splices]
75 do_brack (VarBr n) = do { MkC e1 <- lookupOcc n ; return e1 }
76 do_brack (ExpBr e) = do { MkC e1 <- repLE e ; return e1 }
77 do_brack (PatBr p) = do { MkC p1 <- repLP p ; return p1 }
78 do_brack (TypBr t) = do { MkC t1 <- repLTy t ; return t1 }
79 do_brack (DecBr ds) = do { MkC ds1 <- repTopDs ds ; return ds1 }
81 {- -------------- Examples --------------------
85 gensym (unpackString "x"#) `bindQ` \ x1::String ->
86 lam (pvar x1) (var x1)
89 [| \x -> $(f [| x |]) |]
91 gensym (unpackString "x"#) `bindQ` \ x1::String ->
92 lam (pvar x1) (f (var x1))
96 -------------------------------------------------------
98 -------------------------------------------------------
100 repTopDs :: HsGroup Name -> DsM (Core (TH.Q [TH.Dec]))
102 = do { let { bndrs = map unLoc (groupBinders group) } ;
103 ss <- mkGenSyms bndrs ;
105 -- Bind all the names mainly to avoid repeated use of explicit strings.
107 -- do { t :: String <- genSym "T" ;
108 -- return (Data t [] ...more t's... }
109 -- The other important reason is that the output must mention
110 -- only "T", not "Foo:T" where Foo is the current module
113 decls <- addBinds ss (do {
114 val_ds <- rep_val_binds (hs_valds group) ;
115 tycl_ds <- mapM repTyClD (hs_tyclds group) ;
116 inst_ds <- mapM repInstD' (hs_instds group) ;
117 for_ds <- mapM repForD (hs_fords group) ;
119 return (de_loc $ sort_by_loc $ val_ds ++ catMaybes tycl_ds ++ inst_ds ++ for_ds) }) ;
121 decl_ty <- lookupType decQTyConName ;
122 let { core_list = coreList' decl_ty decls } ;
124 dec_ty <- lookupType decTyConName ;
125 q_decs <- repSequenceQ dec_ty core_list ;
127 wrapNongenSyms ss q_decs
128 -- Do *not* gensym top-level binders
131 groupBinders :: HsGroup Name -> [Located Name]
132 groupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
133 hs_instds = inst_decls, hs_fords = foreign_decls })
134 -- Collect the binders of a Group
135 = collectHsValBinders val_decls ++
136 [n | d <- tycl_decls ++ assoc_tycl_decls, n <- tyClDeclNames (unLoc d)] ++
137 [n | L _ (ForeignImport n _ _) <- foreign_decls]
139 assoc_tycl_decls = concat [ats | L _ (InstDecl _ _ _ ats) <- inst_decls]
142 {- Note [Binders and occurrences]
143 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
144 When we desugar [d| data T = MkT |]
146 Data "T" [] [Con "MkT" []] []
148 Data "Foo:T" [] [Con "Foo:MkT" []] []
149 That is, the new data decl should fit into whatever new module it is
150 asked to fit in. We do *not* clone, though; no need for this:
157 then we must desugar to
158 foo = Data "Foo:T" [] [Con "Foo:MkT" []] []
160 So in repTopDs we bring the binders into scope with mkGenSyms and addBinds.
161 And we use lookupOcc, rather than lookupBinder
162 in repTyClD and repC.
166 repTyClD :: LTyClDecl Name -> DsM (Maybe (SrcSpan, Core TH.DecQ))
168 repTyClD tydecl@(L _ (TyFamily {}))
169 = repTyFamily tydecl addTyVarBinds
171 repTyClD (L loc (TyData { tcdND = DataType, tcdCtxt = cxt,
172 tcdLName = tc, tcdTyVars = tvs, tcdTyPats = opt_tys,
173 tcdCons = cons, tcdDerivs = mb_derivs }))
174 = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences]
175 ; dec <- addTyVarBinds tvs $ \bndrs ->
176 do { cxt1 <- repLContext cxt
177 ; opt_tys1 <- maybeMapM repLTys opt_tys -- only for family insts
178 ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1
179 ; cons1 <- mapM repC cons
180 ; cons2 <- coreList conQTyConName cons1
181 ; derivs1 <- repDerivs mb_derivs
182 ; bndrs1 <- coreList tyVarBndrTyConName bndrs
183 ; repData cxt1 tc1 bndrs1 opt_tys2 cons2 derivs1
185 ; return $ Just (loc, dec)
188 repTyClD (L loc (TyData { tcdND = NewType, tcdCtxt = cxt,
189 tcdLName = tc, tcdTyVars = tvs, tcdTyPats = opt_tys,
190 tcdCons = [con], tcdDerivs = mb_derivs }))
191 = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences]
192 ; dec <- addTyVarBinds tvs $ \bndrs ->
193 do { cxt1 <- repLContext cxt
194 ; opt_tys1 <- maybeMapM repLTys opt_tys -- only for family insts
195 ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1
197 ; derivs1 <- repDerivs mb_derivs
198 ; bndrs1 <- coreList tyVarBndrTyConName bndrs
199 ; repNewtype cxt1 tc1 bndrs1 opt_tys2 con1 derivs1
201 ; return $ Just (loc, dec)
204 repTyClD (L loc (TySynonym { tcdLName = tc, tcdTyVars = tvs, tcdTyPats = opt_tys,
206 = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences]
207 ; dec <- addTyVarBinds tvs $ \bndrs ->
208 do { opt_tys1 <- maybeMapM repLTys opt_tys -- only for family insts
209 ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1
211 ; bndrs1 <- coreList tyVarBndrTyConName bndrs
212 ; repTySyn tc1 bndrs1 opt_tys2 ty1
214 ; return (Just (loc, dec))
217 repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
218 tcdTyVars = tvs, tcdFDs = fds,
219 tcdSigs = sigs, tcdMeths = meth_binds,
221 = do { cls1 <- lookupLOcc cls -- See note [Binders and occurrences]
222 ; dec <- addTyVarBinds tvs $ \bndrs ->
223 do { cxt1 <- repLContext cxt
224 ; sigs1 <- rep_sigs sigs
225 ; binds1 <- rep_binds meth_binds
226 ; fds1 <- repLFunDeps fds
227 ; ats1 <- repLAssocFamilys ats
228 ; decls1 <- coreList decQTyConName (ats1 ++ sigs1 ++ binds1)
229 ; bndrs1 <- coreList tyVarBndrTyConName bndrs
230 ; repClass cxt1 cls1 bndrs1 fds1 decls1
232 ; return $ Just (loc, dec)
236 repTyClD (L loc d) = putSrcSpanDs loc $
237 do { warnDs (hang ds_msg 4 (ppr d))
240 -- The type variables in the head of families are treated differently when the
241 -- family declaration is associated. In that case, they are usage, not binding
244 repTyFamily :: LTyClDecl Name
245 -> ProcessTyVarBinds TH.Dec
246 -> DsM (Maybe (SrcSpan, Core TH.DecQ))
247 repTyFamily (L loc (TyFamily { tcdFlavour = flavour,
248 tcdLName = tc, tcdTyVars = tvs,
249 tcdKind = opt_kind }))
251 = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences]
252 ; dec <- tyVarBinds tvs $ \bndrs ->
253 do { flav <- repFamilyFlavour flavour
254 ; bndrs1 <- coreList tyVarBndrTyConName bndrs
256 Nothing -> repFamilyNoKind flav tc1 bndrs1
257 Just ki -> do { ki1 <- repKind ki
258 ; repFamilyKind flav tc1 bndrs1 ki1
261 ; return $ Just (loc, dec)
263 repTyFamily _ _ = panic "DsMeta.repTyFamily: internal error"
267 repLFunDeps :: [Located (FunDep Name)] -> DsM (Core [TH.FunDep])
268 repLFunDeps fds = do fds' <- mapM repLFunDep fds
269 fdList <- coreList funDepTyConName fds'
272 repLFunDep :: Located (FunDep Name) -> DsM (Core TH.FunDep)
273 repLFunDep (L _ (xs, ys)) = do xs' <- mapM lookupBinder xs
274 ys' <- mapM lookupBinder ys
275 xs_list <- coreList nameTyConName xs'
276 ys_list <- coreList nameTyConName ys'
277 repFunDep xs_list ys_list
279 -- represent family declaration flavours
281 repFamilyFlavour :: FamilyFlavour -> DsM (Core TH.FamFlavour)
282 repFamilyFlavour TypeFamily = rep2 typeFamName []
283 repFamilyFlavour DataFamily = rep2 dataFamName []
285 -- represent associated family declarations
287 repLAssocFamilys :: [LTyClDecl Name] -> DsM [Core TH.DecQ]
288 repLAssocFamilys = mapM repLAssocFamily
290 repLAssocFamily tydecl@(L _ (TyFamily {}))
291 = liftM (snd . fromJust) $ repTyFamily tydecl lookupTyVarBinds
292 repLAssocFamily tydecl
295 msg = ptext (sLit "Illegal associated declaration in class:") <+>
298 -- represent associated family instances
300 repLAssocFamInst :: [LTyClDecl Name] -> DsM [Core TH.DecQ]
301 repLAssocFamInst = liftM de_loc . mapMaybeM repTyClD
303 -- represent instance declarations
305 repInstD' :: LInstDecl Name -> DsM (SrcSpan, Core TH.DecQ)
306 repInstD' (L loc (InstDecl ty binds _ ats)) -- Ignore user pragmas for now
307 = do { i <- addTyVarBinds tvs $ \_ ->
308 -- We must bring the type variables into scope, so their
309 -- occurrences don't fail, even though the binders don't
310 -- appear in the resulting data structure
311 do { cxt1 <- repContext cxt
312 ; inst_ty1 <- repPredTy (HsClassP cls tys)
313 ; ss <- mkGenSyms (collectHsBindBinders binds)
314 ; binds1 <- addBinds ss (rep_binds binds)
315 ; ats1 <- repLAssocFamInst ats
316 ; decls1 <- coreList decQTyConName (ats1 ++ binds1)
317 ; decls2 <- wrapNongenSyms ss decls1
318 -- wrapNongenSyms: do not clone the class op names!
319 -- They must be called 'op' etc, not 'op34'
320 ; repInst cxt1 inst_ty1 (decls2)
324 (tvs, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
326 repForD :: Located (ForeignDecl Name) -> DsM (SrcSpan, Core TH.DecQ)
327 repForD (L loc (ForeignImport name typ (CImport cc s ch cis)))
328 = do MkC name' <- lookupLOcc name
329 MkC typ' <- repLTy typ
330 MkC cc' <- repCCallConv cc
331 MkC s' <- repSafety s
332 cis' <- conv_cimportspec cis
333 MkC str <- coreStringLit $ static
334 ++ unpackFS ch ++ " "
336 dec <- rep2 forImpDName [cc', s', str, name', typ']
339 conv_cimportspec (CLabel cls) = notHandled "Foreign label" (doubleQuotes (ppr cls))
340 conv_cimportspec (CFunction DynamicTarget) = return "dynamic"
341 conv_cimportspec (CFunction (StaticTarget fs)) = return (unpackFS fs)
342 conv_cimportspec CWrapper = return "wrapper"
344 CFunction (StaticTarget _) -> "static "
346 repForD decl = notHandled "Foreign declaration" (ppr decl)
348 repCCallConv :: CCallConv -> DsM (Core TH.Callconv)
349 repCCallConv CCallConv = rep2 cCallName []
350 repCCallConv StdCallConv = rep2 stdCallName []
351 repCCallConv callConv = notHandled "repCCallConv" (ppr callConv)
353 repSafety :: Safety -> DsM (Core TH.Safety)
354 repSafety PlayRisky = rep2 unsafeName []
355 repSafety (PlaySafe False) = rep2 safeName []
356 repSafety (PlaySafe True) = rep2 threadsafeName []
359 ds_msg = ptext (sLit "Cannot desugar this Template Haskell declaration:")
361 -------------------------------------------------------
363 -------------------------------------------------------
365 repC :: LConDecl Name -> DsM (Core TH.ConQ)
366 repC (L _ (ConDecl { con_name = con, con_qvars = [], con_cxt = L _ []
367 , con_details = details, con_res = ResTyH98 }))
368 = do { con1 <- lookupLOcc con -- See note [Binders and occurrences]
369 ; repConstr con1 details
371 repC (L loc con_decl@(ConDecl { con_qvars = tvs, con_cxt = L cloc ctxt, con_res = ResTyH98 }))
372 = addTyVarBinds tvs $ \bndrs ->
373 do { c' <- repC (L loc (con_decl { con_qvars = [], con_cxt = L cloc [] }))
374 ; ctxt' <- repContext ctxt
375 ; bndrs' <- coreList tyVarBndrTyConName bndrs
376 ; rep2 forallCName [unC bndrs', unC ctxt', unC c']
378 repC (L loc con_decl) -- GADTs
380 notHandled "GADT declaration" (ppr con_decl)
382 repBangTy :: LBangType Name -> DsM (Core (TH.StrictTypeQ))
386 rep2 strictTypeName [s, t]
388 (str, ty') = case ty of
389 L _ (HsBangTy _ ty) -> (isStrictName, ty)
390 _ -> (notStrictName, ty)
392 -------------------------------------------------------
394 -------------------------------------------------------
396 repDerivs :: Maybe [LHsType Name] -> DsM (Core [TH.Name])
397 repDerivs Nothing = coreList nameTyConName []
398 repDerivs (Just ctxt)
399 = do { strs <- mapM rep_deriv ctxt ;
400 coreList nameTyConName strs }
402 rep_deriv :: LHsType Name -> DsM (Core TH.Name)
403 -- Deriving clauses must have the simple H98 form
404 rep_deriv (L _ (HsPredTy (HsClassP cls []))) = lookupOcc cls
405 rep_deriv other = notHandled "Non-H98 deriving clause" (ppr other)
408 -------------------------------------------------------
409 -- Signatures in a class decl, or a group of bindings
410 -------------------------------------------------------
412 rep_sigs :: [LSig Name] -> DsM [Core TH.DecQ]
413 rep_sigs sigs = do locs_cores <- rep_sigs' sigs
414 return $ de_loc $ sort_by_loc locs_cores
416 rep_sigs' :: [LSig Name] -> DsM [(SrcSpan, Core TH.DecQ)]
417 -- We silently ignore ones we don't recognise
418 rep_sigs' sigs = do { sigs1 <- mapM rep_sig sigs ;
419 return (concat sigs1) }
421 rep_sig :: LSig Name -> DsM [(SrcSpan, Core TH.DecQ)]
423 -- Empty => Too hard, signature ignored
424 rep_sig (L loc (TypeSig nm ty)) = rep_proto nm ty loc
425 rep_sig (L loc (InlineSig nm ispec)) = rep_inline nm ispec loc
426 rep_sig (L loc (SpecSig nm ty ispec)) = rep_specialise nm ty ispec loc
427 rep_sig _ = return []
429 rep_proto :: Located Name -> LHsType Name -> SrcSpan
430 -> DsM [(SrcSpan, Core TH.DecQ)]
432 = do { nm1 <- lookupLOcc nm
434 ; sig <- repProto nm1 ty1
435 ; return [(loc, sig)]
438 rep_inline :: Located Name -> InlineSpec -> SrcSpan
439 -> DsM [(SrcSpan, Core TH.DecQ)]
440 rep_inline nm ispec loc
441 = do { nm1 <- lookupLOcc nm
442 ; (_, ispec1) <- rep_InlineSpec ispec
443 ; pragma <- repPragInl nm1 ispec1
444 ; return [(loc, pragma)]
447 rep_specialise :: Located Name -> LHsType Name -> InlineSpec -> SrcSpan
448 -> DsM [(SrcSpan, Core TH.DecQ)]
449 rep_specialise nm ty ispec loc
450 = do { nm1 <- lookupLOcc nm
452 ; (hasSpec, ispec1) <- rep_InlineSpec ispec
453 ; pragma <- if hasSpec
454 then repPragSpecInl nm1 ty1 ispec1
455 else repPragSpec nm1 ty1
456 ; return [(loc, pragma)]
459 -- extract all the information needed to build a TH.InlineSpec
461 rep_InlineSpec :: InlineSpec -> DsM (Bool, Core TH.InlineSpecQ)
462 rep_InlineSpec (Inline (InlinePragma activation match) inline)
463 | Nothing <- activation1
464 = liftM ((,) False) $ repInlineSpecNoPhase inline1 match1
465 | Just (flag, phase) <- activation1
466 = liftM ((,) True) $ repInlineSpecPhase inline1 match1 flag phase
467 | otherwise = {- unreachable, but shuts up -W -} panic "rep_InlineSpec"
469 match1 = coreBool (rep_RuleMatchInfo match)
470 activation1 = rep_Activation activation
471 inline1 = coreBool inline
473 rep_RuleMatchInfo FunLike = False
474 rep_RuleMatchInfo ConLike = True
476 rep_Activation NeverActive = Nothing
477 rep_Activation AlwaysActive = Nothing
478 rep_Activation (ActiveBefore phase) = Just (coreBool False,
479 MkC $ mkIntExprInt phase)
480 rep_Activation (ActiveAfter phase) = Just (coreBool True,
481 MkC $ mkIntExprInt phase)
484 -------------------------------------------------------
486 -------------------------------------------------------
488 -- We process type variable bindings in two ways, either by generating fresh
489 -- names or looking up existing names. The difference is crucial for type
490 -- families, depending on whether they are associated or not.
492 type ProcessTyVarBinds a =
493 [LHsTyVarBndr Name] -- the binders to be added
494 -> ([Core TH.TyVarBndr] -> DsM (Core (TH.Q a))) -- action in the ext env
495 -> DsM (Core (TH.Q a))
497 -- gensym a list of type variables and enter them into the meta environment;
498 -- the computations passed as the second argument is executed in that extended
499 -- meta environment and gets the *new* names on Core-level as an argument
501 addTyVarBinds :: ProcessTyVarBinds a
502 addTyVarBinds tvs m =
504 let names = hsLTyVarNames tvs
505 mkWithKinds = map repTyVarBndrWithKind tvs
506 freshNames <- mkGenSyms names
507 term <- addBinds freshNames $ do
508 bndrs <- mapM lookupBinder names
509 kindedBndrs <- zipWithM ($) mkWithKinds bndrs
511 wrapGenSyns freshNames term
513 -- Look up a list of type variables; the computations passed as the second
514 -- argument gets the *new* names on Core-level as an argument
516 lookupTyVarBinds :: ProcessTyVarBinds a
517 lookupTyVarBinds tvs m =
519 let names = hsLTyVarNames tvs
520 mkWithKinds = map repTyVarBndrWithKind tvs
521 bndrs <- mapM lookupBinder names
522 kindedBndrs <- zipWithM ($) mkWithKinds bndrs
525 -- Produce kinded binder constructors from the Haskell tyvar binders
527 repTyVarBndrWithKind :: LHsTyVarBndr Name
528 -> Core TH.Name -> DsM (Core TH.TyVarBndr)
529 repTyVarBndrWithKind (L _ (UserTyVar _)) = repPlainTV
530 repTyVarBndrWithKind (L _ (KindedTyVar _ ki)) =
531 \nm -> repKind ki >>= repKindedTV nm
533 -- represent a type context
535 repLContext :: LHsContext Name -> DsM (Core TH.CxtQ)
536 repLContext (L _ ctxt) = repContext ctxt
538 repContext :: HsContext Name -> DsM (Core TH.CxtQ)
540 preds <- mapM repLPred ctxt
541 predList <- coreList predQTyConName preds
544 -- represent a type predicate
546 repLPred :: LHsPred Name -> DsM (Core TH.PredQ)
547 repLPred (L _ p) = repPred p
549 repPred :: HsPred Name -> DsM (Core TH.PredQ)
550 repPred (HsClassP cls tys)
552 cls1 <- lookupOcc cls
554 tys2 <- coreList typeQTyConName tys1
556 repPred (HsEqualP tyleft tyright)
558 tyleft1 <- repLTy tyleft
559 tyright1 <- repLTy tyright
560 repEqualP tyleft1 tyright1
561 repPred p@(HsIParam _ _) = notHandled "Implicit parameter constraint" (ppr p)
563 repPredTy :: HsPred Name -> DsM (Core TH.TypeQ)
564 repPredTy (HsClassP cls tys)
566 tcon <- repTy (HsTyVar cls)
569 repPredTy _ = panic "DsMeta.repPredTy: unexpected equality: internal error"
571 -- yield the representation of a list of types
573 repLTys :: [LHsType Name] -> DsM [Core TH.TypeQ]
574 repLTys tys = mapM repLTy tys
578 repLTy :: LHsType Name -> DsM (Core TH.TypeQ)
579 repLTy (L _ ty) = repTy ty
581 repTy :: HsType Name -> DsM (Core TH.TypeQ)
582 repTy (HsForAllTy _ tvs ctxt ty) =
583 addTyVarBinds tvs $ \bndrs -> do
584 ctxt1 <- repLContext ctxt
586 bndrs1 <- coreList tyVarBndrTyConName bndrs
587 repTForall bndrs1 ctxt1 ty1
590 | isTvOcc (nameOccName n) = do
596 repTy (HsAppTy f a) = do
600 repTy (HsFunTy f a) = do
603 tcon <- repArrowTyCon
604 repTapps tcon [f1, a1]
605 repTy (HsListTy t) = do
609 repTy (HsPArrTy t) = do
611 tcon <- repTy (HsTyVar (tyConName parrTyCon))
613 repTy (HsTupleTy _ tys) = do
615 tcon <- repTupleTyCon (length tys)
617 repTy (HsOpTy ty1 n ty2) = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1)
619 repTy (HsParTy t) = repLTy t
620 repTy (HsPredTy pred) = repPredTy pred
621 repTy (HsKindSig t k) = do
625 repTy (HsSpliceTy splice) = repSplice splice
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 repSplice :: HsSplice Name -> DsM (Core a)
648 -- See Note [How brackets and nested splices are handled] in TcSplice
649 -- We return a CoreExpr of any old type; the context should know
650 repSplice (HsSplice n _)
651 = do { mb_val <- dsLookupMetaEnv n
653 Just (Splice e) -> do { e' <- dsExpr e
655 _ -> pprPanic "HsSplice" (ppr n) }
656 -- Should not happen; statically checked
658 -----------------------------------------------------------------------------
660 -----------------------------------------------------------------------------
662 repLEs :: [LHsExpr Name] -> DsM (Core [TH.ExpQ])
663 repLEs es = do { es' <- mapM repLE es ;
664 coreList expQTyConName es' }
666 -- FIXME: some of these panics should be converted into proper error messages
667 -- unless we can make sure that constructs, which are plainly not
668 -- supported in TH already lead to error messages at an earlier stage
669 repLE :: LHsExpr Name -> DsM (Core TH.ExpQ)
670 repLE (L loc e) = putSrcSpanDs loc (repE e)
672 repE :: HsExpr Name -> DsM (Core TH.ExpQ)
674 do { mb_val <- dsLookupMetaEnv x
676 Nothing -> do { str <- globalVar x
677 ; repVarOrCon x str }
678 Just (Bound y) -> repVarOrCon x (coreVar y)
679 Just (Splice e) -> do { e' <- dsExpr e
680 ; return (MkC e') } }
681 repE e@(HsIPVar _) = notHandled "Implicit parameters" (ppr e)
683 -- Remember, we're desugaring renamer output here, so
684 -- HsOverlit can definitely occur
685 repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
686 repE (HsLit l) = do { a <- repLiteral l; repLit a }
687 repE (HsLam (MatchGroup [m] _)) = repLambda m
688 repE (HsApp x y) = do {a <- repLE x; b <- repLE y; repApp a b}
690 repE (OpApp e1 op _ e2) =
691 do { arg1 <- repLE e1;
694 repInfixApp arg1 the_op arg2 }
695 repE (NegApp x _) = do
697 negateVar <- lookupOcc negateName >>= repVar
699 repE (HsPar x) = repLE x
700 repE (SectionL x y) = do { a <- repLE x; b <- repLE y; repSectionL a b }
701 repE (SectionR x y) = do { a <- repLE x; b <- repLE y; repSectionR a b }
702 repE (HsCase e (MatchGroup ms _)) = do { arg <- repLE e
703 ; ms2 <- mapM repMatchTup ms
704 ; repCaseE arg (nonEmptyCoreList ms2) }
705 repE (HsIf x y z) = do
710 repE (HsLet bs e) = do { (ss,ds) <- repBinds bs
711 ; e2 <- addBinds ss (repLE e)
714 -- FIXME: I haven't got the types here right yet
715 repE (HsDo DoExpr sts body _)
716 = do { (ss,zs) <- repLSts sts;
717 body' <- addBinds ss $ repLE body;
718 ret <- repNoBindSt body';
719 e <- repDoE (nonEmptyCoreList (zs ++ [ret]));
721 repE (HsDo ListComp sts body _)
722 = do { (ss,zs) <- repLSts sts;
723 body' <- addBinds ss $ repLE body;
724 ret <- repNoBindSt body';
725 e <- repComp (nonEmptyCoreList (zs ++ [ret]));
727 repE e@(HsDo _ _ _ _) = notHandled "mdo and [: :]" (ppr e)
728 repE (ExplicitList _ es) = do { xs <- repLEs es; repListExp xs }
729 repE e@(ExplicitPArr _ _) = notHandled "Parallel arrays" (ppr e)
730 repE e@(ExplicitTuple es boxed)
731 | not (isBoxed boxed) = notHandled "Unboxed tuples" (ppr e)
732 | not (all tupArgPresent es) = notHandled "Tuple sections" (ppr e)
733 | otherwise = do { xs <- repLEs [e | Present e <- es]; repTup xs }
735 repE (RecordCon c _ flds)
736 = do { x <- lookupLOcc c;
737 fs <- repFields flds;
739 repE (RecordUpd e flds _ _ _)
741 fs <- repFields flds;
744 repE (ExprWithTySig e ty) = do { e1 <- repLE e; t1 <- repLTy ty; repSigExp e1 t1 }
745 repE (ArithSeq _ aseq) =
747 From e -> do { ds1 <- repLE e; repFrom ds1 }
756 FromThenTo e1 e2 e3 -> do
760 repFromThenTo ds1 ds2 ds3
762 repE (HsSpliceE splice) = repSplice splice
763 repE e@(PArrSeq {}) = notHandled "Parallel arrays" (ppr e)
764 repE e@(HsCoreAnn {}) = notHandled "Core annotations" (ppr e)
765 repE e@(HsSCC {}) = notHandled "Cost centres" (ppr e)
766 repE e@(HsTickPragma {}) = notHandled "Tick Pragma" (ppr e)
767 repE e@(HsBracketOut {}) = notHandled "TH brackets" (ppr e)
768 repE e = notHandled "Expression form" (ppr e)
770 -----------------------------------------------------------------------------
771 -- Building representations of auxillary structures like Match, Clause, Stmt,
773 repMatchTup :: LMatch Name -> DsM (Core TH.MatchQ)
774 repMatchTup (L _ (Match [p] _ (GRHSs guards wheres))) =
775 do { ss1 <- mkGenSyms (collectPatBinders p)
776 ; addBinds ss1 $ do {
778 ; (ss2,ds) <- repBinds wheres
779 ; addBinds ss2 $ do {
780 ; gs <- repGuards guards
781 ; match <- repMatch p1 gs ds
782 ; wrapGenSyns (ss1++ss2) match }}}
783 repMatchTup _ = panic "repMatchTup: case alt with more than one arg"
785 repClauseTup :: LMatch Name -> DsM (Core TH.ClauseQ)
786 repClauseTup (L _ (Match ps _ (GRHSs guards wheres))) =
787 do { ss1 <- mkGenSyms (collectPatsBinders ps)
788 ; addBinds ss1 $ do {
790 ; (ss2,ds) <- repBinds wheres
791 ; addBinds ss2 $ do {
792 gs <- repGuards guards
793 ; clause <- repClause ps1 gs ds
794 ; wrapGenSyns (ss1++ss2) clause }}}
796 repGuards :: [LGRHS Name] -> DsM (Core TH.BodyQ)
797 repGuards [L _ (GRHS [] e)]
798 = do {a <- repLE e; repNormal a }
800 = do { zs <- mapM process other;
801 let {(xs, ys) = unzip zs};
802 gd <- repGuarded (nonEmptyCoreList ys);
803 wrapGenSyns (concat xs) gd }
805 process :: LGRHS Name -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp))))
806 process (L _ (GRHS [L _ (ExprStmt e1 _ _)] e2))
807 = do { x <- repLNormalGE e1 e2;
809 process (L _ (GRHS ss rhs))
810 = do (gs, ss') <- repLSts ss
811 rhs' <- addBinds gs $ repLE rhs
812 g <- repPatGE (nonEmptyCoreList ss') rhs'
815 repFields :: HsRecordBinds Name -> DsM (Core [TH.Q TH.FieldExp])
816 repFields (HsRecFields { rec_flds = flds })
817 = do { fnames <- mapM lookupLOcc (map hsRecFieldId flds)
818 ; es <- mapM repLE (map hsRecFieldArg flds)
819 ; fs <- zipWithM repFieldExp fnames es
820 ; coreList fieldExpQTyConName fs }
823 -----------------------------------------------------------------------------
824 -- Representing Stmt's is tricky, especially if bound variables
825 -- shadow each other. Consider: [| do { x <- f 1; x <- f x; g x } |]
826 -- First gensym new names for every variable in any of the patterns.
827 -- both static (x'1 and x'2), and dynamic ((gensym "x") and (gensym "y"))
828 -- if variables didn't shaddow, the static gensym wouldn't be necessary
829 -- and we could reuse the original names (x and x).
831 -- do { x'1 <- gensym "x"
832 -- ; x'2 <- gensym "x"
833 -- ; doE [ BindSt (pvar x'1) [| f 1 |]
834 -- , BindSt (pvar x'2) [| f x |]
835 -- , NoBindSt [| g x |]
839 -- The strategy is to translate a whole list of do-bindings by building a
840 -- bigger environment, and a bigger set of meta bindings
841 -- (like: x'1 <- gensym "x" ) and then combining these with the translations
842 -- of the expressions within the Do
844 -----------------------------------------------------------------------------
845 -- The helper function repSts computes the translation of each sub expression
846 -- and a bunch of prefix bindings denoting the dynamic renaming.
848 repLSts :: [LStmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
849 repLSts stmts = repSts (map unLoc stmts)
851 repSts :: [Stmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
852 repSts (BindStmt p e _ _ : ss) =
854 ; ss1 <- mkGenSyms (collectPatBinders p)
855 ; addBinds ss1 $ do {
857 ; (ss2,zs) <- repSts ss
858 ; z <- repBindSt p1 e2
859 ; return (ss1++ss2, z : zs) }}
860 repSts (LetStmt bs : ss) =
861 do { (ss1,ds) <- repBinds bs
863 ; (ss2,zs) <- addBinds ss1 (repSts ss)
864 ; return (ss1++ss2, z : zs) }
865 repSts (ExprStmt e _ _ : ss) =
867 ; z <- repNoBindSt e2
868 ; (ss2,zs) <- repSts ss
869 ; return (ss2, z : zs) }
870 repSts [] = return ([],[])
871 repSts other = notHandled "Exotic statement" (ppr other)
874 -----------------------------------------------------------
876 -----------------------------------------------------------
878 repBinds :: HsLocalBinds Name -> DsM ([GenSymBind], Core [TH.DecQ])
879 repBinds EmptyLocalBinds
880 = do { core_list <- coreList decQTyConName []
881 ; return ([], core_list) }
883 repBinds b@(HsIPBinds _) = notHandled "Implicit parameters" (ppr b)
885 repBinds (HsValBinds decs)
886 = do { let { bndrs = map unLoc (collectHsValBinders decs) }
887 -- No need to worrry about detailed scopes within
888 -- the binding group, because we are talking Names
889 -- here, so we can safely treat it as a mutually
891 ; ss <- mkGenSyms bndrs
892 ; prs <- addBinds ss (rep_val_binds decs)
893 ; core_list <- coreList decQTyConName
894 (de_loc (sort_by_loc prs))
895 ; return (ss, core_list) }
897 rep_val_binds :: HsValBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
898 -- Assumes: all the binders of the binding are alrady in the meta-env
899 rep_val_binds (ValBindsOut binds sigs)
900 = do { core1 <- rep_binds' (unionManyBags (map snd binds))
901 ; core2 <- rep_sigs' sigs
902 ; return (core1 ++ core2) }
903 rep_val_binds (ValBindsIn _ _)
904 = panic "rep_val_binds: ValBindsIn"
906 rep_binds :: LHsBinds Name -> DsM [Core TH.DecQ]
907 rep_binds binds = do { binds_w_locs <- rep_binds' binds
908 ; return (de_loc (sort_by_loc binds_w_locs)) }
910 rep_binds' :: LHsBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
911 rep_binds' binds = mapM rep_bind (bagToList binds)
913 rep_bind :: LHsBind Name -> DsM (SrcSpan, Core TH.DecQ)
914 -- Assumes: all the binders of the binding are alrady in the meta-env
916 -- Note GHC treats declarations of a variable (not a pattern)
917 -- e.g. x = g 5 as a Fun MonoBinds. This is indicated by a single match
918 -- with an empty list of patterns
919 rep_bind (L loc (FunBind { fun_id = fn,
920 fun_matches = MatchGroup [L _ (Match [] _ (GRHSs guards wheres))] _ }))
921 = do { (ss,wherecore) <- repBinds wheres
922 ; guardcore <- addBinds ss (repGuards guards)
923 ; fn' <- lookupLBinder fn
925 ; ans <- repVal p guardcore wherecore
926 ; ans' <- wrapGenSyns ss ans
927 ; return (loc, ans') }
929 rep_bind (L loc (FunBind { fun_id = fn, fun_matches = MatchGroup ms _ }))
930 = do { ms1 <- mapM repClauseTup ms
931 ; fn' <- lookupLBinder fn
932 ; ans <- repFun fn' (nonEmptyCoreList ms1)
933 ; return (loc, ans) }
935 rep_bind (L loc (PatBind { pat_lhs = pat, pat_rhs = GRHSs guards wheres }))
936 = do { patcore <- repLP pat
937 ; (ss,wherecore) <- repBinds wheres
938 ; guardcore <- addBinds ss (repGuards guards)
939 ; ans <- repVal patcore guardcore wherecore
940 ; ans' <- wrapGenSyns ss ans
941 ; return (loc, ans') }
943 rep_bind (L _ (VarBind { var_id = v, var_rhs = e}))
944 = do { v' <- lookupBinder v
947 ; patcore <- repPvar v'
948 ; empty_decls <- coreList decQTyConName []
949 ; ans <- repVal patcore x empty_decls
950 ; return (srcLocSpan (getSrcLoc v), ans) }
952 rep_bind (L _ (AbsBinds {})) = panic "rep_bind: AbsBinds"
954 -----------------------------------------------------------------------------
955 -- Since everything in a Bind is mutually recursive we need rename all
956 -- all the variables simultaneously. For example:
957 -- [| AndMonoBinds (f x = x + g 2) (g x = f 1 + 2) |] would translate to
958 -- do { f'1 <- gensym "f"
959 -- ; g'2 <- gensym "g"
960 -- ; [ do { x'3 <- gensym "x"; fun f'1 [pvar x'3] [| x + g2 |]},
961 -- do { x'4 <- gensym "x"; fun g'2 [pvar x'4] [| f 1 + 2 |]}
963 -- This requires collecting the bindings (f'1 <- gensym "f"), and the
964 -- environment ( f |-> f'1 ) from each binding, and then unioning them
965 -- together. As we do this we collect GenSymBinds's which represent the renamed
966 -- variables bound by the Bindings. In order not to lose track of these
967 -- representations we build a shadow datatype MB with the same structure as
968 -- MonoBinds, but which has slots for the representations
971 -----------------------------------------------------------------------------
972 -- GHC allows a more general form of lambda abstraction than specified
973 -- by Haskell 98. In particular it allows guarded lambda's like :
974 -- (\ x | even x -> 0 | odd x -> 1) at the moment we can't represent this in
975 -- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like
976 -- (\ p1 .. pn -> exp) by causing an error.
978 repLambda :: LMatch Name -> DsM (Core TH.ExpQ)
979 repLambda (L _ (Match ps _ (GRHSs [L _ (GRHS [] e)] EmptyLocalBinds)))
980 = do { let bndrs = collectPatsBinders ps ;
981 ; ss <- mkGenSyms bndrs
982 ; lam <- addBinds ss (
983 do { xs <- repLPs ps; body <- repLE e; repLam xs body })
984 ; wrapGenSyns ss lam }
986 repLambda (L _ m) = notHandled "Guarded labmdas" (pprMatch (LambdaExpr :: HsMatchContext Name) m)
989 -----------------------------------------------------------------------------
991 -- repP deals with patterns. It assumes that we have already
992 -- walked over the pattern(s) once to collect the binders, and
993 -- have extended the environment. So every pattern-bound
994 -- variable should already appear in the environment.
996 -- Process a list of patterns
997 repLPs :: [LPat Name] -> DsM (Core [TH.PatQ])
998 repLPs ps = do { ps' <- mapM repLP ps ;
999 coreList patQTyConName ps' }
1001 repLP :: LPat Name -> DsM (Core TH.PatQ)
1002 repLP (L _ p) = repP p
1004 repP :: Pat Name -> DsM (Core TH.PatQ)
1005 repP (WildPat _) = repPwild
1006 repP (LitPat l) = do { l2 <- repLiteral l; repPlit l2 }
1007 repP (VarPat x) = do { x' <- lookupBinder x; repPvar x' }
1008 repP (LazyPat p) = do { p1 <- repLP p; repPtilde p1 }
1009 repP (BangPat p) = do { p1 <- repLP p; repPbang p1 }
1010 repP (AsPat x p) = do { x' <- lookupLBinder x; p1 <- repLP p; repPaspat x' p1 }
1011 repP (ParPat p) = repLP p
1012 repP (ListPat ps _) = do { qs <- repLPs ps; repPlist qs }
1013 repP (TuplePat ps _ _) = do { qs <- repLPs ps; repPtup qs }
1014 repP (ConPatIn dc details)
1015 = do { con_str <- lookupLOcc dc
1017 PrefixCon ps -> do { qs <- repLPs ps; repPcon con_str qs }
1018 RecCon rec -> do { let flds = rec_flds rec
1019 ; vs <- sequence $ map lookupLOcc (map hsRecFieldId flds)
1020 ; ps <- sequence $ map repLP (map hsRecFieldArg flds)
1021 ; fps <- zipWithM (\x y -> rep2 fieldPatName [unC x,unC y]) vs ps
1022 ; fps' <- coreList fieldPatQTyConName fps
1023 ; repPrec con_str fps' }
1024 InfixCon p1 p2 -> do { p1' <- repLP p1;
1026 repPinfix p1' con_str p2' }
1028 repP (NPat l Nothing _) = do { a <- repOverloadedLiteral l; repPlit a }
1029 repP p@(NPat _ (Just _) _) = notHandled "Negative overloaded patterns" (ppr p)
1030 repP p@(SigPatIn {}) = notHandled "Type signatures in patterns" (ppr p)
1031 -- The problem is to do with scoped type variables.
1032 -- To implement them, we have to implement the scoping rules
1033 -- here in DsMeta, and I don't want to do that today!
1034 -- do { p' <- repLP p; t' <- repLTy t; repPsig p' t' }
1035 -- repPsig :: Core TH.PatQ -> Core TH.TypeQ -> DsM (Core TH.PatQ)
1036 -- repPsig (MkC p) (MkC t) = rep2 sigPName [p, t]
1038 repP other = notHandled "Exotic pattern" (ppr other)
1040 ----------------------------------------------------------
1041 -- Declaration ordering helpers
1043 sort_by_loc :: [(SrcSpan, a)] -> [(SrcSpan, a)]
1044 sort_by_loc xs = sortBy comp xs
1045 where comp x y = compare (fst x) (fst y)
1047 de_loc :: [(a, b)] -> [b]
1050 ----------------------------------------------------------
1051 -- The meta-environment
1053 -- A name/identifier association for fresh names of locally bound entities
1054 type GenSymBind = (Name, Id) -- Gensym the string and bind it to the Id
1055 -- I.e. (x, x_id) means
1056 -- let x_id = gensym "x" in ...
1058 -- Generate a fresh name for a locally bound entity
1060 mkGenSyms :: [Name] -> DsM [GenSymBind]
1061 -- We can use the existing name. For example:
1062 -- [| \x_77 -> x_77 + x_77 |]
1064 -- do { x_77 <- genSym "x"; .... }
1065 -- We use the same x_77 in the desugared program, but with the type Bndr
1068 -- We do make it an Internal name, though (hence localiseName)
1070 -- Nevertheless, it's monadic because we have to generate nameTy
1071 mkGenSyms ns = do { var_ty <- lookupType nameTyConName
1072 ; return [(nm, mkLocalId (localiseName nm) var_ty) | nm <- ns] }
1075 addBinds :: [GenSymBind] -> DsM a -> DsM a
1076 -- Add a list of fresh names for locally bound entities to the
1077 -- meta environment (which is part of the state carried around
1078 -- by the desugarer monad)
1079 addBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,Bound id) | (n,id) <- bs]) m
1081 -- Look up a locally bound name
1083 lookupLBinder :: Located Name -> DsM (Core TH.Name)
1084 lookupLBinder (L _ n) = lookupBinder n
1086 lookupBinder :: Name -> DsM (Core TH.Name)
1088 = do { mb_val <- dsLookupMetaEnv n;
1090 Just (Bound x) -> return (coreVar x)
1091 _ -> failWithDs msg }
1093 msg = ptext (sLit "DsMeta: failed binder lookup when desugaring a TH bracket:") <+> ppr n
1095 -- Look up a name that is either locally bound or a global name
1097 -- * If it is a global name, generate the "original name" representation (ie,
1098 -- the <module>:<name> form) for the associated entity
1100 lookupLOcc :: Located Name -> DsM (Core TH.Name)
1101 -- Lookup an occurrence; it can't be a splice.
1102 -- Use the in-scope bindings if they exist
1103 lookupLOcc (L _ n) = lookupOcc n
1105 lookupOcc :: Name -> DsM (Core TH.Name)
1107 = do { mb_val <- dsLookupMetaEnv n ;
1109 Nothing -> globalVar n
1110 Just (Bound x) -> return (coreVar x)
1111 Just (Splice _) -> pprPanic "repE:lookupOcc" (ppr n)
1114 lookupTvOcc :: Name -> DsM (Core TH.Name)
1115 -- Type variables can't be staged and are not lexically scoped in TH
1117 = do { mb_val <- dsLookupMetaEnv n ;
1119 Just (Bound x) -> return (coreVar x)
1123 msg = vcat [ ptext (sLit "Illegal lexically-scoped type variable") <+> quotes (ppr n)
1124 , ptext (sLit "Lexically scoped type variables are not supported by Template Haskell") ]
1126 globalVar :: Name -> DsM (Core TH.Name)
1127 -- Not bound by the meta-env
1128 -- Could be top-level; or could be local
1129 -- f x = $(g [| x |])
1130 -- Here the x will be local
1132 | isExternalName name
1133 = do { MkC mod <- coreStringLit name_mod
1134 ; MkC pkg <- coreStringLit name_pkg
1135 ; MkC occ <- occNameLit name
1136 ; rep2 mk_varg [pkg,mod,occ] }
1138 = do { MkC occ <- occNameLit name
1139 ; MkC uni <- coreIntLit (getKey (getUnique name))
1140 ; rep2 mkNameLName [occ,uni] }
1142 mod = ASSERT( isExternalName name) nameModule name
1143 name_mod = moduleNameString (moduleName mod)
1144 name_pkg = packageIdString (modulePackageId mod)
1145 name_occ = nameOccName name
1146 mk_varg | OccName.isDataOcc name_occ = mkNameG_dName
1147 | OccName.isVarOcc name_occ = mkNameG_vName
1148 | OccName.isTcOcc name_occ = mkNameG_tcName
1149 | otherwise = pprPanic "DsMeta.globalVar" (ppr name)
1151 lookupType :: Name -- Name of type constructor (e.g. TH.ExpQ)
1152 -> DsM Type -- The type
1153 lookupType tc_name = do { tc <- dsLookupTyCon tc_name ;
1154 return (mkTyConApp tc []) }
1156 wrapGenSyns :: [GenSymBind]
1157 -> Core (TH.Q a) -> DsM (Core (TH.Q a))
1158 -- wrapGenSyns [(nm1,id1), (nm2,id2)] y
1159 -- --> bindQ (gensym nm1) (\ id1 ->
1160 -- bindQ (gensym nm2 (\ id2 ->
1163 wrapGenSyns binds body@(MkC b)
1164 = do { var_ty <- lookupType nameTyConName
1167 [elt_ty] = tcTyConAppArgs (exprType b)
1168 -- b :: Q a, so we can get the type 'a' by looking at the
1169 -- argument type. NB: this relies on Q being a data/newtype,
1170 -- not a type synonym
1172 go _ [] = return body
1173 go var_ty ((name,id) : binds)
1174 = do { MkC body' <- go var_ty binds
1175 ; lit_str <- occNameLit name
1176 ; gensym_app <- repGensym lit_str
1177 ; repBindQ var_ty elt_ty
1178 gensym_app (MkC (Lam id body')) }
1180 -- Just like wrapGenSym, but don't actually do the gensym
1181 -- Instead use the existing name:
1182 -- let x = "x" in ...
1183 -- Only used for [Decl], and for the class ops in class
1184 -- and instance decls
1185 wrapNongenSyms :: [GenSymBind] -> Core a -> DsM (Core a)
1186 wrapNongenSyms binds (MkC body)
1187 = do { binds' <- mapM do_one binds ;
1188 return (MkC (mkLets binds' body)) }
1191 = do { MkC lit_str <- occNameLit name
1192 ; MkC var <- rep2 mkNameName [lit_str]
1193 ; return (NonRec id var) }
1195 occNameLit :: Name -> DsM (Core String)
1196 occNameLit n = coreStringLit (occNameString (nameOccName n))
1199 -- %*********************************************************************
1201 -- Constructing code
1203 -- %*********************************************************************
1205 -----------------------------------------------------------------------------
1206 -- PHANTOM TYPES for consistency. In order to make sure we do this correct
1207 -- we invent a new datatype which uses phantom types.
1209 newtype Core a = MkC CoreExpr
1210 unC :: Core a -> CoreExpr
1213 rep2 :: Name -> [ CoreExpr ] -> DsM (Core a)
1214 rep2 n xs = do { id <- dsLookupGlobalId n
1215 ; return (MkC (foldl App (Var id) xs)) }
1217 -- Then we make "repConstructors" which use the phantom types for each of the
1218 -- smart constructors of the Meta.Meta datatypes.
1221 -- %*********************************************************************
1223 -- The 'smart constructors'
1225 -- %*********************************************************************
1227 --------------- Patterns -----------------
1228 repPlit :: Core TH.Lit -> DsM (Core TH.PatQ)
1229 repPlit (MkC l) = rep2 litPName [l]
1231 repPvar :: Core TH.Name -> DsM (Core TH.PatQ)
1232 repPvar (MkC s) = rep2 varPName [s]
1234 repPtup :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
1235 repPtup (MkC ps) = rep2 tupPName [ps]
1237 repPcon :: Core TH.Name -> Core [TH.PatQ] -> DsM (Core TH.PatQ)
1238 repPcon (MkC s) (MkC ps) = rep2 conPName [s, ps]
1240 repPrec :: Core TH.Name -> Core [(TH.Name,TH.PatQ)] -> DsM (Core TH.PatQ)
1241 repPrec (MkC c) (MkC rps) = rep2 recPName [c,rps]
1243 repPinfix :: Core TH.PatQ -> Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
1244 repPinfix (MkC p1) (MkC n) (MkC p2) = rep2 infixPName [p1, n, p2]
1246 repPtilde :: Core TH.PatQ -> DsM (Core TH.PatQ)
1247 repPtilde (MkC p) = rep2 tildePName [p]
1249 repPbang :: Core TH.PatQ -> DsM (Core TH.PatQ)
1250 repPbang (MkC p) = rep2 bangPName [p]
1252 repPaspat :: Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
1253 repPaspat (MkC s) (MkC p) = rep2 asPName [s, p]
1255 repPwild :: DsM (Core TH.PatQ)
1256 repPwild = rep2 wildPName []
1258 repPlist :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
1259 repPlist (MkC ps) = rep2 listPName [ps]
1261 --------------- Expressions -----------------
1262 repVarOrCon :: Name -> Core TH.Name -> DsM (Core TH.ExpQ)
1263 repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
1264 | otherwise = repVar str
1266 repVar :: Core TH.Name -> DsM (Core TH.ExpQ)
1267 repVar (MkC s) = rep2 varEName [s]
1269 repCon :: Core TH.Name -> DsM (Core TH.ExpQ)
1270 repCon (MkC s) = rep2 conEName [s]
1272 repLit :: Core TH.Lit -> DsM (Core TH.ExpQ)
1273 repLit (MkC c) = rep2 litEName [c]
1275 repApp :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1276 repApp (MkC x) (MkC y) = rep2 appEName [x,y]
1278 repLam :: Core [TH.PatQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1279 repLam (MkC ps) (MkC e) = rep2 lamEName [ps, e]
1281 repTup :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
1282 repTup (MkC es) = rep2 tupEName [es]
1284 repCond :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1285 repCond (MkC x) (MkC y) (MkC z) = rep2 condEName [x,y,z]
1287 repLetE :: Core [TH.DecQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1288 repLetE (MkC ds) (MkC e) = rep2 letEName [ds, e]
1290 repCaseE :: Core TH.ExpQ -> Core [TH.MatchQ] -> DsM( Core TH.ExpQ)
1291 repCaseE (MkC e) (MkC ms) = rep2 caseEName [e, ms]
1293 repDoE :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
1294 repDoE (MkC ss) = rep2 doEName [ss]
1296 repComp :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
1297 repComp (MkC ss) = rep2 compEName [ss]
1299 repListExp :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
1300 repListExp (MkC es) = rep2 listEName [es]
1302 repSigExp :: Core TH.ExpQ -> Core TH.TypeQ -> DsM (Core TH.ExpQ)
1303 repSigExp (MkC e) (MkC t) = rep2 sigEName [e,t]
1305 repRecCon :: Core TH.Name -> Core [TH.Q TH.FieldExp]-> DsM (Core TH.ExpQ)
1306 repRecCon (MkC c) (MkC fs) = rep2 recConEName [c,fs]
1308 repRecUpd :: Core TH.ExpQ -> Core [TH.Q TH.FieldExp] -> DsM (Core TH.ExpQ)
1309 repRecUpd (MkC e) (MkC fs) = rep2 recUpdEName [e,fs]
1311 repFieldExp :: Core TH.Name -> Core TH.ExpQ -> DsM (Core (TH.Q TH.FieldExp))
1312 repFieldExp (MkC n) (MkC x) = rep2 fieldExpName [n,x]
1314 repInfixApp :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1315 repInfixApp (MkC x) (MkC y) (MkC z) = rep2 infixAppName [x,y,z]
1317 repSectionL :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1318 repSectionL (MkC x) (MkC y) = rep2 sectionLName [x,y]
1320 repSectionR :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1321 repSectionR (MkC x) (MkC y) = rep2 sectionRName [x,y]
1323 ------------ Right hand sides (guarded expressions) ----
1324 repGuarded :: Core [TH.Q (TH.Guard, TH.Exp)] -> DsM (Core TH.BodyQ)
1325 repGuarded (MkC pairs) = rep2 guardedBName [pairs]
1327 repNormal :: Core TH.ExpQ -> DsM (Core TH.BodyQ)
1328 repNormal (MkC e) = rep2 normalBName [e]
1330 ------------ Guards ----
1331 repLNormalGE :: LHsExpr Name -> LHsExpr Name -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1332 repLNormalGE g e = do g' <- repLE g
1336 repNormalGE :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1337 repNormalGE (MkC g) (MkC e) = rep2 normalGEName [g, e]
1339 repPatGE :: Core [TH.StmtQ] -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1340 repPatGE (MkC ss) (MkC e) = rep2 patGEName [ss, e]
1342 ------------- Stmts -------------------
1343 repBindSt :: Core TH.PatQ -> Core TH.ExpQ -> DsM (Core TH.StmtQ)
1344 repBindSt (MkC p) (MkC e) = rep2 bindSName [p,e]
1346 repLetSt :: Core [TH.DecQ] -> DsM (Core TH.StmtQ)
1347 repLetSt (MkC ds) = rep2 letSName [ds]
1349 repNoBindSt :: Core TH.ExpQ -> DsM (Core TH.StmtQ)
1350 repNoBindSt (MkC e) = rep2 noBindSName [e]
1352 -------------- Range (Arithmetic sequences) -----------
1353 repFrom :: Core TH.ExpQ -> DsM (Core TH.ExpQ)
1354 repFrom (MkC x) = rep2 fromEName [x]
1356 repFromThen :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1357 repFromThen (MkC x) (MkC y) = rep2 fromThenEName [x,y]
1359 repFromTo :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1360 repFromTo (MkC x) (MkC y) = rep2 fromToEName [x,y]
1362 repFromThenTo :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1363 repFromThenTo (MkC x) (MkC y) (MkC z) = rep2 fromThenToEName [x,y,z]
1365 ------------ Match and Clause Tuples -----------
1366 repMatch :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.MatchQ)
1367 repMatch (MkC p) (MkC bod) (MkC ds) = rep2 matchName [p, bod, ds]
1369 repClause :: Core [TH.PatQ] -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.ClauseQ)
1370 repClause (MkC ps) (MkC bod) (MkC ds) = rep2 clauseName [ps, bod, ds]
1372 -------------- Dec -----------------------------
1373 repVal :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1374 repVal (MkC p) (MkC b) (MkC ds) = rep2 valDName [p, b, ds]
1376 repFun :: Core TH.Name -> Core [TH.ClauseQ] -> DsM (Core TH.DecQ)
1377 repFun (MkC nm) (MkC b) = rep2 funDName [nm, b]
1379 repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr]
1380 -> Maybe (Core [TH.TypeQ])
1381 -> Core [TH.ConQ] -> Core [TH.Name] -> DsM (Core TH.DecQ)
1382 repData (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC cons) (MkC derivs)
1383 = rep2 dataDName [cxt, nm, tvs, cons, derivs]
1384 repData (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC cons) (MkC derivs)
1385 = rep2 dataInstDName [cxt, nm, tys, cons, derivs]
1387 repNewtype :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr]
1388 -> Maybe (Core [TH.TypeQ])
1389 -> Core TH.ConQ -> Core [TH.Name] -> DsM (Core TH.DecQ)
1390 repNewtype (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC con) (MkC derivs)
1391 = rep2 newtypeDName [cxt, nm, tvs, con, derivs]
1392 repNewtype (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC con) (MkC derivs)
1393 = rep2 newtypeInstDName [cxt, nm, tys, con, derivs]
1395 repTySyn :: Core TH.Name -> Core [TH.TyVarBndr]
1396 -> Maybe (Core [TH.TypeQ])
1397 -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1398 repTySyn (MkC nm) (MkC tvs) Nothing (MkC rhs)
1399 = rep2 tySynDName [nm, tvs, rhs]
1400 repTySyn (MkC nm) (MkC _) (Just (MkC tys)) (MkC rhs)
1401 = rep2 tySynInstDName [nm, tys, rhs]
1403 repInst :: Core TH.CxtQ -> Core TH.TypeQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1404 repInst (MkC cxt) (MkC ty) (MkC ds) = rep2 instanceDName [cxt, ty, ds]
1406 repClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr]
1407 -> Core [TH.FunDep] -> Core [TH.DecQ]
1408 -> DsM (Core TH.DecQ)
1409 repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds)
1410 = rep2 classDName [cxt, cls, tvs, fds, ds]
1412 repPragInl :: Core TH.Name -> Core TH.InlineSpecQ -> DsM (Core TH.DecQ)
1413 repPragInl (MkC nm) (MkC ispec) = rep2 pragInlDName [nm, ispec]
1415 repPragSpec :: Core TH.Name -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1416 repPragSpec (MkC nm) (MkC ty) = rep2 pragSpecDName [nm, ty]
1418 repPragSpecInl :: Core TH.Name -> Core TH.TypeQ -> Core TH.InlineSpecQ
1419 -> DsM (Core TH.DecQ)
1420 repPragSpecInl (MkC nm) (MkC ty) (MkC ispec)
1421 = rep2 pragSpecInlDName [nm, ty, ispec]
1423 repFamilyNoKind :: Core TH.FamFlavour -> Core TH.Name -> Core [TH.TyVarBndr]
1424 -> DsM (Core TH.DecQ)
1425 repFamilyNoKind (MkC flav) (MkC nm) (MkC tvs)
1426 = rep2 familyNoKindDName [flav, nm, tvs]
1428 repFamilyKind :: Core TH.FamFlavour -> Core TH.Name -> Core [TH.TyVarBndr]
1430 -> DsM (Core TH.DecQ)
1431 repFamilyKind (MkC flav) (MkC nm) (MkC tvs) (MkC ki)
1432 = rep2 familyKindDName [flav, nm, tvs, ki]
1434 repInlineSpecNoPhase :: Core Bool -> Core Bool -> DsM (Core TH.InlineSpecQ)
1435 repInlineSpecNoPhase (MkC inline) (MkC conlike)
1436 = rep2 inlineSpecNoPhaseName [inline, conlike]
1438 repInlineSpecPhase :: Core Bool -> Core Bool -> Core Bool -> Core Int
1439 -> DsM (Core TH.InlineSpecQ)
1440 repInlineSpecPhase (MkC inline) (MkC conlike) (MkC beforeFrom) (MkC phase)
1441 = rep2 inlineSpecPhaseName [inline, conlike, beforeFrom, phase]
1443 repFunDep :: Core [TH.Name] -> Core [TH.Name] -> DsM (Core TH.FunDep)
1444 repFunDep (MkC xs) (MkC ys) = rep2 funDepName [xs, ys]
1446 repProto :: Core TH.Name -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1447 repProto (MkC s) (MkC ty) = rep2 sigDName [s, ty]
1449 repCtxt :: Core [TH.PredQ] -> DsM (Core TH.CxtQ)
1450 repCtxt (MkC tys) = rep2 cxtName [tys]
1452 repClassP :: Core TH.Name -> Core [TH.TypeQ] -> DsM (Core TH.PredQ)
1453 repClassP (MkC cla) (MkC tys) = rep2 classPName [cla, tys]
1455 repEqualP :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.PredQ)
1456 repEqualP (MkC ty1) (MkC ty2) = rep2 equalPName [ty1, ty2]
1458 repConstr :: Core TH.Name -> HsConDeclDetails Name
1459 -> DsM (Core TH.ConQ)
1460 repConstr con (PrefixCon ps)
1461 = do arg_tys <- mapM repBangTy ps
1462 arg_tys1 <- coreList strictTypeQTyConName arg_tys
1463 rep2 normalCName [unC con, unC arg_tys1]
1464 repConstr con (RecCon ips)
1465 = do arg_vs <- mapM lookupLOcc (map cd_fld_name ips)
1466 arg_tys <- mapM repBangTy (map cd_fld_type ips)
1467 arg_vtys <- zipWithM (\x y -> rep2 varStrictTypeName [unC x, unC y])
1469 arg_vtys' <- coreList varStrictTypeQTyConName arg_vtys
1470 rep2 recCName [unC con, unC arg_vtys']
1471 repConstr con (InfixCon st1 st2)
1472 = do arg1 <- repBangTy st1
1473 arg2 <- repBangTy st2
1474 rep2 infixCName [unC arg1, unC con, unC arg2]
1476 ------------ Types -------------------
1478 repTForall :: Core [TH.TyVarBndr] -> Core TH.CxtQ -> Core TH.TypeQ
1479 -> DsM (Core TH.TypeQ)
1480 repTForall (MkC tvars) (MkC ctxt) (MkC ty)
1481 = rep2 forallTName [tvars, ctxt, ty]
1483 repTvar :: Core TH.Name -> DsM (Core TH.TypeQ)
1484 repTvar (MkC s) = rep2 varTName [s]
1486 repTapp :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)
1487 repTapp (MkC t1) (MkC t2) = rep2 appTName [t1, t2]
1489 repTapps :: Core TH.TypeQ -> [Core TH.TypeQ] -> DsM (Core TH.TypeQ)
1490 repTapps f [] = return f
1491 repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
1493 repTSig :: Core TH.TypeQ -> Core TH.Kind -> DsM (Core TH.TypeQ)
1494 repTSig (MkC ty) (MkC ki) = rep2 sigTName [ty, ki]
1496 --------- Type constructors --------------
1498 repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
1499 repNamedTyCon (MkC s) = rep2 conTName [s]
1501 repTupleTyCon :: Int -> DsM (Core TH.TypeQ)
1502 -- Note: not Core Int; it's easier to be direct here
1503 repTupleTyCon i = rep2 tupleTName [mkIntExprInt i]
1505 repArrowTyCon :: DsM (Core TH.TypeQ)
1506 repArrowTyCon = rep2 arrowTName []
1508 repListTyCon :: DsM (Core TH.TypeQ)
1509 repListTyCon = rep2 listTName []
1511 ------------ Kinds -------------------
1513 repPlainTV :: Core TH.Name -> DsM (Core TH.TyVarBndr)
1514 repPlainTV (MkC nm) = rep2 plainTVName [nm]
1516 repKindedTV :: Core TH.Name -> Core TH.Kind -> DsM (Core TH.TyVarBndr)
1517 repKindedTV (MkC nm) (MkC ki) = rep2 kindedTVName [nm, ki]
1519 repStarK :: DsM (Core TH.Kind)
1520 repStarK = rep2 starKName []
1522 repArrowK :: Core TH.Kind -> Core TH.Kind -> DsM (Core TH.Kind)
1523 repArrowK (MkC ki1) (MkC ki2) = rep2 arrowKName [ki1, ki2]
1525 ----------------------------------------------------------
1528 repLiteral :: HsLit -> DsM (Core TH.Lit)
1530 = do lit' <- case lit of
1531 HsIntPrim i -> mk_integer i
1532 HsWordPrim w -> mk_integer w
1533 HsInt i -> mk_integer i
1534 HsFloatPrim r -> mk_rational r
1535 HsDoublePrim r -> mk_rational r
1537 lit_expr <- dsLit lit'
1539 Just lit_name -> rep2 lit_name [lit_expr]
1540 Nothing -> notHandled "Exotic literal" (ppr lit)
1542 mb_lit_name = case lit of
1543 HsInteger _ _ -> Just integerLName
1544 HsInt _ -> Just integerLName
1545 HsIntPrim _ -> Just intPrimLName
1546 HsWordPrim _ -> Just wordPrimLName
1547 HsFloatPrim _ -> Just floatPrimLName
1548 HsDoublePrim _ -> Just doublePrimLName
1549 HsChar _ -> Just charLName
1550 HsString _ -> Just stringLName
1551 HsRat _ _ -> Just rationalLName
1554 mk_integer :: Integer -> DsM HsLit
1555 mk_integer i = do integer_ty <- lookupType integerTyConName
1556 return $ HsInteger i integer_ty
1557 mk_rational :: Rational -> DsM HsLit
1558 mk_rational r = do rat_ty <- lookupType rationalTyConName
1559 return $ HsRat r rat_ty
1560 mk_string :: FastString -> DsM HsLit
1561 mk_string s = return $ HsString s
1563 repOverloadedLiteral :: HsOverLit Name -> DsM (Core TH.Lit)
1564 repOverloadedLiteral (OverLit { ol_val = val})
1565 = do { lit <- mk_lit val; repLiteral lit }
1566 -- The type Rational will be in the environment, becuase
1567 -- the smart constructor 'TH.Syntax.rationalL' uses it in its type,
1568 -- and rationalL is sucked in when any TH stuff is used
1570 mk_lit :: OverLitVal -> DsM HsLit
1571 mk_lit (HsIntegral i) = mk_integer i
1572 mk_lit (HsFractional f) = mk_rational f
1573 mk_lit (HsIsString s) = mk_string s
1575 --------------- Miscellaneous -------------------
1577 repGensym :: Core String -> DsM (Core (TH.Q TH.Name))
1578 repGensym (MkC lit_str) = rep2 newNameName [lit_str]
1580 repBindQ :: Type -> Type -- a and b
1581 -> Core (TH.Q a) -> Core (a -> TH.Q b) -> DsM (Core (TH.Q b))
1582 repBindQ ty_a ty_b (MkC x) (MkC y)
1583 = rep2 bindQName [Type ty_a, Type ty_b, x, y]
1585 repSequenceQ :: Type -> Core [TH.Q a] -> DsM (Core (TH.Q [a]))
1586 repSequenceQ ty_a (MkC list)
1587 = rep2 sequenceQName [Type ty_a, list]
1589 ------------ Lists and Tuples -------------------
1590 -- turn a list of patterns into a single pattern matching a list
1592 coreList :: Name -- Of the TyCon of the element type
1593 -> [Core a] -> DsM (Core [a])
1595 = do { elt_ty <- lookupType tc_name; return (coreList' elt_ty es) }
1597 coreList' :: Type -- The element type
1598 -> [Core a] -> Core [a]
1599 coreList' elt_ty es = MkC (mkListExpr elt_ty (map unC es ))
1601 nonEmptyCoreList :: [Core a] -> Core [a]
1602 -- The list must be non-empty so we can get the element type
1603 -- Otherwise use coreList
1604 nonEmptyCoreList [] = panic "coreList: empty argument"
1605 nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs))
1607 coreStringLit :: String -> DsM (Core String)
1608 coreStringLit s = do { z <- mkStringExpr s; return(MkC z) }
1610 ------------ Bool, Literals & Variables -------------------
1612 coreBool :: Bool -> Core Bool
1613 coreBool False = MkC $ mkConApp falseDataCon []
1614 coreBool True = MkC $ mkConApp trueDataCon []
1616 coreIntLit :: Int -> DsM (Core Int)
1617 coreIntLit i = return (MkC (mkIntExprInt i))
1619 coreVar :: Id -> Core TH.Name -- The Id has type Name
1620 coreVar id = MkC (Var id)
1622 ----------------- Failure -----------------------
1623 notHandled :: String -> SDoc -> DsM a
1624 notHandled what doc = failWithDs msg
1626 msg = hang (text what <+> ptext (sLit "not (yet) handled by Template Haskell"))
1630 -- %************************************************************************
1632 -- The known-key names for Template Haskell
1634 -- %************************************************************************
1636 -- To add a name, do three things
1638 -- 1) Allocate a key
1640 -- 3) Add the name to knownKeyNames
1642 templateHaskellNames :: [Name]
1643 -- The names that are implicitly mentioned by ``bracket''
1644 -- Should stay in sync with the import list of DsMeta
1646 templateHaskellNames = [
1647 returnQName, bindQName, sequenceQName, newNameName, liftName,
1648 mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
1651 charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
1652 floatPrimLName, doublePrimLName, rationalLName,
1654 litPName, varPName, tupPName, conPName, tildePName, bangPName, infixPName,
1655 asPName, wildPName, recPName, listPName, sigPName,
1663 varEName, conEName, litEName, appEName, infixEName,
1664 infixAppName, sectionLName, sectionRName, lamEName, tupEName,
1665 condEName, letEName, caseEName, doEName, compEName,
1666 fromEName, fromThenEName, fromToEName, fromThenToEName,
1667 listEName, sigEName, recConEName, recUpdEName,
1671 guardedBName, normalBName,
1673 normalGEName, patGEName,
1675 bindSName, letSName, noBindSName, parSName,
1677 funDName, valDName, dataDName, newtypeDName, tySynDName,
1678 classDName, instanceDName, sigDName, forImpDName,
1679 pragInlDName, pragSpecDName, pragSpecInlDName,
1680 familyNoKindDName, familyKindDName, dataInstDName, newtypeInstDName,
1685 classPName, equalPName,
1687 isStrictName, notStrictName,
1689 normalCName, recCName, infixCName, forallCName,
1695 forallTName, varTName, conTName, appTName,
1696 tupleTName, arrowTName, listTName, sigTName,
1698 plainTVName, kindedTVName,
1700 starKName, arrowKName,
1702 cCallName, stdCallName,
1708 inlineSpecNoPhaseName, inlineSpecPhaseName,
1712 typeFamName, dataFamName,
1715 qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchQTyConName,
1716 clauseQTyConName, expQTyConName, fieldExpTyConName, predTyConName,
1717 stmtQTyConName, decQTyConName, conQTyConName, strictTypeQTyConName,
1718 varStrictTypeQTyConName, typeQTyConName, expTyConName, decTyConName,
1719 typeTyConName, tyVarBndrTyConName, matchTyConName, clauseTyConName,
1720 patQTyConName, fieldPatQTyConName, fieldExpQTyConName, funDepTyConName,
1724 quoteExpName, quotePatName]
1726 thSyn, thLib, qqLib :: Module
1727 thSyn = mkTHModule (fsLit "Language.Haskell.TH.Syntax")
1728 thLib = mkTHModule (fsLit "Language.Haskell.TH.Lib")
1729 qqLib = mkTHModule (fsLit "Language.Haskell.TH.Quote")
1731 mkTHModule :: FastString -> Module
1732 mkTHModule m = mkModule thPackageId (mkModuleNameFS m)
1734 libFun, libTc, thFun, thTc, qqFun :: FastString -> Unique -> Name
1735 libFun = mk_known_key_name OccName.varName thLib
1736 libTc = mk_known_key_name OccName.tcName thLib
1737 thFun = mk_known_key_name OccName.varName thSyn
1738 thTc = mk_known_key_name OccName.tcName thSyn
1739 qqFun = mk_known_key_name OccName.varName qqLib
1741 -------------------- TH.Syntax -----------------------
1742 qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
1743 fieldPatTyConName, expTyConName, decTyConName, typeTyConName,
1744 tyVarBndrTyConName, matchTyConName, clauseTyConName, funDepTyConName,
1745 predTyConName :: Name
1746 qTyConName = thTc (fsLit "Q") qTyConKey
1747 nameTyConName = thTc (fsLit "Name") nameTyConKey
1748 fieldExpTyConName = thTc (fsLit "FieldExp") fieldExpTyConKey
1749 patTyConName = thTc (fsLit "Pat") patTyConKey
1750 fieldPatTyConName = thTc (fsLit "FieldPat") fieldPatTyConKey
1751 expTyConName = thTc (fsLit "Exp") expTyConKey
1752 decTyConName = thTc (fsLit "Dec") decTyConKey
1753 typeTyConName = thTc (fsLit "Type") typeTyConKey
1754 tyVarBndrTyConName= thTc (fsLit "TyVarBndr") tyVarBndrTyConKey
1755 matchTyConName = thTc (fsLit "Match") matchTyConKey
1756 clauseTyConName = thTc (fsLit "Clause") clauseTyConKey
1757 funDepTyConName = thTc (fsLit "FunDep") funDepTyConKey
1758 predTyConName = thTc (fsLit "Pred") predTyConKey
1760 returnQName, bindQName, sequenceQName, newNameName, liftName,
1761 mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName,
1762 mkNameLName, liftStringName :: Name
1763 returnQName = thFun (fsLit "returnQ") returnQIdKey
1764 bindQName = thFun (fsLit "bindQ") bindQIdKey
1765 sequenceQName = thFun (fsLit "sequenceQ") sequenceQIdKey
1766 newNameName = thFun (fsLit "newName") newNameIdKey
1767 liftName = thFun (fsLit "lift") liftIdKey
1768 liftStringName = thFun (fsLit "liftString") liftStringIdKey
1769 mkNameName = thFun (fsLit "mkName") mkNameIdKey
1770 mkNameG_vName = thFun (fsLit "mkNameG_v") mkNameG_vIdKey
1771 mkNameG_dName = thFun (fsLit "mkNameG_d") mkNameG_dIdKey
1772 mkNameG_tcName = thFun (fsLit "mkNameG_tc") mkNameG_tcIdKey
1773 mkNameLName = thFun (fsLit "mkNameL") mkNameLIdKey
1776 -------------------- TH.Lib -----------------------
1778 charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
1779 floatPrimLName, doublePrimLName, rationalLName :: Name
1780 charLName = libFun (fsLit "charL") charLIdKey
1781 stringLName = libFun (fsLit "stringL") stringLIdKey
1782 integerLName = libFun (fsLit "integerL") integerLIdKey
1783 intPrimLName = libFun (fsLit "intPrimL") intPrimLIdKey
1784 wordPrimLName = libFun (fsLit "wordPrimL") wordPrimLIdKey
1785 floatPrimLName = libFun (fsLit "floatPrimL") floatPrimLIdKey
1786 doublePrimLName = libFun (fsLit "doublePrimL") doublePrimLIdKey
1787 rationalLName = libFun (fsLit "rationalL") rationalLIdKey
1790 litPName, varPName, tupPName, conPName, infixPName, tildePName, bangPName,
1791 asPName, wildPName, recPName, listPName, sigPName :: Name
1792 litPName = libFun (fsLit "litP") litPIdKey
1793 varPName = libFun (fsLit "varP") varPIdKey
1794 tupPName = libFun (fsLit "tupP") tupPIdKey
1795 conPName = libFun (fsLit "conP") conPIdKey
1796 infixPName = libFun (fsLit "infixP") infixPIdKey
1797 tildePName = libFun (fsLit "tildeP") tildePIdKey
1798 bangPName = libFun (fsLit "bangP") bangPIdKey
1799 asPName = libFun (fsLit "asP") asPIdKey
1800 wildPName = libFun (fsLit "wildP") wildPIdKey
1801 recPName = libFun (fsLit "recP") recPIdKey
1802 listPName = libFun (fsLit "listP") listPIdKey
1803 sigPName = libFun (fsLit "sigP") sigPIdKey
1805 -- type FieldPat = ...
1806 fieldPatName :: Name
1807 fieldPatName = libFun (fsLit "fieldPat") fieldPatIdKey
1811 matchName = libFun (fsLit "match") matchIdKey
1813 -- data Clause = ...
1815 clauseName = libFun (fsLit "clause") clauseIdKey
1818 varEName, conEName, litEName, appEName, infixEName, infixAppName,
1819 sectionLName, sectionRName, lamEName, tupEName, condEName,
1820 letEName, caseEName, doEName, compEName :: Name
1821 varEName = libFun (fsLit "varE") varEIdKey
1822 conEName = libFun (fsLit "conE") conEIdKey
1823 litEName = libFun (fsLit "litE") litEIdKey
1824 appEName = libFun (fsLit "appE") appEIdKey
1825 infixEName = libFun (fsLit "infixE") infixEIdKey
1826 infixAppName = libFun (fsLit "infixApp") infixAppIdKey
1827 sectionLName = libFun (fsLit "sectionL") sectionLIdKey
1828 sectionRName = libFun (fsLit "sectionR") sectionRIdKey
1829 lamEName = libFun (fsLit "lamE") lamEIdKey
1830 tupEName = libFun (fsLit "tupE") tupEIdKey
1831 condEName = libFun (fsLit "condE") condEIdKey
1832 letEName = libFun (fsLit "letE") letEIdKey
1833 caseEName = libFun (fsLit "caseE") caseEIdKey
1834 doEName = libFun (fsLit "doE") doEIdKey
1835 compEName = libFun (fsLit "compE") compEIdKey
1836 -- ArithSeq skips a level
1837 fromEName, fromThenEName, fromToEName, fromThenToEName :: Name
1838 fromEName = libFun (fsLit "fromE") fromEIdKey
1839 fromThenEName = libFun (fsLit "fromThenE") fromThenEIdKey
1840 fromToEName = libFun (fsLit "fromToE") fromToEIdKey
1841 fromThenToEName = libFun (fsLit "fromThenToE") fromThenToEIdKey
1843 listEName, sigEName, recConEName, recUpdEName :: Name
1844 listEName = libFun (fsLit "listE") listEIdKey
1845 sigEName = libFun (fsLit "sigE") sigEIdKey
1846 recConEName = libFun (fsLit "recConE") recConEIdKey
1847 recUpdEName = libFun (fsLit "recUpdE") recUpdEIdKey
1849 -- type FieldExp = ...
1850 fieldExpName :: Name
1851 fieldExpName = libFun (fsLit "fieldExp") fieldExpIdKey
1854 guardedBName, normalBName :: Name
1855 guardedBName = libFun (fsLit "guardedB") guardedBIdKey
1856 normalBName = libFun (fsLit "normalB") normalBIdKey
1859 normalGEName, patGEName :: Name
1860 normalGEName = libFun (fsLit "normalGE") normalGEIdKey
1861 patGEName = libFun (fsLit "patGE") patGEIdKey
1864 bindSName, letSName, noBindSName, parSName :: Name
1865 bindSName = libFun (fsLit "bindS") bindSIdKey
1866 letSName = libFun (fsLit "letS") letSIdKey
1867 noBindSName = libFun (fsLit "noBindS") noBindSIdKey
1868 parSName = libFun (fsLit "parS") parSIdKey
1871 funDName, valDName, dataDName, newtypeDName, tySynDName, classDName,
1872 instanceDName, sigDName, forImpDName, pragInlDName, pragSpecDName,
1873 pragSpecInlDName, familyNoKindDName, familyKindDName, dataInstDName,
1874 newtypeInstDName, tySynInstDName :: Name
1875 funDName = libFun (fsLit "funD") funDIdKey
1876 valDName = libFun (fsLit "valD") valDIdKey
1877 dataDName = libFun (fsLit "dataD") dataDIdKey
1878 newtypeDName = libFun (fsLit "newtypeD") newtypeDIdKey
1879 tySynDName = libFun (fsLit "tySynD") tySynDIdKey
1880 classDName = libFun (fsLit "classD") classDIdKey
1881 instanceDName = libFun (fsLit "instanceD") instanceDIdKey
1882 sigDName = libFun (fsLit "sigD") sigDIdKey
1883 forImpDName = libFun (fsLit "forImpD") forImpDIdKey
1884 pragInlDName = libFun (fsLit "pragInlD") pragInlDIdKey
1885 pragSpecDName = libFun (fsLit "pragSpecD") pragSpecDIdKey
1886 pragSpecInlDName = libFun (fsLit "pragSpecInlD") pragSpecInlDIdKey
1887 familyNoKindDName= libFun (fsLit "familyNoKindD")familyNoKindDIdKey
1888 familyKindDName = libFun (fsLit "familyKindD") familyKindDIdKey
1889 dataInstDName = libFun (fsLit "dataInstD") dataInstDIdKey
1890 newtypeInstDName = libFun (fsLit "newtypeInstD") newtypeInstDIdKey
1891 tySynInstDName = libFun (fsLit "tySynInstD") tySynInstDIdKey
1895 cxtName = libFun (fsLit "cxt") cxtIdKey
1898 classPName, equalPName :: Name
1899 classPName = libFun (fsLit "classP") classPIdKey
1900 equalPName = libFun (fsLit "equalP") equalPIdKey
1902 -- data Strict = ...
1903 isStrictName, notStrictName :: Name
1904 isStrictName = libFun (fsLit "isStrict") isStrictKey
1905 notStrictName = libFun (fsLit "notStrict") notStrictKey
1908 normalCName, recCName, infixCName, forallCName :: Name
1909 normalCName = libFun (fsLit "normalC") normalCIdKey
1910 recCName = libFun (fsLit "recC") recCIdKey
1911 infixCName = libFun (fsLit "infixC") infixCIdKey
1912 forallCName = libFun (fsLit "forallC") forallCIdKey
1914 -- type StrictType = ...
1915 strictTypeName :: Name
1916 strictTypeName = libFun (fsLit "strictType") strictTKey
1918 -- type VarStrictType = ...
1919 varStrictTypeName :: Name
1920 varStrictTypeName = libFun (fsLit "varStrictType") varStrictTKey
1923 forallTName, varTName, conTName, tupleTName, arrowTName,
1924 listTName, appTName, sigTName :: Name
1925 forallTName = libFun (fsLit "forallT") forallTIdKey
1926 varTName = libFun (fsLit "varT") varTIdKey
1927 conTName = libFun (fsLit "conT") conTIdKey
1928 tupleTName = libFun (fsLit "tupleT") tupleTIdKey
1929 arrowTName = libFun (fsLit "arrowT") arrowTIdKey
1930 listTName = libFun (fsLit "listT") listTIdKey
1931 appTName = libFun (fsLit "appT") appTIdKey
1932 sigTName = libFun (fsLit "sigT") sigTIdKey
1934 -- data TyVarBndr = ...
1935 plainTVName, kindedTVName :: Name
1936 plainTVName = libFun (fsLit "plainTV") plainTVIdKey
1937 kindedTVName = libFun (fsLit "kindedTV") kindedTVIdKey
1940 starKName, arrowKName :: Name
1941 starKName = libFun (fsLit "starK") starKIdKey
1942 arrowKName = libFun (fsLit "arrowK") arrowKIdKey
1944 -- data Callconv = ...
1945 cCallName, stdCallName :: Name
1946 cCallName = libFun (fsLit "cCall") cCallIdKey
1947 stdCallName = libFun (fsLit "stdCall") stdCallIdKey
1949 -- data Safety = ...
1950 unsafeName, safeName, threadsafeName :: Name
1951 unsafeName = libFun (fsLit "unsafe") unsafeIdKey
1952 safeName = libFun (fsLit "safe") safeIdKey
1953 threadsafeName = libFun (fsLit "threadsafe") threadsafeIdKey
1955 -- data InlineSpec = ...
1956 inlineSpecNoPhaseName, inlineSpecPhaseName :: Name
1957 inlineSpecNoPhaseName = libFun (fsLit "inlineSpecNoPhase") inlineSpecNoPhaseIdKey
1958 inlineSpecPhaseName = libFun (fsLit "inlineSpecPhase") inlineSpecPhaseIdKey
1960 -- data FunDep = ...
1962 funDepName = libFun (fsLit "funDep") funDepIdKey
1964 -- data FamFlavour = ...
1965 typeFamName, dataFamName :: Name
1966 typeFamName = libFun (fsLit "typeFam") typeFamIdKey
1967 dataFamName = libFun (fsLit "dataFam") dataFamIdKey
1969 matchQTyConName, clauseQTyConName, expQTyConName, stmtQTyConName,
1970 decQTyConName, conQTyConName, strictTypeQTyConName,
1971 varStrictTypeQTyConName, typeQTyConName, fieldExpQTyConName,
1972 patQTyConName, fieldPatQTyConName, predQTyConName :: Name
1973 matchQTyConName = libTc (fsLit "MatchQ") matchQTyConKey
1974 clauseQTyConName = libTc (fsLit "ClauseQ") clauseQTyConKey
1975 expQTyConName = libTc (fsLit "ExpQ") expQTyConKey
1976 stmtQTyConName = libTc (fsLit "StmtQ") stmtQTyConKey
1977 decQTyConName = libTc (fsLit "DecQ") decQTyConKey
1978 conQTyConName = libTc (fsLit "ConQ") conQTyConKey
1979 strictTypeQTyConName = libTc (fsLit "StrictTypeQ") strictTypeQTyConKey
1980 varStrictTypeQTyConName = libTc (fsLit "VarStrictTypeQ") varStrictTypeQTyConKey
1981 typeQTyConName = libTc (fsLit "TypeQ") typeQTyConKey
1982 fieldExpQTyConName = libTc (fsLit "FieldExpQ") fieldExpQTyConKey
1983 patQTyConName = libTc (fsLit "PatQ") patQTyConKey
1984 fieldPatQTyConName = libTc (fsLit "FieldPatQ") fieldPatQTyConKey
1985 predQTyConName = libTc (fsLit "PredQ") predQTyConKey
1988 quoteExpName, quotePatName :: Name
1989 quoteExpName = qqFun (fsLit "quoteExp") quoteExpKey
1990 quotePatName = qqFun (fsLit "quotePat") quotePatKey
1992 -- TyConUniques available: 100-129
1993 -- Check in PrelNames if you want to change this
1995 expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,
1996 decQTyConKey, patTyConKey, matchQTyConKey, clauseQTyConKey,
1997 stmtQTyConKey, conQTyConKey, typeQTyConKey, typeTyConKey, tyVarBndrTyConKey,
1998 decTyConKey, varStrictTypeQTyConKey, strictTypeQTyConKey,
1999 fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey,
2000 fieldPatQTyConKey, fieldExpQTyConKey, funDepTyConKey, predTyConKey,
2001 predQTyConKey :: Unique
2002 expTyConKey = mkPreludeTyConUnique 100
2003 matchTyConKey = mkPreludeTyConUnique 101
2004 clauseTyConKey = mkPreludeTyConUnique 102
2005 qTyConKey = mkPreludeTyConUnique 103
2006 expQTyConKey = mkPreludeTyConUnique 104
2007 decQTyConKey = mkPreludeTyConUnique 105
2008 patTyConKey = mkPreludeTyConUnique 106
2009 matchQTyConKey = mkPreludeTyConUnique 107
2010 clauseQTyConKey = mkPreludeTyConUnique 108
2011 stmtQTyConKey = mkPreludeTyConUnique 109
2012 conQTyConKey = mkPreludeTyConUnique 110
2013 typeQTyConKey = mkPreludeTyConUnique 111
2014 typeTyConKey = mkPreludeTyConUnique 112
2015 tyVarBndrTyConKey = mkPreludeTyConUnique 125
2016 decTyConKey = mkPreludeTyConUnique 113
2017 varStrictTypeQTyConKey = mkPreludeTyConUnique 114
2018 strictTypeQTyConKey = mkPreludeTyConUnique 115
2019 fieldExpTyConKey = mkPreludeTyConUnique 116
2020 fieldPatTyConKey = mkPreludeTyConUnique 117
2021 nameTyConKey = mkPreludeTyConUnique 118
2022 patQTyConKey = mkPreludeTyConUnique 119
2023 fieldPatQTyConKey = mkPreludeTyConUnique 120
2024 fieldExpQTyConKey = mkPreludeTyConUnique 121
2025 funDepTyConKey = mkPreludeTyConUnique 122
2026 predTyConKey = mkPreludeTyConUnique 123
2027 predQTyConKey = mkPreludeTyConUnique 124
2029 -- IdUniques available: 200-399
2030 -- If you want to change this, make sure you check in PrelNames
2032 returnQIdKey, bindQIdKey, sequenceQIdKey, liftIdKey, newNameIdKey,
2033 mkNameIdKey, mkNameG_vIdKey, mkNameG_dIdKey, mkNameG_tcIdKey,
2034 mkNameLIdKey :: Unique
2035 returnQIdKey = mkPreludeMiscIdUnique 200
2036 bindQIdKey = mkPreludeMiscIdUnique 201
2037 sequenceQIdKey = mkPreludeMiscIdUnique 202
2038 liftIdKey = mkPreludeMiscIdUnique 203
2039 newNameIdKey = mkPreludeMiscIdUnique 204
2040 mkNameIdKey = mkPreludeMiscIdUnique 205
2041 mkNameG_vIdKey = mkPreludeMiscIdUnique 206
2042 mkNameG_dIdKey = mkPreludeMiscIdUnique 207
2043 mkNameG_tcIdKey = mkPreludeMiscIdUnique 208
2044 mkNameLIdKey = mkPreludeMiscIdUnique 209
2048 charLIdKey, stringLIdKey, integerLIdKey, intPrimLIdKey, wordPrimLIdKey,
2049 floatPrimLIdKey, doublePrimLIdKey, rationalLIdKey :: Unique
2050 charLIdKey = mkPreludeMiscIdUnique 210
2051 stringLIdKey = mkPreludeMiscIdUnique 211
2052 integerLIdKey = mkPreludeMiscIdUnique 212
2053 intPrimLIdKey = mkPreludeMiscIdUnique 213
2054 wordPrimLIdKey = mkPreludeMiscIdUnique 214
2055 floatPrimLIdKey = mkPreludeMiscIdUnique 215
2056 doublePrimLIdKey = mkPreludeMiscIdUnique 216
2057 rationalLIdKey = mkPreludeMiscIdUnique 217
2059 liftStringIdKey :: Unique
2060 liftStringIdKey = mkPreludeMiscIdUnique 218
2063 litPIdKey, varPIdKey, tupPIdKey, conPIdKey, infixPIdKey, tildePIdKey, bangPIdKey,
2064 asPIdKey, wildPIdKey, recPIdKey, listPIdKey, sigPIdKey :: Unique
2065 litPIdKey = mkPreludeMiscIdUnique 220
2066 varPIdKey = mkPreludeMiscIdUnique 221
2067 tupPIdKey = mkPreludeMiscIdUnique 222
2068 conPIdKey = mkPreludeMiscIdUnique 223
2069 infixPIdKey = mkPreludeMiscIdUnique 312
2070 tildePIdKey = mkPreludeMiscIdUnique 224
2071 bangPIdKey = mkPreludeMiscIdUnique 359
2072 asPIdKey = mkPreludeMiscIdUnique 225
2073 wildPIdKey = mkPreludeMiscIdUnique 226
2074 recPIdKey = mkPreludeMiscIdUnique 227
2075 listPIdKey = mkPreludeMiscIdUnique 228
2076 sigPIdKey = mkPreludeMiscIdUnique 229
2078 -- type FieldPat = ...
2079 fieldPatIdKey :: Unique
2080 fieldPatIdKey = mkPreludeMiscIdUnique 230
2083 matchIdKey :: Unique
2084 matchIdKey = mkPreludeMiscIdUnique 231
2086 -- data Clause = ...
2087 clauseIdKey :: Unique
2088 clauseIdKey = mkPreludeMiscIdUnique 232
2092 varEIdKey, conEIdKey, litEIdKey, appEIdKey, infixEIdKey, infixAppIdKey,
2093 sectionLIdKey, sectionRIdKey, lamEIdKey, tupEIdKey, condEIdKey,
2094 letEIdKey, caseEIdKey, doEIdKey, compEIdKey,
2095 fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey,
2096 listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey :: Unique
2097 varEIdKey = mkPreludeMiscIdUnique 240
2098 conEIdKey = mkPreludeMiscIdUnique 241
2099 litEIdKey = mkPreludeMiscIdUnique 242
2100 appEIdKey = mkPreludeMiscIdUnique 243
2101 infixEIdKey = mkPreludeMiscIdUnique 244
2102 infixAppIdKey = mkPreludeMiscIdUnique 245
2103 sectionLIdKey = mkPreludeMiscIdUnique 246
2104 sectionRIdKey = mkPreludeMiscIdUnique 247
2105 lamEIdKey = mkPreludeMiscIdUnique 248
2106 tupEIdKey = mkPreludeMiscIdUnique 249
2107 condEIdKey = mkPreludeMiscIdUnique 250
2108 letEIdKey = mkPreludeMiscIdUnique 251
2109 caseEIdKey = mkPreludeMiscIdUnique 252
2110 doEIdKey = mkPreludeMiscIdUnique 253
2111 compEIdKey = mkPreludeMiscIdUnique 254
2112 fromEIdKey = mkPreludeMiscIdUnique 255
2113 fromThenEIdKey = mkPreludeMiscIdUnique 256
2114 fromToEIdKey = mkPreludeMiscIdUnique 257
2115 fromThenToEIdKey = mkPreludeMiscIdUnique 258
2116 listEIdKey = mkPreludeMiscIdUnique 259
2117 sigEIdKey = mkPreludeMiscIdUnique 260
2118 recConEIdKey = mkPreludeMiscIdUnique 261
2119 recUpdEIdKey = mkPreludeMiscIdUnique 262
2121 -- type FieldExp = ...
2122 fieldExpIdKey :: Unique
2123 fieldExpIdKey = mkPreludeMiscIdUnique 265
2126 guardedBIdKey, normalBIdKey :: Unique
2127 guardedBIdKey = mkPreludeMiscIdUnique 266
2128 normalBIdKey = mkPreludeMiscIdUnique 267
2131 normalGEIdKey, patGEIdKey :: Unique
2132 normalGEIdKey = mkPreludeMiscIdUnique 310
2133 patGEIdKey = mkPreludeMiscIdUnique 311
2136 bindSIdKey, letSIdKey, noBindSIdKey, parSIdKey :: Unique
2137 bindSIdKey = mkPreludeMiscIdUnique 268
2138 letSIdKey = mkPreludeMiscIdUnique 269
2139 noBindSIdKey = mkPreludeMiscIdUnique 270
2140 parSIdKey = mkPreludeMiscIdUnique 271
2143 funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey,
2144 classDIdKey, instanceDIdKey, sigDIdKey, forImpDIdKey, pragInlDIdKey,
2145 pragSpecDIdKey, pragSpecInlDIdKey, familyNoKindDIdKey, familyKindDIdKey,
2146 dataInstDIdKey, newtypeInstDIdKey, tySynInstDIdKey :: Unique
2147 funDIdKey = mkPreludeMiscIdUnique 272
2148 valDIdKey = mkPreludeMiscIdUnique 273
2149 dataDIdKey = mkPreludeMiscIdUnique 274
2150 newtypeDIdKey = mkPreludeMiscIdUnique 275
2151 tySynDIdKey = mkPreludeMiscIdUnique 276
2152 classDIdKey = mkPreludeMiscIdUnique 277
2153 instanceDIdKey = mkPreludeMiscIdUnique 278
2154 sigDIdKey = mkPreludeMiscIdUnique 279
2155 forImpDIdKey = mkPreludeMiscIdUnique 297
2156 pragInlDIdKey = mkPreludeMiscIdUnique 348
2157 pragSpecDIdKey = mkPreludeMiscIdUnique 349
2158 pragSpecInlDIdKey = mkPreludeMiscIdUnique 352
2159 familyNoKindDIdKey= mkPreludeMiscIdUnique 340
2160 familyKindDIdKey = mkPreludeMiscIdUnique 353
2161 dataInstDIdKey = mkPreludeMiscIdUnique 341
2162 newtypeInstDIdKey = mkPreludeMiscIdUnique 342
2163 tySynInstDIdKey = mkPreludeMiscIdUnique 343
2167 cxtIdKey = mkPreludeMiscIdUnique 280
2170 classPIdKey, equalPIdKey :: Unique
2171 classPIdKey = mkPreludeMiscIdUnique 346
2172 equalPIdKey = mkPreludeMiscIdUnique 347
2174 -- data Strict = ...
2175 isStrictKey, notStrictKey :: Unique
2176 isStrictKey = mkPreludeMiscIdUnique 281
2177 notStrictKey = mkPreludeMiscIdUnique 282
2180 normalCIdKey, recCIdKey, infixCIdKey, forallCIdKey :: Unique
2181 normalCIdKey = mkPreludeMiscIdUnique 283
2182 recCIdKey = mkPreludeMiscIdUnique 284
2183 infixCIdKey = mkPreludeMiscIdUnique 285
2184 forallCIdKey = mkPreludeMiscIdUnique 288
2186 -- type StrictType = ...
2187 strictTKey :: Unique
2188 strictTKey = mkPreludeMiscIdUnique 286
2190 -- type VarStrictType = ...
2191 varStrictTKey :: Unique
2192 varStrictTKey = mkPreludeMiscIdUnique 287
2195 forallTIdKey, varTIdKey, conTIdKey, tupleTIdKey, arrowTIdKey,
2196 listTIdKey, appTIdKey, sigTIdKey :: Unique
2197 forallTIdKey = mkPreludeMiscIdUnique 290
2198 varTIdKey = mkPreludeMiscIdUnique 291
2199 conTIdKey = mkPreludeMiscIdUnique 292
2200 tupleTIdKey = mkPreludeMiscIdUnique 294
2201 arrowTIdKey = mkPreludeMiscIdUnique 295
2202 listTIdKey = mkPreludeMiscIdUnique 296
2203 appTIdKey = mkPreludeMiscIdUnique 293
2204 sigTIdKey = mkPreludeMiscIdUnique 358
2206 -- data TyVarBndr = ...
2207 plainTVIdKey, kindedTVIdKey :: Unique
2208 plainTVIdKey = mkPreludeMiscIdUnique 354
2209 kindedTVIdKey = mkPreludeMiscIdUnique 355
2212 starKIdKey, arrowKIdKey :: Unique
2213 starKIdKey = mkPreludeMiscIdUnique 356
2214 arrowKIdKey = mkPreludeMiscIdUnique 357
2216 -- data Callconv = ...
2217 cCallIdKey, stdCallIdKey :: Unique
2218 cCallIdKey = mkPreludeMiscIdUnique 300
2219 stdCallIdKey = mkPreludeMiscIdUnique 301
2221 -- data Safety = ...
2222 unsafeIdKey, safeIdKey, threadsafeIdKey :: Unique
2223 unsafeIdKey = mkPreludeMiscIdUnique 305
2224 safeIdKey = mkPreludeMiscIdUnique 306
2225 threadsafeIdKey = mkPreludeMiscIdUnique 307
2227 -- data InlineSpec =
2228 inlineSpecNoPhaseIdKey, inlineSpecPhaseIdKey :: Unique
2229 inlineSpecNoPhaseIdKey = mkPreludeMiscIdUnique 350
2230 inlineSpecPhaseIdKey = mkPreludeMiscIdUnique 351
2232 -- data FunDep = ...
2233 funDepIdKey :: Unique
2234 funDepIdKey = mkPreludeMiscIdUnique 320
2236 -- data FamFlavour = ...
2237 typeFamIdKey, dataFamIdKey :: Unique
2238 typeFamIdKey = mkPreludeMiscIdUnique 344
2239 dataFamIdKey = mkPreludeMiscIdUnique 345
2242 quoteExpKey, quotePatKey :: Unique
2243 quoteExpKey = mkPreludeMiscIdUnique 321
2244 quotePatKey = mkPreludeMiscIdUnique 322