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 {-# OPTIONS -fno-warn-unused-imports #-}
17 -- The above warning supression flag is a temporary kludge.
18 -- While working on this module you are encouraged to remove it and fix
19 -- any warnings in the module. See
20 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
22 -- The kludge is only needed in this module because of trac #2267.
24 module DsMeta( dsBracket,
25 templateHaskellNames, qTyConName, nameTyConName,
26 liftName, expQTyConName, patQTyConName, decQTyConName, typeQTyConName,
27 decTyConName, typeTyConName, mkNameG_dName, mkNameG_vName, mkNameG_tcName,
28 quoteExpName, quotePatName
31 #include "HsVersions.h"
33 import {-# SOURCE #-} DsExpr ( dsExpr )
39 import qualified Language.Haskell.TH as TH
44 -- To avoid clashes with DsMeta.varName we must make a local alias for
45 -- OccName.varName we do this by removing varName from the import of
46 -- OccName above, making a qualified instance of OccName and using
47 -- OccNameAlias.varName where varName ws previously used in this file.
48 import qualified OccName
73 -----------------------------------------------------------------------------
74 dsBracket :: HsBracket Name -> [PendingSplice] -> DsM CoreExpr
75 -- Returns a CoreExpr of type TH.ExpQ
76 -- The quoted thing is parameterised over Name, even though it has
77 -- been type checked. We don't want all those type decorations!
79 dsBracket brack splices
80 = dsExtendMetaEnv new_bit (do_brack brack)
82 new_bit = mkNameEnv [(n, Splice (unLoc e)) | (n,e) <- splices]
84 do_brack (VarBr n) = do { MkC e1 <- lookupOcc n ; return e1 }
85 do_brack (ExpBr e) = do { MkC e1 <- repLE e ; return e1 }
86 do_brack (PatBr p) = do { MkC p1 <- repLP p ; return p1 }
87 do_brack (TypBr t) = do { MkC t1 <- repLTy t ; return t1 }
88 do_brack (DecBr ds) = do { MkC ds1 <- repTopDs ds ; return ds1 }
90 {- -------------- Examples --------------------
94 gensym (unpackString "x"#) `bindQ` \ x1::String ->
95 lam (pvar x1) (var x1)
98 [| \x -> $(f [| x |]) |]
100 gensym (unpackString "x"#) `bindQ` \ x1::String ->
101 lam (pvar x1) (f (var x1))
105 -------------------------------------------------------
107 -------------------------------------------------------
109 repTopDs :: HsGroup Name -> DsM (Core (TH.Q [TH.Dec]))
111 = do { let { bndrs = map unLoc (groupBinders group) } ;
112 ss <- mkGenSyms bndrs ;
114 -- Bind all the names mainly to avoid repeated use of explicit strings.
116 -- do { t :: String <- genSym "T" ;
117 -- return (Data t [] ...more t's... }
118 -- The other important reason is that the output must mention
119 -- only "T", not "Foo:T" where Foo is the current module
122 decls <- addBinds ss (do {
123 val_ds <- rep_val_binds (hs_valds group) ;
124 tycl_ds <- mapM repTyClD (hs_tyclds group) ;
125 inst_ds <- mapM repInstD' (hs_instds group) ;
126 for_ds <- mapM repForD (hs_fords group) ;
128 return (de_loc $ sort_by_loc $ val_ds ++ catMaybes tycl_ds ++ inst_ds ++ for_ds) }) ;
130 decl_ty <- lookupType decQTyConName ;
131 let { core_list = coreList' decl_ty decls } ;
133 dec_ty <- lookupType decTyConName ;
134 q_decs <- repSequenceQ dec_ty core_list ;
136 wrapNongenSyms ss q_decs
137 -- Do *not* gensym top-level binders
140 groupBinders :: HsGroup Name -> [Located Name]
141 groupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
142 hs_instds = inst_decls, hs_fords = foreign_decls })
143 -- Collect the binders of a Group
144 = collectHsValBinders val_decls ++
145 [n | d <- tycl_decls ++ assoc_tycl_decls, n <- tyClDeclNames (unLoc d)] ++
146 [n | L _ (ForeignImport n _ _) <- foreign_decls]
148 assoc_tycl_decls = concat [ats | L _ (InstDecl _ _ _ ats) <- inst_decls]
151 {- Note [Binders and occurrences]
152 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
153 When we desugar [d| data T = MkT |]
155 Data "T" [] [Con "MkT" []] []
157 Data "Foo:T" [] [Con "Foo:MkT" []] []
158 That is, the new data decl should fit into whatever new module it is
159 asked to fit in. We do *not* clone, though; no need for this:
166 then we must desugar to
167 foo = Data "Foo:T" [] [Con "Foo:MkT" []] []
169 So in repTopDs we bring the binders into scope with mkGenSyms and addBinds.
170 And we use lookupOcc, rather than lookupBinder
171 in repTyClD and repC.
175 repTyClD :: LTyClDecl Name -> DsM (Maybe (SrcSpan, Core TH.DecQ))
177 repTyClD tydecl@(L _ (TyFamily {}))
178 = repTyFamily tydecl addTyVarBinds
180 repTyClD (L loc (TyData { tcdND = DataType, tcdCtxt = cxt,
181 tcdLName = tc, tcdTyVars = tvs, tcdTyPats = opt_tys,
182 tcdCons = cons, tcdDerivs = mb_derivs }))
183 = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences]
184 ; dec <- addTyVarBinds tvs $ \bndrs ->
185 do { cxt1 <- repLContext cxt
186 ; opt_tys1 <- maybeMapM repLTys opt_tys -- only for family insts
187 ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1
188 ; cons1 <- mapM repC cons
189 ; cons2 <- coreList conQTyConName cons1
190 ; derivs1 <- repDerivs mb_derivs
191 ; bndrs1 <- coreList nameTyConName bndrs
192 ; repData cxt1 tc1 bndrs1 opt_tys2 cons2 derivs1
194 ; return $ Just (loc, dec)
197 repTyClD (L loc (TyData { tcdND = NewType, tcdCtxt = cxt,
198 tcdLName = tc, tcdTyVars = tvs, tcdTyPats = opt_tys,
199 tcdCons = [con], tcdDerivs = mb_derivs }))
200 = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences]
201 ; dec <- addTyVarBinds tvs $ \bndrs ->
202 do { cxt1 <- repLContext cxt
203 ; opt_tys1 <- maybeMapM repLTys opt_tys -- only for family insts
204 ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1
206 ; derivs1 <- repDerivs mb_derivs
207 ; bndrs1 <- coreList nameTyConName bndrs
208 ; repNewtype cxt1 tc1 bndrs1 opt_tys2 con1 derivs1
210 ; return $ Just (loc, dec)
213 repTyClD (L loc (TySynonym { tcdLName = tc, tcdTyVars = tvs, tcdTyPats = opt_tys,
215 = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences]
216 ; dec <- addTyVarBinds tvs $ \bndrs ->
217 do { opt_tys1 <- maybeMapM repLTys opt_tys -- only for family insts
218 ; opt_tys2 <- maybeMapM (coreList typeQTyConName) opt_tys1
220 ; bndrs1 <- coreList nameTyConName bndrs
221 ; repTySyn tc1 bndrs1 opt_tys2 ty1
223 ; return (Just (loc, dec))
226 repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
227 tcdTyVars = tvs, tcdFDs = fds,
228 tcdSigs = sigs, tcdMeths = meth_binds,
230 = do { cls1 <- lookupLOcc cls -- See note [Binders and occurrences]
231 ; dec <- addTyVarBinds tvs $ \bndrs ->
232 do { cxt1 <- repLContext cxt
233 ; sigs1 <- rep_sigs sigs
234 ; binds1 <- rep_binds meth_binds
235 ; fds1 <- repLFunDeps fds
236 ; ats1 <- repLAssocFamilys ats
237 ; decls1 <- coreList decQTyConName (ats1 ++ sigs1 ++ binds1)
238 ; bndrs1 <- coreList nameTyConName bndrs
239 ; repClass cxt1 cls1 bndrs1 fds1 decls1
241 ; return $ Just (loc, dec)
245 repTyClD (L loc d) = putSrcSpanDs loc $
246 do { warnDs (hang ds_msg 4 (ppr d))
249 -- The type variables in the head of families are treated differently when the
250 -- family declaration is associated. In that case, they are usage, not binding
253 repTyFamily :: LTyClDecl Name
254 -> ProcessTyVarBinds TH.Dec
255 -> DsM (Maybe (SrcSpan, Core TH.DecQ))
256 repTyFamily (L loc (TyFamily { tcdFlavour = flavour,
257 tcdLName = tc, tcdTyVars = tvs,
260 = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences]
261 ; dec <- tyVarBinds tvs $ \bndrs ->
262 do { flav <- repFamilyFlavour flavour
263 ; bndrs1 <- coreList nameTyConName bndrs
264 ; repFamily flav tc1 bndrs1
266 ; return $ Just (loc, dec)
268 repTyFamily _ _ = panic "DsMeta.repTyFamily: internal error"
272 repLFunDeps :: [Located (FunDep Name)] -> DsM (Core [TH.FunDep])
273 repLFunDeps fds = do fds' <- mapM repLFunDep fds
274 fdList <- coreList funDepTyConName fds'
277 repLFunDep :: Located (FunDep Name) -> DsM (Core TH.FunDep)
278 repLFunDep (L _ (xs, ys)) = do xs' <- mapM lookupBinder xs
279 ys' <- mapM lookupBinder ys
280 xs_list <- coreList nameTyConName xs'
281 ys_list <- coreList nameTyConName ys'
282 repFunDep xs_list ys_list
284 -- represent family declaration flavours
286 repFamilyFlavour :: FamilyFlavour -> DsM (Core TH.FamFlavour)
287 repFamilyFlavour TypeFamily = rep2 typeFamName []
288 repFamilyFlavour DataFamily = rep2 dataFamName []
290 -- represent associated family declarations
292 repLAssocFamilys :: [LTyClDecl Name] -> DsM [Core TH.DecQ]
293 repLAssocFamilys = mapM repLAssocFamily
295 repLAssocFamily tydecl@(L _ (TyFamily {}))
296 = liftM (snd . fromJust) $ repTyFamily tydecl lookupTyVarBinds
297 repLAssocFamily tydecl
300 msg = ptext (sLit "Illegal associated declaration in class:") <+>
303 -- represent associated family instances
305 repLAssocFamInst :: [LTyClDecl Name] -> DsM [Core TH.DecQ]
306 repLAssocFamInst = liftM de_loc . mapMaybeM repTyClD
308 -- represent instance declarations
310 repInstD' :: LInstDecl Name -> DsM (SrcSpan, Core TH.DecQ)
311 repInstD' (L loc (InstDecl ty binds _ ats)) -- Ignore user pragmas for now
312 = do { i <- addTyVarBinds tvs $ \_ ->
313 -- We must bring the type variables into scope, so their
314 -- occurrences don't fail, even though the binders don't
315 -- appear in the resulting data structure
316 do { cxt1 <- repContext cxt
317 ; inst_ty1 <- repPredTy (HsClassP cls tys)
318 ; ss <- mkGenSyms (collectHsBindBinders binds)
319 ; binds1 <- addBinds ss (rep_binds binds)
320 ; ats1 <- repLAssocFamInst ats
321 ; decls1 <- coreList decQTyConName (ats1 ++ binds1)
322 ; decls2 <- wrapNongenSyms ss decls1
323 -- wrapNongenSyms: do not clone the class op names!
324 -- They must be called 'op' etc, not 'op34'
325 ; repInst cxt1 inst_ty1 (decls2)
329 (tvs, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
331 repForD :: Located (ForeignDecl Name) -> DsM (SrcSpan, Core TH.DecQ)
332 repForD (L loc (ForeignImport name typ (CImport cc s ch cn cis)))
333 = do MkC name' <- lookupLOcc name
334 MkC typ' <- repLTy typ
335 MkC cc' <- repCCallConv cc
336 MkC s' <- repSafety s
337 cis' <- conv_cimportspec cis
338 MkC str <- coreStringLit $ static
339 ++ unpackFS ch ++ " "
340 ++ unpackFS cn ++ " "
342 dec <- rep2 forImpDName [cc', s', str, name', typ']
345 conv_cimportspec (CLabel cls) = notHandled "Foreign label" (doubleQuotes (ppr cls))
346 conv_cimportspec (CFunction DynamicTarget) = return "dynamic"
347 conv_cimportspec (CFunction (StaticTarget fs)) = return (unpackFS fs)
348 conv_cimportspec CWrapper = return "wrapper"
350 CFunction (StaticTarget _) -> "static "
352 repForD decl = notHandled "Foreign declaration" (ppr decl)
354 repCCallConv :: CCallConv -> DsM (Core TH.Callconv)
355 repCCallConv CCallConv = rep2 cCallName []
356 repCCallConv StdCallConv = rep2 stdCallName []
357 repCCallConv CmmCallConv = notHandled "repCCallConv" (ppr CmmCallConv)
359 repSafety :: Safety -> DsM (Core TH.Safety)
360 repSafety PlayRisky = rep2 unsafeName []
361 repSafety (PlaySafe False) = rep2 safeName []
362 repSafety (PlaySafe True) = rep2 threadsafeName []
365 ds_msg = ptext (sLit "Cannot desugar this Template Haskell declaration:")
367 -------------------------------------------------------
369 -------------------------------------------------------
371 repC :: LConDecl Name -> DsM (Core TH.ConQ)
372 repC (L _ (ConDecl con _ [] (L _ []) details ResTyH98 _))
373 = do { con1 <- lookupLOcc con ; -- See note [Binders and occurrences]
374 repConstr con1 details }
375 repC (L loc (ConDecl con expl tvs (L cloc ctxt) details ResTyH98 doc))
376 = do { addTyVarBinds tvs $ \bndrs -> do {
377 c' <- repC (L loc (ConDecl con expl [] (L cloc []) details ResTyH98 doc));
378 ctxt' <- repContext ctxt;
379 bndrs' <- coreList nameTyConName bndrs;
380 rep2 forallCName [unC bndrs', unC ctxt', unC c']
383 repC (L loc con_decl) -- GADTs
385 notHandled "GADT declaration" (ppr con_decl)
387 repBangTy :: LBangType Name -> DsM (Core (TH.StrictTypeQ))
391 rep2 strictTypeName [s, t]
393 (str, ty') = case ty of
394 L _ (HsBangTy _ ty) -> (isStrictName, ty)
395 _ -> (notStrictName, ty)
397 -------------------------------------------------------
399 -------------------------------------------------------
401 repDerivs :: Maybe [LHsType Name] -> DsM (Core [TH.Name])
402 repDerivs Nothing = coreList nameTyConName []
403 repDerivs (Just ctxt)
404 = do { strs <- mapM rep_deriv ctxt ;
405 coreList nameTyConName strs }
407 rep_deriv :: LHsType Name -> DsM (Core TH.Name)
408 -- Deriving clauses must have the simple H98 form
409 rep_deriv (L _ (HsPredTy (HsClassP cls []))) = lookupOcc cls
410 rep_deriv other = notHandled "Non-H98 deriving clause" (ppr other)
413 -------------------------------------------------------
414 -- Signatures in a class decl, or a group of bindings
415 -------------------------------------------------------
417 rep_sigs :: [LSig Name] -> DsM [Core TH.DecQ]
418 rep_sigs sigs = do locs_cores <- rep_sigs' sigs
419 return $ de_loc $ sort_by_loc locs_cores
421 rep_sigs' :: [LSig Name] -> DsM [(SrcSpan, Core TH.DecQ)]
422 -- We silently ignore ones we don't recognise
423 rep_sigs' sigs = do { sigs1 <- mapM rep_sig sigs ;
424 return (concat sigs1) }
426 rep_sig :: LSig Name -> DsM [(SrcSpan, Core TH.DecQ)]
428 -- Empty => Too hard, signature ignored
429 rep_sig (L loc (TypeSig nm ty)) = rep_proto nm ty loc
430 rep_sig (L loc (InlineSig nm ispec)) = rep_inline nm ispec loc
431 rep_sig (L loc (SpecSig nm ty ispec)) = rep_specialise nm ty ispec loc
432 rep_sig _ = return []
434 rep_proto :: Located Name -> LHsType Name -> SrcSpan
435 -> DsM [(SrcSpan, Core TH.DecQ)]
437 = do { nm1 <- lookupLOcc nm
439 ; sig <- repProto nm1 ty1
440 ; return [(loc, sig)]
443 rep_inline :: Located Name -> InlineSpec -> SrcSpan
444 -> DsM [(SrcSpan, Core TH.DecQ)]
445 rep_inline nm ispec loc
446 = do { nm1 <- lookupLOcc nm
447 ; (_, ispec1) <- rep_InlineSpec ispec
448 ; pragma <- repPragInl nm1 ispec1
449 ; return [(loc, pragma)]
452 rep_specialise :: Located Name -> LHsType Name -> InlineSpec -> SrcSpan
453 -> DsM [(SrcSpan, Core TH.DecQ)]
454 rep_specialise nm ty ispec loc
455 = do { nm1 <- lookupLOcc nm
457 ; (hasSpec, ispec1) <- rep_InlineSpec ispec
458 ; pragma <- if hasSpec
459 then repPragSpecInl nm1 ty1 ispec1
460 else repPragSpec nm1 ty1
461 ; return [(loc, pragma)]
464 -- extract all the information needed to build a TH.InlineSpec
466 rep_InlineSpec :: InlineSpec -> DsM (Bool, Core TH.InlineSpecQ)
467 rep_InlineSpec (Inline (InlinePragma activation match) inline)
468 | Nothing <- activation1
469 = liftM ((,) False) $ repInlineSpecNoPhase inline1 match1
470 | Just (flag, phase) <- activation1
471 = liftM ((,) True) $ repInlineSpecPhase inline1 match1 flag phase
472 | otherwise = {- unreachable, but shuts up -W -} panic "rep_InlineSpec"
474 match1 = coreBool (rep_RuleMatchInfo match)
475 activation1 = rep_Activation activation
476 inline1 = coreBool inline
478 rep_RuleMatchInfo FunLike = False
479 rep_RuleMatchInfo ConLike = True
481 rep_Activation NeverActive = Nothing
482 rep_Activation AlwaysActive = Nothing
483 rep_Activation (ActiveBefore phase) = Just (coreBool False,
484 MkC $ mkIntExprInt phase)
485 rep_Activation (ActiveAfter phase) = Just (coreBool True,
486 MkC $ mkIntExprInt phase)
489 -------------------------------------------------------
491 -------------------------------------------------------
493 -- We process type variable bindings in two ways, either by generating fresh
494 -- names or looking up existing names. The difference is crucial for type
495 -- families, depending on whether they are associated or not.
497 type ProcessTyVarBinds a =
498 [LHsTyVarBndr Name] -- the binders to be added
499 -> ([Core TH.Name] -> DsM (Core (TH.Q a))) -- action in the ext env
500 -> DsM (Core (TH.Q a))
502 -- gensym a list of type variables and enter them into the meta environment;
503 -- the computations passed as the second argument is executed in that extended
504 -- meta environment and gets the *new* names on Core-level as an argument
506 addTyVarBinds :: ProcessTyVarBinds a
507 addTyVarBinds tvs m =
509 let names = map (hsTyVarName.unLoc) tvs
510 freshNames <- mkGenSyms names
511 term <- addBinds freshNames $ do
512 bndrs <- mapM lookupBinder names
514 wrapGenSyns freshNames term
516 -- Look up a list of type variables; the computations passed as the second
517 -- argument gets the *new* names on Core-level as an argument
519 lookupTyVarBinds :: ProcessTyVarBinds a
520 lookupTyVarBinds tvs m =
522 let names = map (hsTyVarName.unLoc) tvs
523 bndrs <- mapM lookupBinder names
526 -- represent a type context
528 repLContext :: LHsContext Name -> DsM (Core TH.CxtQ)
529 repLContext (L _ ctxt) = repContext ctxt
531 repContext :: HsContext Name -> DsM (Core TH.CxtQ)
533 preds <- mapM repLPred ctxt
534 predList <- coreList predQTyConName preds
537 -- represent a type predicate
539 repLPred :: LHsPred Name -> DsM (Core TH.PredQ)
540 repLPred (L _ p) = repPred p
542 repPred :: HsPred Name -> DsM (Core TH.PredQ)
543 repPred (HsClassP cls tys)
545 cls1 <- lookupOcc cls
547 tys2 <- coreList typeQTyConName tys1
549 repPred (HsEqualP tyleft tyright)
551 tyleft1 <- repLTy tyleft
552 tyright1 <- repLTy tyright
553 repEqualP tyleft1 tyright1
554 repPred p@(HsIParam _ _) = notHandled "Implicit parameter constraint" (ppr p)
556 repPredTy :: HsPred Name -> DsM (Core TH.TypeQ)
557 repPredTy (HsClassP cls tys)
559 tcon <- repTy (HsTyVar cls)
562 repPredTy _ = panic "DsMeta.repPredTy: unexpected equality: internal error"
564 -- yield the representation of a list of types
566 repLTys :: [LHsType Name] -> DsM [Core TH.TypeQ]
567 repLTys tys = mapM repLTy tys
571 repLTy :: LHsType Name -> DsM (Core TH.TypeQ)
572 repLTy (L _ ty) = repTy ty
574 repTy :: HsType Name -> DsM (Core TH.TypeQ)
575 repTy (HsForAllTy _ tvs ctxt ty) =
576 addTyVarBinds tvs $ \bndrs -> do
577 ctxt1 <- repLContext ctxt
579 bndrs1 <- coreList nameTyConName bndrs
580 repTForall bndrs1 ctxt1 ty1
583 | isTvOcc (nameOccName n) = do
589 repTy (HsAppTy f a) = do
593 repTy (HsFunTy f a) = do
596 tcon <- repArrowTyCon
597 repTapps tcon [f1, a1]
598 repTy (HsListTy t) = do
602 repTy (HsPArrTy t) = do
604 tcon <- repTy (HsTyVar (tyConName parrTyCon))
606 repTy (HsTupleTy _ tys) = do
608 tcon <- repTupleTyCon (length tys)
610 repTy (HsOpTy ty1 n ty2) = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1)
612 repTy (HsParTy t) = repLTy t
613 repTy (HsPredTy pred) = repPredTy pred
614 repTy ty@(HsNumTy _) = notHandled "Number types (for generics)" (ppr ty)
615 repTy ty = notHandled "Exotic form of type" (ppr ty)
618 -----------------------------------------------------------------------------
620 -----------------------------------------------------------------------------
622 repLEs :: [LHsExpr Name] -> DsM (Core [TH.ExpQ])
623 repLEs es = do { es' <- mapM repLE es ;
624 coreList expQTyConName es' }
626 -- FIXME: some of these panics should be converted into proper error messages
627 -- unless we can make sure that constructs, which are plainly not
628 -- supported in TH already lead to error messages at an earlier stage
629 repLE :: LHsExpr Name -> DsM (Core TH.ExpQ)
630 repLE (L loc e) = putSrcSpanDs loc (repE e)
632 repE :: HsExpr Name -> DsM (Core TH.ExpQ)
634 do { mb_val <- dsLookupMetaEnv x
636 Nothing -> do { str <- globalVar x
637 ; repVarOrCon x str }
638 Just (Bound y) -> repVarOrCon x (coreVar y)
639 Just (Splice e) -> do { e' <- dsExpr e
640 ; return (MkC e') } }
641 repE e@(HsIPVar _) = notHandled "Implicit parameters" (ppr e)
643 -- Remember, we're desugaring renamer output here, so
644 -- HsOverlit can definitely occur
645 repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
646 repE (HsLit l) = do { a <- repLiteral l; repLit a }
647 repE (HsLam (MatchGroup [m] _)) = repLambda m
648 repE (HsApp x y) = do {a <- repLE x; b <- repLE y; repApp a b}
650 repE (OpApp e1 op _ e2) =
651 do { arg1 <- repLE e1;
654 repInfixApp arg1 the_op arg2 }
655 repE (NegApp x _) = do
657 negateVar <- lookupOcc negateName >>= repVar
659 repE (HsPar x) = repLE x
660 repE (SectionL x y) = do { a <- repLE x; b <- repLE y; repSectionL a b }
661 repE (SectionR x y) = do { a <- repLE x; b <- repLE y; repSectionR a b }
662 repE (HsCase e (MatchGroup ms _)) = do { arg <- repLE e
663 ; ms2 <- mapM repMatchTup ms
664 ; repCaseE arg (nonEmptyCoreList ms2) }
665 repE (HsIf x y z) = do
670 repE (HsLet bs e) = do { (ss,ds) <- repBinds bs
671 ; e2 <- addBinds ss (repLE e)
674 -- FIXME: I haven't got the types here right yet
675 repE (HsDo DoExpr sts body _)
676 = do { (ss,zs) <- repLSts sts;
677 body' <- addBinds ss $ repLE body;
678 ret <- repNoBindSt body';
679 e <- repDoE (nonEmptyCoreList (zs ++ [ret]));
681 repE (HsDo ListComp sts body _)
682 = do { (ss,zs) <- repLSts sts;
683 body' <- addBinds ss $ repLE body;
684 ret <- repNoBindSt body';
685 e <- repComp (nonEmptyCoreList (zs ++ [ret]));
687 repE e@(HsDo _ _ _ _) = notHandled "mdo and [: :]" (ppr e)
688 repE (ExplicitList _ es) = do { xs <- repLEs es; repListExp xs }
689 repE e@(ExplicitPArr _ _) = notHandled "Parallel arrays" (ppr e)
690 repE e@(ExplicitTuple es boxed)
691 | isBoxed boxed = do { xs <- repLEs es; repTup xs }
692 | otherwise = notHandled "Unboxed tuples" (ppr e)
693 repE (RecordCon c _ flds)
694 = do { x <- lookupLOcc c;
695 fs <- repFields flds;
697 repE (RecordUpd e flds _ _ _)
699 fs <- repFields flds;
702 repE (ExprWithTySig e ty) = do { e1 <- repLE e; t1 <- repLTy ty; repSigExp e1 t1 }
703 repE (ArithSeq _ aseq) =
705 From e -> do { ds1 <- repLE e; repFrom ds1 }
714 FromThenTo e1 e2 e3 -> do
718 repFromThenTo ds1 ds2 ds3
719 repE (HsSpliceE (HsSplice n _))
720 = do { mb_val <- dsLookupMetaEnv n
722 Just (Splice e) -> do { e' <- dsExpr e
724 _ -> pprPanic "HsSplice" (ppr n) }
725 -- Should not happen; statically checked
727 repE e@(PArrSeq {}) = notHandled "Parallel arrays" (ppr e)
728 repE e@(HsCoreAnn {}) = notHandled "Core annotations" (ppr e)
729 repE e@(HsSCC {}) = notHandled "Cost centres" (ppr e)
730 repE e@(HsTickPragma {}) = notHandled "Tick Pragma" (ppr e)
731 repE e@(HsBracketOut {}) = notHandled "TH brackets" (ppr e)
732 repE e = notHandled "Expression form" (ppr e)
734 -----------------------------------------------------------------------------
735 -- Building representations of auxillary structures like Match, Clause, Stmt,
737 repMatchTup :: LMatch Name -> DsM (Core TH.MatchQ)
738 repMatchTup (L _ (Match [p] _ (GRHSs guards wheres))) =
739 do { ss1 <- mkGenSyms (collectPatBinders p)
740 ; addBinds ss1 $ do {
742 ; (ss2,ds) <- repBinds wheres
743 ; addBinds ss2 $ do {
744 ; gs <- repGuards guards
745 ; match <- repMatch p1 gs ds
746 ; wrapGenSyns (ss1++ss2) match }}}
747 repMatchTup _ = panic "repMatchTup: case alt with more than one arg"
749 repClauseTup :: LMatch Name -> DsM (Core TH.ClauseQ)
750 repClauseTup (L _ (Match ps _ (GRHSs guards wheres))) =
751 do { ss1 <- mkGenSyms (collectPatsBinders ps)
752 ; addBinds ss1 $ do {
754 ; (ss2,ds) <- repBinds wheres
755 ; addBinds ss2 $ do {
756 gs <- repGuards guards
757 ; clause <- repClause ps1 gs ds
758 ; wrapGenSyns (ss1++ss2) clause }}}
760 repGuards :: [LGRHS Name] -> DsM (Core TH.BodyQ)
761 repGuards [L _ (GRHS [] e)]
762 = do {a <- repLE e; repNormal a }
764 = do { zs <- mapM process other;
765 let {(xs, ys) = unzip zs};
766 gd <- repGuarded (nonEmptyCoreList ys);
767 wrapGenSyns (concat xs) gd }
769 process :: LGRHS Name -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp))))
770 process (L _ (GRHS [L _ (ExprStmt e1 _ _)] e2))
771 = do { x <- repLNormalGE e1 e2;
773 process (L _ (GRHS ss rhs))
774 = do (gs, ss') <- repLSts ss
775 rhs' <- addBinds gs $ repLE rhs
776 g <- repPatGE (nonEmptyCoreList ss') rhs'
779 repFields :: HsRecordBinds Name -> DsM (Core [TH.Q TH.FieldExp])
780 repFields (HsRecFields { rec_flds = flds })
781 = do { fnames <- mapM lookupLOcc (map hsRecFieldId flds)
782 ; es <- mapM repLE (map hsRecFieldArg flds)
783 ; fs <- zipWithM repFieldExp fnames es
784 ; coreList fieldExpQTyConName fs }
787 -----------------------------------------------------------------------------
788 -- Representing Stmt's is tricky, especially if bound variables
789 -- shadow each other. Consider: [| do { x <- f 1; x <- f x; g x } |]
790 -- First gensym new names for every variable in any of the patterns.
791 -- both static (x'1 and x'2), and dynamic ((gensym "x") and (gensym "y"))
792 -- if variables didn't shaddow, the static gensym wouldn't be necessary
793 -- and we could reuse the original names (x and x).
795 -- do { x'1 <- gensym "x"
796 -- ; x'2 <- gensym "x"
797 -- ; doE [ BindSt (pvar x'1) [| f 1 |]
798 -- , BindSt (pvar x'2) [| f x |]
799 -- , NoBindSt [| g x |]
803 -- The strategy is to translate a whole list of do-bindings by building a
804 -- bigger environment, and a bigger set of meta bindings
805 -- (like: x'1 <- gensym "x" ) and then combining these with the translations
806 -- of the expressions within the Do
808 -----------------------------------------------------------------------------
809 -- The helper function repSts computes the translation of each sub expression
810 -- and a bunch of prefix bindings denoting the dynamic renaming.
812 repLSts :: [LStmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
813 repLSts stmts = repSts (map unLoc stmts)
815 repSts :: [Stmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
816 repSts (BindStmt p e _ _ : ss) =
818 ; ss1 <- mkGenSyms (collectPatBinders p)
819 ; addBinds ss1 $ do {
821 ; (ss2,zs) <- repSts ss
822 ; z <- repBindSt p1 e2
823 ; return (ss1++ss2, z : zs) }}
824 repSts (LetStmt bs : ss) =
825 do { (ss1,ds) <- repBinds bs
827 ; (ss2,zs) <- addBinds ss1 (repSts ss)
828 ; return (ss1++ss2, z : zs) }
829 repSts (ExprStmt e _ _ : ss) =
831 ; z <- repNoBindSt e2
832 ; (ss2,zs) <- repSts ss
833 ; return (ss2, z : zs) }
834 repSts [] = return ([],[])
835 repSts other = notHandled "Exotic statement" (ppr other)
838 -----------------------------------------------------------
840 -----------------------------------------------------------
842 repBinds :: HsLocalBinds Name -> DsM ([GenSymBind], Core [TH.DecQ])
843 repBinds EmptyLocalBinds
844 = do { core_list <- coreList decQTyConName []
845 ; return ([], core_list) }
847 repBinds b@(HsIPBinds _) = notHandled "Implicit parameters" (ppr b)
849 repBinds (HsValBinds decs)
850 = do { let { bndrs = map unLoc (collectHsValBinders decs) }
851 -- No need to worrry about detailed scopes within
852 -- the binding group, because we are talking Names
853 -- here, so we can safely treat it as a mutually
855 ; ss <- mkGenSyms bndrs
856 ; prs <- addBinds ss (rep_val_binds decs)
857 ; core_list <- coreList decQTyConName
858 (de_loc (sort_by_loc prs))
859 ; return (ss, core_list) }
861 rep_val_binds :: HsValBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
862 -- Assumes: all the binders of the binding are alrady in the meta-env
863 rep_val_binds (ValBindsOut binds sigs)
864 = do { core1 <- rep_binds' (unionManyBags (map snd binds))
865 ; core2 <- rep_sigs' sigs
866 ; return (core1 ++ core2) }
867 rep_val_binds (ValBindsIn _ _)
868 = panic "rep_val_binds: ValBindsIn"
870 rep_binds :: LHsBinds Name -> DsM [Core TH.DecQ]
871 rep_binds binds = do { binds_w_locs <- rep_binds' binds
872 ; return (de_loc (sort_by_loc binds_w_locs)) }
874 rep_binds' :: LHsBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
875 rep_binds' binds = mapM rep_bind (bagToList binds)
877 rep_bind :: LHsBind Name -> DsM (SrcSpan, Core TH.DecQ)
878 -- Assumes: all the binders of the binding are alrady in the meta-env
880 -- Note GHC treats declarations of a variable (not a pattern)
881 -- e.g. x = g 5 as a Fun MonoBinds. This is indicated by a single match
882 -- with an empty list of patterns
883 rep_bind (L loc (FunBind { fun_id = fn,
884 fun_matches = MatchGroup [L _ (Match [] _ (GRHSs guards wheres))] _ }))
885 = do { (ss,wherecore) <- repBinds wheres
886 ; guardcore <- addBinds ss (repGuards guards)
887 ; fn' <- lookupLBinder fn
889 ; ans <- repVal p guardcore wherecore
890 ; ans' <- wrapGenSyns ss ans
891 ; return (loc, ans') }
893 rep_bind (L loc (FunBind { fun_id = fn, fun_matches = MatchGroup ms _ }))
894 = do { ms1 <- mapM repClauseTup ms
895 ; fn' <- lookupLBinder fn
896 ; ans <- repFun fn' (nonEmptyCoreList ms1)
897 ; return (loc, ans) }
899 rep_bind (L loc (PatBind { pat_lhs = pat, pat_rhs = GRHSs guards wheres }))
900 = do { patcore <- repLP pat
901 ; (ss,wherecore) <- repBinds wheres
902 ; guardcore <- addBinds ss (repGuards guards)
903 ; ans <- repVal patcore guardcore wherecore
904 ; ans' <- wrapGenSyns ss ans
905 ; return (loc, ans') }
907 rep_bind (L _ (VarBind { var_id = v, var_rhs = e}))
908 = do { v' <- lookupBinder v
911 ; patcore <- repPvar v'
912 ; empty_decls <- coreList decQTyConName []
913 ; ans <- repVal patcore x empty_decls
914 ; return (srcLocSpan (getSrcLoc v), ans) }
916 rep_bind (L _ (AbsBinds {})) = panic "rep_bind: AbsBinds"
918 -----------------------------------------------------------------------------
919 -- Since everything in a Bind is mutually recursive we need rename all
920 -- all the variables simultaneously. For example:
921 -- [| AndMonoBinds (f x = x + g 2) (g x = f 1 + 2) |] would translate to
922 -- do { f'1 <- gensym "f"
923 -- ; g'2 <- gensym "g"
924 -- ; [ do { x'3 <- gensym "x"; fun f'1 [pvar x'3] [| x + g2 |]},
925 -- do { x'4 <- gensym "x"; fun g'2 [pvar x'4] [| f 1 + 2 |]}
927 -- This requires collecting the bindings (f'1 <- gensym "f"), and the
928 -- environment ( f |-> f'1 ) from each binding, and then unioning them
929 -- together. As we do this we collect GenSymBinds's which represent the renamed
930 -- variables bound by the Bindings. In order not to lose track of these
931 -- representations we build a shadow datatype MB with the same structure as
932 -- MonoBinds, but which has slots for the representations
935 -----------------------------------------------------------------------------
936 -- GHC allows a more general form of lambda abstraction than specified
937 -- by Haskell 98. In particular it allows guarded lambda's like :
938 -- (\ x | even x -> 0 | odd x -> 1) at the moment we can't represent this in
939 -- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like
940 -- (\ p1 .. pn -> exp) by causing an error.
942 repLambda :: LMatch Name -> DsM (Core TH.ExpQ)
943 repLambda (L _ (Match ps _ (GRHSs [L _ (GRHS [] e)] EmptyLocalBinds)))
944 = do { let bndrs = collectPatsBinders ps ;
945 ; ss <- mkGenSyms bndrs
946 ; lam <- addBinds ss (
947 do { xs <- repLPs ps; body <- repLE e; repLam xs body })
948 ; wrapGenSyns ss lam }
950 repLambda (L _ m) = notHandled "Guarded labmdas" (pprMatch (LambdaExpr :: HsMatchContext Name) m)
953 -----------------------------------------------------------------------------
955 -- repP deals with patterns. It assumes that we have already
956 -- walked over the pattern(s) once to collect the binders, and
957 -- have extended the environment. So every pattern-bound
958 -- variable should already appear in the environment.
960 -- Process a list of patterns
961 repLPs :: [LPat Name] -> DsM (Core [TH.PatQ])
962 repLPs ps = do { ps' <- mapM repLP ps ;
963 coreList patQTyConName ps' }
965 repLP :: LPat Name -> DsM (Core TH.PatQ)
966 repLP (L _ p) = repP p
968 repP :: Pat Name -> DsM (Core TH.PatQ)
969 repP (WildPat _) = repPwild
970 repP (LitPat l) = do { l2 <- repLiteral l; repPlit l2 }
971 repP (VarPat x) = do { x' <- lookupBinder x; repPvar x' }
972 repP (LazyPat p) = do { p1 <- repLP p; repPtilde p1 }
973 repP (AsPat x p) = do { x' <- lookupLBinder x; p1 <- repLP p; repPaspat x' p1 }
974 repP (ParPat p) = repLP p
975 repP (ListPat ps _) = do { qs <- repLPs ps; repPlist qs }
976 repP (TuplePat ps _ _) = do { qs <- repLPs ps; repPtup qs }
977 repP (ConPatIn dc details)
978 = do { con_str <- lookupLOcc dc
980 PrefixCon ps -> do { qs <- repLPs ps; repPcon con_str qs }
981 RecCon rec -> do { let flds = rec_flds rec
982 ; vs <- sequence $ map lookupLOcc (map hsRecFieldId flds)
983 ; ps <- sequence $ map repLP (map hsRecFieldArg flds)
984 ; fps <- zipWithM (\x y -> rep2 fieldPatName [unC x,unC y]) vs ps
985 ; fps' <- coreList fieldPatQTyConName fps
986 ; repPrec con_str fps' }
987 InfixCon p1 p2 -> do { p1' <- repLP p1;
989 repPinfix p1' con_str p2' }
991 repP (NPat l Nothing _) = do { a <- repOverloadedLiteral l; repPlit a }
992 repP p@(NPat _ (Just _) _) = notHandled "Negative overloaded patterns" (ppr p)
993 repP p@(SigPatIn {}) = notHandled "Type signatures in patterns" (ppr p)
994 -- The problem is to do with scoped type variables.
995 -- To implement them, we have to implement the scoping rules
996 -- here in DsMeta, and I don't want to do that today!
997 -- do { p' <- repLP p; t' <- repLTy t; repPsig p' t' }
998 -- repPsig :: Core TH.PatQ -> Core TH.TypeQ -> DsM (Core TH.PatQ)
999 -- repPsig (MkC p) (MkC t) = rep2 sigPName [p, t]
1001 repP other = notHandled "Exotic pattern" (ppr other)
1003 ----------------------------------------------------------
1004 -- Declaration ordering helpers
1006 sort_by_loc :: [(SrcSpan, a)] -> [(SrcSpan, a)]
1007 sort_by_loc xs = sortBy comp xs
1008 where comp x y = compare (fst x) (fst y)
1010 de_loc :: [(a, b)] -> [b]
1013 ----------------------------------------------------------
1014 -- The meta-environment
1016 -- A name/identifier association for fresh names of locally bound entities
1017 type GenSymBind = (Name, Id) -- Gensym the string and bind it to the Id
1018 -- I.e. (x, x_id) means
1019 -- let x_id = gensym "x" in ...
1021 -- Generate a fresh name for a locally bound entity
1023 mkGenSyms :: [Name] -> DsM [GenSymBind]
1024 -- We can use the existing name. For example:
1025 -- [| \x_77 -> x_77 + x_77 |]
1027 -- do { x_77 <- genSym "x"; .... }
1028 -- We use the same x_77 in the desugared program, but with the type Bndr
1031 -- We do make it an Internal name, though (hence localiseName)
1033 -- Nevertheless, it's monadic because we have to generate nameTy
1034 mkGenSyms ns = do { var_ty <- lookupType nameTyConName
1035 ; return [(nm, mkLocalId (localiseName nm) var_ty) | nm <- ns] }
1038 addBinds :: [GenSymBind] -> DsM a -> DsM a
1039 -- Add a list of fresh names for locally bound entities to the
1040 -- meta environment (which is part of the state carried around
1041 -- by the desugarer monad)
1042 addBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,Bound id) | (n,id) <- bs]) m
1044 -- Look up a locally bound name
1046 lookupLBinder :: Located Name -> DsM (Core TH.Name)
1047 lookupLBinder (L _ n) = lookupBinder n
1049 lookupBinder :: Name -> DsM (Core TH.Name)
1051 = do { mb_val <- dsLookupMetaEnv n;
1053 Just (Bound x) -> return (coreVar x)
1054 _ -> failWithDs msg }
1056 msg = ptext (sLit "DsMeta: failed binder lookup when desugaring a TH bracket:") <+> ppr n
1058 -- Look up a name that is either locally bound or a global name
1060 -- * If it is a global name, generate the "original name" representation (ie,
1061 -- the <module>:<name> form) for the associated entity
1063 lookupLOcc :: Located Name -> DsM (Core TH.Name)
1064 -- Lookup an occurrence; it can't be a splice.
1065 -- Use the in-scope bindings if they exist
1066 lookupLOcc (L _ n) = lookupOcc n
1068 lookupOcc :: Name -> DsM (Core TH.Name)
1070 = do { mb_val <- dsLookupMetaEnv n ;
1072 Nothing -> globalVar n
1073 Just (Bound x) -> return (coreVar x)
1074 Just (Splice _) -> pprPanic "repE:lookupOcc" (ppr n)
1077 lookupTvOcc :: Name -> DsM (Core TH.Name)
1078 -- Type variables can't be staged and are not lexically scoped in TH
1080 = do { mb_val <- dsLookupMetaEnv n ;
1082 Just (Bound x) -> return (coreVar x)
1086 msg = vcat [ ptext (sLit "Illegal lexically-scoped type variable") <+> quotes (ppr n)
1087 , ptext (sLit "Lexically scoped type variables are not supported by Template Haskell") ]
1089 globalVar :: Name -> DsM (Core TH.Name)
1090 -- Not bound by the meta-env
1091 -- Could be top-level; or could be local
1092 -- f x = $(g [| x |])
1093 -- Here the x will be local
1095 | isExternalName name
1096 = do { MkC mod <- coreStringLit name_mod
1097 ; MkC pkg <- coreStringLit name_pkg
1098 ; MkC occ <- occNameLit name
1099 ; rep2 mk_varg [pkg,mod,occ] }
1101 = do { MkC occ <- occNameLit name
1102 ; MkC uni <- coreIntLit (getKey (getUnique name))
1103 ; rep2 mkNameLName [occ,uni] }
1105 mod = ASSERT( isExternalName name) nameModule name
1106 name_mod = moduleNameString (moduleName mod)
1107 name_pkg = packageIdString (modulePackageId mod)
1108 name_occ = nameOccName name
1109 mk_varg | OccName.isDataOcc name_occ = mkNameG_dName
1110 | OccName.isVarOcc name_occ = mkNameG_vName
1111 | OccName.isTcOcc name_occ = mkNameG_tcName
1112 | otherwise = pprPanic "DsMeta.globalVar" (ppr name)
1114 lookupType :: Name -- Name of type constructor (e.g. TH.ExpQ)
1115 -> DsM Type -- The type
1116 lookupType tc_name = do { tc <- dsLookupTyCon tc_name ;
1117 return (mkTyConApp tc []) }
1119 wrapGenSyns :: [GenSymBind]
1120 -> Core (TH.Q a) -> DsM (Core (TH.Q a))
1121 -- wrapGenSyns [(nm1,id1), (nm2,id2)] y
1122 -- --> bindQ (gensym nm1) (\ id1 ->
1123 -- bindQ (gensym nm2 (\ id2 ->
1126 wrapGenSyns binds body@(MkC b)
1127 = do { var_ty <- lookupType nameTyConName
1130 [elt_ty] = tcTyConAppArgs (exprType b)
1131 -- b :: Q a, so we can get the type 'a' by looking at the
1132 -- argument type. NB: this relies on Q being a data/newtype,
1133 -- not a type synonym
1135 go _ [] = return body
1136 go var_ty ((name,id) : binds)
1137 = do { MkC body' <- go var_ty binds
1138 ; lit_str <- occNameLit name
1139 ; gensym_app <- repGensym lit_str
1140 ; repBindQ var_ty elt_ty
1141 gensym_app (MkC (Lam id body')) }
1143 -- Just like wrapGenSym, but don't actually do the gensym
1144 -- Instead use the existing name:
1145 -- let x = "x" in ...
1146 -- Only used for [Decl], and for the class ops in class
1147 -- and instance decls
1148 wrapNongenSyms :: [GenSymBind] -> Core a -> DsM (Core a)
1149 wrapNongenSyms binds (MkC body)
1150 = do { binds' <- mapM do_one binds ;
1151 return (MkC (mkLets binds' body)) }
1154 = do { MkC lit_str <- occNameLit name
1155 ; MkC var <- rep2 mkNameName [lit_str]
1156 ; return (NonRec id var) }
1158 occNameLit :: Name -> DsM (Core String)
1159 occNameLit n = coreStringLit (occNameString (nameOccName n))
1162 -- %*********************************************************************
1164 -- Constructing code
1166 -- %*********************************************************************
1168 -----------------------------------------------------------------------------
1169 -- PHANTOM TYPES for consistency. In order to make sure we do this correct
1170 -- we invent a new datatype which uses phantom types.
1172 newtype Core a = MkC CoreExpr
1173 unC :: Core a -> CoreExpr
1176 rep2 :: Name -> [ CoreExpr ] -> DsM (Core a)
1177 rep2 n xs = do { id <- dsLookupGlobalId n
1178 ; return (MkC (foldl App (Var id) xs)) }
1180 -- Then we make "repConstructors" which use the phantom types for each of the
1181 -- smart constructors of the Meta.Meta datatypes.
1184 -- %*********************************************************************
1186 -- The 'smart constructors'
1188 -- %*********************************************************************
1190 --------------- Patterns -----------------
1191 repPlit :: Core TH.Lit -> DsM (Core TH.PatQ)
1192 repPlit (MkC l) = rep2 litPName [l]
1194 repPvar :: Core TH.Name -> DsM (Core TH.PatQ)
1195 repPvar (MkC s) = rep2 varPName [s]
1197 repPtup :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
1198 repPtup (MkC ps) = rep2 tupPName [ps]
1200 repPcon :: Core TH.Name -> Core [TH.PatQ] -> DsM (Core TH.PatQ)
1201 repPcon (MkC s) (MkC ps) = rep2 conPName [s, ps]
1203 repPrec :: Core TH.Name -> Core [(TH.Name,TH.PatQ)] -> DsM (Core TH.PatQ)
1204 repPrec (MkC c) (MkC rps) = rep2 recPName [c,rps]
1206 repPinfix :: Core TH.PatQ -> Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
1207 repPinfix (MkC p1) (MkC n) (MkC p2) = rep2 infixPName [p1, n, p2]
1209 repPtilde :: Core TH.PatQ -> DsM (Core TH.PatQ)
1210 repPtilde (MkC p) = rep2 tildePName [p]
1212 repPaspat :: Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
1213 repPaspat (MkC s) (MkC p) = rep2 asPName [s, p]
1215 repPwild :: DsM (Core TH.PatQ)
1216 repPwild = rep2 wildPName []
1218 repPlist :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
1219 repPlist (MkC ps) = rep2 listPName [ps]
1221 --------------- Expressions -----------------
1222 repVarOrCon :: Name -> Core TH.Name -> DsM (Core TH.ExpQ)
1223 repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
1224 | otherwise = repVar str
1226 repVar :: Core TH.Name -> DsM (Core TH.ExpQ)
1227 repVar (MkC s) = rep2 varEName [s]
1229 repCon :: Core TH.Name -> DsM (Core TH.ExpQ)
1230 repCon (MkC s) = rep2 conEName [s]
1232 repLit :: Core TH.Lit -> DsM (Core TH.ExpQ)
1233 repLit (MkC c) = rep2 litEName [c]
1235 repApp :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1236 repApp (MkC x) (MkC y) = rep2 appEName [x,y]
1238 repLam :: Core [TH.PatQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1239 repLam (MkC ps) (MkC e) = rep2 lamEName [ps, e]
1241 repTup :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
1242 repTup (MkC es) = rep2 tupEName [es]
1244 repCond :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1245 repCond (MkC x) (MkC y) (MkC z) = rep2 condEName [x,y,z]
1247 repLetE :: Core [TH.DecQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1248 repLetE (MkC ds) (MkC e) = rep2 letEName [ds, e]
1250 repCaseE :: Core TH.ExpQ -> Core [TH.MatchQ] -> DsM( Core TH.ExpQ)
1251 repCaseE (MkC e) (MkC ms) = rep2 caseEName [e, ms]
1253 repDoE :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
1254 repDoE (MkC ss) = rep2 doEName [ss]
1256 repComp :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
1257 repComp (MkC ss) = rep2 compEName [ss]
1259 repListExp :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
1260 repListExp (MkC es) = rep2 listEName [es]
1262 repSigExp :: Core TH.ExpQ -> Core TH.TypeQ -> DsM (Core TH.ExpQ)
1263 repSigExp (MkC e) (MkC t) = rep2 sigEName [e,t]
1265 repRecCon :: Core TH.Name -> Core [TH.Q TH.FieldExp]-> DsM (Core TH.ExpQ)
1266 repRecCon (MkC c) (MkC fs) = rep2 recConEName [c,fs]
1268 repRecUpd :: Core TH.ExpQ -> Core [TH.Q TH.FieldExp] -> DsM (Core TH.ExpQ)
1269 repRecUpd (MkC e) (MkC fs) = rep2 recUpdEName [e,fs]
1271 repFieldExp :: Core TH.Name -> Core TH.ExpQ -> DsM (Core (TH.Q TH.FieldExp))
1272 repFieldExp (MkC n) (MkC x) = rep2 fieldExpName [n,x]
1274 repInfixApp :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1275 repInfixApp (MkC x) (MkC y) (MkC z) = rep2 infixAppName [x,y,z]
1277 repSectionL :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1278 repSectionL (MkC x) (MkC y) = rep2 sectionLName [x,y]
1280 repSectionR :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1281 repSectionR (MkC x) (MkC y) = rep2 sectionRName [x,y]
1283 ------------ Right hand sides (guarded expressions) ----
1284 repGuarded :: Core [TH.Q (TH.Guard, TH.Exp)] -> DsM (Core TH.BodyQ)
1285 repGuarded (MkC pairs) = rep2 guardedBName [pairs]
1287 repNormal :: Core TH.ExpQ -> DsM (Core TH.BodyQ)
1288 repNormal (MkC e) = rep2 normalBName [e]
1290 ------------ Guards ----
1291 repLNormalGE :: LHsExpr Name -> LHsExpr Name -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1292 repLNormalGE g e = do g' <- repLE g
1296 repNormalGE :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1297 repNormalGE (MkC g) (MkC e) = rep2 normalGEName [g, e]
1299 repPatGE :: Core [TH.StmtQ] -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1300 repPatGE (MkC ss) (MkC e) = rep2 patGEName [ss, e]
1302 ------------- Stmts -------------------
1303 repBindSt :: Core TH.PatQ -> Core TH.ExpQ -> DsM (Core TH.StmtQ)
1304 repBindSt (MkC p) (MkC e) = rep2 bindSName [p,e]
1306 repLetSt :: Core [TH.DecQ] -> DsM (Core TH.StmtQ)
1307 repLetSt (MkC ds) = rep2 letSName [ds]
1309 repNoBindSt :: Core TH.ExpQ -> DsM (Core TH.StmtQ)
1310 repNoBindSt (MkC e) = rep2 noBindSName [e]
1312 -------------- Range (Arithmetic sequences) -----------
1313 repFrom :: Core TH.ExpQ -> DsM (Core TH.ExpQ)
1314 repFrom (MkC x) = rep2 fromEName [x]
1316 repFromThen :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1317 repFromThen (MkC x) (MkC y) = rep2 fromThenEName [x,y]
1319 repFromTo :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1320 repFromTo (MkC x) (MkC y) = rep2 fromToEName [x,y]
1322 repFromThenTo :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1323 repFromThenTo (MkC x) (MkC y) (MkC z) = rep2 fromThenToEName [x,y,z]
1325 ------------ Match and Clause Tuples -----------
1326 repMatch :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.MatchQ)
1327 repMatch (MkC p) (MkC bod) (MkC ds) = rep2 matchName [p, bod, ds]
1329 repClause :: Core [TH.PatQ] -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.ClauseQ)
1330 repClause (MkC ps) (MkC bod) (MkC ds) = rep2 clauseName [ps, bod, ds]
1332 -------------- Dec -----------------------------
1333 repVal :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1334 repVal (MkC p) (MkC b) (MkC ds) = rep2 valDName [p, b, ds]
1336 repFun :: Core TH.Name -> Core [TH.ClauseQ] -> DsM (Core TH.DecQ)
1337 repFun (MkC nm) (MkC b) = rep2 funDName [nm, b]
1339 repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name]
1340 -> Maybe (Core [TH.TypeQ])
1341 -> Core [TH.ConQ] -> Core [TH.Name] -> DsM (Core TH.DecQ)
1342 repData (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC cons) (MkC derivs)
1343 = rep2 dataDName [cxt, nm, tvs, cons, derivs]
1344 repData (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC cons) (MkC derivs)
1345 = rep2 dataInstDName [cxt, nm, tys, cons, derivs]
1347 repNewtype :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name]
1348 -> Maybe (Core [TH.TypeQ])
1349 -> Core TH.ConQ -> Core [TH.Name] -> DsM (Core TH.DecQ)
1350 repNewtype (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC con) (MkC derivs)
1351 = rep2 newtypeDName [cxt, nm, tvs, con, derivs]
1352 repNewtype (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC con) (MkC derivs)
1353 = rep2 newtypeInstDName [cxt, nm, tys, con, derivs]
1355 repTySyn :: Core TH.Name -> Core [TH.Name]
1356 -> Maybe (Core [TH.TypeQ])
1357 -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1358 repTySyn (MkC nm) (MkC tvs) Nothing (MkC rhs)
1359 = rep2 tySynDName [nm, tvs, rhs]
1360 repTySyn (MkC nm) (MkC _) (Just (MkC tys)) (MkC rhs)
1361 = rep2 tySynInstDName [nm, tys, rhs]
1363 repInst :: Core TH.CxtQ -> Core TH.TypeQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1364 repInst (MkC cxt) (MkC ty) (MkC ds) = rep2 instanceDName [cxt, ty, ds]
1366 repClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name]
1367 -> Core [TH.FunDep] -> Core [TH.DecQ]
1368 -> DsM (Core TH.DecQ)
1369 repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds)
1370 = rep2 classDName [cxt, cls, tvs, fds, ds]
1372 repPragInl :: Core TH.Name -> Core TH.InlineSpecQ -> DsM (Core TH.DecQ)
1373 repPragInl (MkC nm) (MkC ispec) = rep2 pragInlDName [nm, ispec]
1375 repPragSpec :: Core TH.Name -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1376 repPragSpec (MkC nm) (MkC ty) = rep2 pragSpecDName [nm, ty]
1378 repPragSpecInl :: Core TH.Name -> Core TH.TypeQ -> Core TH.InlineSpecQ
1379 -> DsM (Core TH.DecQ)
1380 repPragSpecInl (MkC nm) (MkC ty) (MkC ispec)
1381 = rep2 pragSpecInlDName [nm, ty, ispec]
1383 repFamily :: Core TH.FamFlavour -> Core TH.Name -> Core [TH.Name]
1384 -> DsM (Core TH.DecQ)
1385 repFamily (MkC flav) (MkC nm) (MkC tvs)
1386 = rep2 familyDName [flav, nm, tvs]
1388 repInlineSpecNoPhase :: Core Bool -> Core Bool -> DsM (Core TH.InlineSpecQ)
1389 repInlineSpecNoPhase (MkC inline) (MkC conlike)
1390 = rep2 inlineSpecNoPhaseName [inline, conlike]
1392 repInlineSpecPhase :: Core Bool -> Core Bool -> Core Bool -> Core Int
1393 -> DsM (Core TH.InlineSpecQ)
1394 repInlineSpecPhase (MkC inline) (MkC conlike) (MkC beforeFrom) (MkC phase)
1395 = rep2 inlineSpecPhaseName [inline, conlike, beforeFrom, phase]
1397 repFunDep :: Core [TH.Name] -> Core [TH.Name] -> DsM (Core TH.FunDep)
1398 repFunDep (MkC xs) (MkC ys) = rep2 funDepName [xs, ys]
1400 repProto :: Core TH.Name -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1401 repProto (MkC s) (MkC ty) = rep2 sigDName [s, ty]
1403 repCtxt :: Core [TH.PredQ] -> DsM (Core TH.CxtQ)
1404 repCtxt (MkC tys) = rep2 cxtName [tys]
1406 repClassP :: Core TH.Name -> Core [TH.TypeQ] -> DsM (Core TH.PredQ)
1407 repClassP (MkC cla) (MkC tys) = rep2 classPName [cla, tys]
1409 repEqualP :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.PredQ)
1410 repEqualP (MkC ty1) (MkC ty2) = rep2 equalPName [ty1, ty2]
1412 repConstr :: Core TH.Name -> HsConDeclDetails Name
1413 -> DsM (Core TH.ConQ)
1414 repConstr con (PrefixCon ps)
1415 = do arg_tys <- mapM repBangTy ps
1416 arg_tys1 <- coreList strictTypeQTyConName arg_tys
1417 rep2 normalCName [unC con, unC arg_tys1]
1418 repConstr con (RecCon ips)
1419 = do arg_vs <- mapM lookupLOcc (map cd_fld_name ips)
1420 arg_tys <- mapM repBangTy (map cd_fld_type ips)
1421 arg_vtys <- zipWithM (\x y -> rep2 varStrictTypeName [unC x, unC y])
1423 arg_vtys' <- coreList varStrictTypeQTyConName arg_vtys
1424 rep2 recCName [unC con, unC arg_vtys']
1425 repConstr con (InfixCon st1 st2)
1426 = do arg1 <- repBangTy st1
1427 arg2 <- repBangTy st2
1428 rep2 infixCName [unC arg1, unC con, unC arg2]
1430 ------------ Types -------------------
1432 repTForall :: Core [TH.Name] -> Core TH.CxtQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)
1433 repTForall (MkC tvars) (MkC ctxt) (MkC ty)
1434 = rep2 forallTName [tvars, ctxt, ty]
1436 repTvar :: Core TH.Name -> DsM (Core TH.TypeQ)
1437 repTvar (MkC s) = rep2 varTName [s]
1439 repTapp :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)
1440 repTapp (MkC t1) (MkC t2) = rep2 appTName [t1,t2]
1442 repTapps :: Core TH.TypeQ -> [Core TH.TypeQ] -> DsM (Core TH.TypeQ)
1443 repTapps f [] = return f
1444 repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
1446 --------- Type constructors --------------
1448 repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
1449 repNamedTyCon (MkC s) = rep2 conTName [s]
1451 repTupleTyCon :: Int -> DsM (Core TH.TypeQ)
1452 -- Note: not Core Int; it's easier to be direct here
1453 repTupleTyCon i = rep2 tupleTName [mkIntExprInt i]
1455 repArrowTyCon :: DsM (Core TH.TypeQ)
1456 repArrowTyCon = rep2 arrowTName []
1458 repListTyCon :: DsM (Core TH.TypeQ)
1459 repListTyCon = rep2 listTName []
1462 ----------------------------------------------------------
1465 repLiteral :: HsLit -> DsM (Core TH.Lit)
1467 = do lit' <- case lit of
1468 HsIntPrim i -> mk_integer i
1469 HsWordPrim w -> mk_integer w
1470 HsInt i -> mk_integer i
1471 HsFloatPrim r -> mk_rational r
1472 HsDoublePrim r -> mk_rational r
1474 lit_expr <- dsLit lit'
1476 Just lit_name -> rep2 lit_name [lit_expr]
1477 Nothing -> notHandled "Exotic literal" (ppr lit)
1479 mb_lit_name = case lit of
1480 HsInteger _ _ -> Just integerLName
1481 HsInt _ -> Just integerLName
1482 HsIntPrim _ -> Just intPrimLName
1483 HsWordPrim _ -> Just wordPrimLName
1484 HsFloatPrim _ -> Just floatPrimLName
1485 HsDoublePrim _ -> Just doublePrimLName
1486 HsChar _ -> Just charLName
1487 HsString _ -> Just stringLName
1488 HsRat _ _ -> Just rationalLName
1491 mk_integer :: Integer -> DsM HsLit
1492 mk_integer i = do integer_ty <- lookupType integerTyConName
1493 return $ HsInteger i integer_ty
1494 mk_rational :: Rational -> DsM HsLit
1495 mk_rational r = do rat_ty <- lookupType rationalTyConName
1496 return $ HsRat r rat_ty
1497 mk_string :: FastString -> DsM HsLit
1498 mk_string s = return $ HsString s
1500 repOverloadedLiteral :: HsOverLit Name -> DsM (Core TH.Lit)
1501 repOverloadedLiteral (OverLit { ol_val = val})
1502 = do { lit <- mk_lit val; repLiteral lit }
1503 -- The type Rational will be in the environment, becuase
1504 -- the smart constructor 'TH.Syntax.rationalL' uses it in its type,
1505 -- and rationalL is sucked in when any TH stuff is used
1507 mk_lit :: OverLitVal -> DsM HsLit
1508 mk_lit (HsIntegral i) = mk_integer i
1509 mk_lit (HsFractional f) = mk_rational f
1510 mk_lit (HsIsString s) = mk_string s
1512 --------------- Miscellaneous -------------------
1514 repGensym :: Core String -> DsM (Core (TH.Q TH.Name))
1515 repGensym (MkC lit_str) = rep2 newNameName [lit_str]
1517 repBindQ :: Type -> Type -- a and b
1518 -> Core (TH.Q a) -> Core (a -> TH.Q b) -> DsM (Core (TH.Q b))
1519 repBindQ ty_a ty_b (MkC x) (MkC y)
1520 = rep2 bindQName [Type ty_a, Type ty_b, x, y]
1522 repSequenceQ :: Type -> Core [TH.Q a] -> DsM (Core (TH.Q [a]))
1523 repSequenceQ ty_a (MkC list)
1524 = rep2 sequenceQName [Type ty_a, list]
1526 ------------ Lists and Tuples -------------------
1527 -- turn a list of patterns into a single pattern matching a list
1529 coreList :: Name -- Of the TyCon of the element type
1530 -> [Core a] -> DsM (Core [a])
1532 = do { elt_ty <- lookupType tc_name; return (coreList' elt_ty es) }
1534 coreList' :: Type -- The element type
1535 -> [Core a] -> Core [a]
1536 coreList' elt_ty es = MkC (mkListExpr elt_ty (map unC es ))
1538 nonEmptyCoreList :: [Core a] -> Core [a]
1539 -- The list must be non-empty so we can get the element type
1540 -- Otherwise use coreList
1541 nonEmptyCoreList [] = panic "coreList: empty argument"
1542 nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs))
1544 coreStringLit :: String -> DsM (Core String)
1545 coreStringLit s = do { z <- mkStringExpr s; return(MkC z) }
1547 ------------ Bool, Literals & Variables -------------------
1549 coreBool :: Bool -> Core Bool
1550 coreBool False = MkC $ mkConApp falseDataCon []
1551 coreBool True = MkC $ mkConApp trueDataCon []
1553 coreIntLit :: Int -> DsM (Core Int)
1554 coreIntLit i = return (MkC (mkIntExprInt i))
1556 coreVar :: Id -> Core TH.Name -- The Id has type Name
1557 coreVar id = MkC (Var id)
1559 ----------------- Failure -----------------------
1560 notHandled :: String -> SDoc -> DsM a
1561 notHandled what doc = failWithDs msg
1563 msg = hang (text what <+> ptext (sLit "not (yet) handled by Template Haskell"))
1567 -- %************************************************************************
1569 -- The known-key names for Template Haskell
1571 -- %************************************************************************
1573 -- To add a name, do three things
1575 -- 1) Allocate a key
1577 -- 3) Add the name to knownKeyNames
1579 templateHaskellNames :: [Name]
1580 -- The names that are implicitly mentioned by ``bracket''
1581 -- Should stay in sync with the import list of DsMeta
1583 templateHaskellNames = [
1584 returnQName, bindQName, sequenceQName, newNameName, liftName,
1585 mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
1588 charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
1589 floatPrimLName, doublePrimLName, rationalLName,
1591 litPName, varPName, tupPName, conPName, tildePName, infixPName,
1592 asPName, wildPName, recPName, listPName, sigPName,
1600 varEName, conEName, litEName, appEName, infixEName,
1601 infixAppName, sectionLName, sectionRName, lamEName, tupEName,
1602 condEName, letEName, caseEName, doEName, compEName,
1603 fromEName, fromThenEName, fromToEName, fromThenToEName,
1604 listEName, sigEName, recConEName, recUpdEName,
1608 guardedBName, normalBName,
1610 normalGEName, patGEName,
1612 bindSName, letSName, noBindSName, parSName,
1614 funDName, valDName, dataDName, newtypeDName, tySynDName,
1615 classDName, instanceDName, sigDName, forImpDName,
1616 pragInlDName, pragSpecDName, pragSpecInlDName,
1617 familyDName, dataInstDName, newtypeInstDName, tySynInstDName,
1621 classPName, equalPName,
1623 isStrictName, notStrictName,
1625 normalCName, recCName, infixCName, forallCName,
1631 forallTName, varTName, conTName, appTName,
1632 tupleTName, arrowTName, listTName,
1634 cCallName, stdCallName,
1640 inlineSpecNoPhaseName, inlineSpecPhaseName,
1644 typeFamName, dataFamName,
1647 qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchQTyConName,
1648 clauseQTyConName, expQTyConName, fieldExpTyConName, predTyConName,
1649 stmtQTyConName, decQTyConName, conQTyConName, strictTypeQTyConName,
1650 varStrictTypeQTyConName, typeQTyConName, expTyConName, decTyConName,
1651 typeTyConName, matchTyConName, clauseTyConName, patQTyConName,
1652 fieldPatQTyConName, fieldExpQTyConName, funDepTyConName, predQTyConName,
1655 quoteExpName, quotePatName]
1657 thSyn, thLib, qqLib :: Module
1658 thSyn = mkTHModule (fsLit "Language.Haskell.TH.Syntax")
1659 thLib = mkTHModule (fsLit "Language.Haskell.TH.Lib")
1660 qqLib = mkTHModule (fsLit "Language.Haskell.TH.Quote")
1662 mkTHModule :: FastString -> Module
1663 mkTHModule m = mkModule thPackageId (mkModuleNameFS m)
1665 libFun, libTc, thFun, thTc, qqFun :: FastString -> Unique -> Name
1666 libFun = mk_known_key_name OccName.varName thLib
1667 libTc = mk_known_key_name OccName.tcName thLib
1668 thFun = mk_known_key_name OccName.varName thSyn
1669 thTc = mk_known_key_name OccName.tcName thSyn
1670 qqFun = mk_known_key_name OccName.varName qqLib
1672 -------------------- TH.Syntax -----------------------
1673 qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
1674 fieldPatTyConName, expTyConName, decTyConName, typeTyConName,
1675 matchTyConName, clauseTyConName, funDepTyConName, predTyConName :: Name
1676 qTyConName = thTc (fsLit "Q") qTyConKey
1677 nameTyConName = thTc (fsLit "Name") nameTyConKey
1678 fieldExpTyConName = thTc (fsLit "FieldExp") fieldExpTyConKey
1679 patTyConName = thTc (fsLit "Pat") patTyConKey
1680 fieldPatTyConName = thTc (fsLit "FieldPat") fieldPatTyConKey
1681 expTyConName = thTc (fsLit "Exp") expTyConKey
1682 decTyConName = thTc (fsLit "Dec") decTyConKey
1683 typeTyConName = thTc (fsLit "Type") typeTyConKey
1684 matchTyConName = thTc (fsLit "Match") matchTyConKey
1685 clauseTyConName = thTc (fsLit "Clause") clauseTyConKey
1686 funDepTyConName = thTc (fsLit "FunDep") funDepTyConKey
1687 predTyConName = thTc (fsLit "Pred") predTyConKey
1689 returnQName, bindQName, sequenceQName, newNameName, liftName,
1690 mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName,
1692 returnQName = thFun (fsLit "returnQ") returnQIdKey
1693 bindQName = thFun (fsLit "bindQ") bindQIdKey
1694 sequenceQName = thFun (fsLit "sequenceQ") sequenceQIdKey
1695 newNameName = thFun (fsLit "newName") newNameIdKey
1696 liftName = thFun (fsLit "lift") liftIdKey
1697 mkNameName = thFun (fsLit "mkName") mkNameIdKey
1698 mkNameG_vName = thFun (fsLit "mkNameG_v") mkNameG_vIdKey
1699 mkNameG_dName = thFun (fsLit "mkNameG_d") mkNameG_dIdKey
1700 mkNameG_tcName = thFun (fsLit "mkNameG_tc") mkNameG_tcIdKey
1701 mkNameLName = thFun (fsLit "mkNameL") mkNameLIdKey
1704 -------------------- TH.Lib -----------------------
1706 charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
1707 floatPrimLName, doublePrimLName, rationalLName :: Name
1708 charLName = libFun (fsLit "charL") charLIdKey
1709 stringLName = libFun (fsLit "stringL") stringLIdKey
1710 integerLName = libFun (fsLit "integerL") integerLIdKey
1711 intPrimLName = libFun (fsLit "intPrimL") intPrimLIdKey
1712 wordPrimLName = libFun (fsLit "wordPrimL") wordPrimLIdKey
1713 floatPrimLName = libFun (fsLit "floatPrimL") floatPrimLIdKey
1714 doublePrimLName = libFun (fsLit "doublePrimL") doublePrimLIdKey
1715 rationalLName = libFun (fsLit "rationalL") rationalLIdKey
1718 litPName, varPName, tupPName, conPName, infixPName, tildePName,
1719 asPName, wildPName, recPName, listPName, sigPName :: Name
1720 litPName = libFun (fsLit "litP") litPIdKey
1721 varPName = libFun (fsLit "varP") varPIdKey
1722 tupPName = libFun (fsLit "tupP") tupPIdKey
1723 conPName = libFun (fsLit "conP") conPIdKey
1724 infixPName = libFun (fsLit "infixP") infixPIdKey
1725 tildePName = libFun (fsLit "tildeP") tildePIdKey
1726 asPName = libFun (fsLit "asP") asPIdKey
1727 wildPName = libFun (fsLit "wildP") wildPIdKey
1728 recPName = libFun (fsLit "recP") recPIdKey
1729 listPName = libFun (fsLit "listP") listPIdKey
1730 sigPName = libFun (fsLit "sigP") sigPIdKey
1732 -- type FieldPat = ...
1733 fieldPatName :: Name
1734 fieldPatName = libFun (fsLit "fieldPat") fieldPatIdKey
1738 matchName = libFun (fsLit "match") matchIdKey
1740 -- data Clause = ...
1742 clauseName = libFun (fsLit "clause") clauseIdKey
1745 varEName, conEName, litEName, appEName, infixEName, infixAppName,
1746 sectionLName, sectionRName, lamEName, tupEName, condEName,
1747 letEName, caseEName, doEName, compEName :: Name
1748 varEName = libFun (fsLit "varE") varEIdKey
1749 conEName = libFun (fsLit "conE") conEIdKey
1750 litEName = libFun (fsLit "litE") litEIdKey
1751 appEName = libFun (fsLit "appE") appEIdKey
1752 infixEName = libFun (fsLit "infixE") infixEIdKey
1753 infixAppName = libFun (fsLit "infixApp") infixAppIdKey
1754 sectionLName = libFun (fsLit "sectionL") sectionLIdKey
1755 sectionRName = libFun (fsLit "sectionR") sectionRIdKey
1756 lamEName = libFun (fsLit "lamE") lamEIdKey
1757 tupEName = libFun (fsLit "tupE") tupEIdKey
1758 condEName = libFun (fsLit "condE") condEIdKey
1759 letEName = libFun (fsLit "letE") letEIdKey
1760 caseEName = libFun (fsLit "caseE") caseEIdKey
1761 doEName = libFun (fsLit "doE") doEIdKey
1762 compEName = libFun (fsLit "compE") compEIdKey
1763 -- ArithSeq skips a level
1764 fromEName, fromThenEName, fromToEName, fromThenToEName :: Name
1765 fromEName = libFun (fsLit "fromE") fromEIdKey
1766 fromThenEName = libFun (fsLit "fromThenE") fromThenEIdKey
1767 fromToEName = libFun (fsLit "fromToE") fromToEIdKey
1768 fromThenToEName = libFun (fsLit "fromThenToE") fromThenToEIdKey
1770 listEName, sigEName, recConEName, recUpdEName :: Name
1771 listEName = libFun (fsLit "listE") listEIdKey
1772 sigEName = libFun (fsLit "sigE") sigEIdKey
1773 recConEName = libFun (fsLit "recConE") recConEIdKey
1774 recUpdEName = libFun (fsLit "recUpdE") recUpdEIdKey
1776 -- type FieldExp = ...
1777 fieldExpName :: Name
1778 fieldExpName = libFun (fsLit "fieldExp") fieldExpIdKey
1781 guardedBName, normalBName :: Name
1782 guardedBName = libFun (fsLit "guardedB") guardedBIdKey
1783 normalBName = libFun (fsLit "normalB") normalBIdKey
1786 normalGEName, patGEName :: Name
1787 normalGEName = libFun (fsLit "normalGE") normalGEIdKey
1788 patGEName = libFun (fsLit "patGE") patGEIdKey
1791 bindSName, letSName, noBindSName, parSName :: Name
1792 bindSName = libFun (fsLit "bindS") bindSIdKey
1793 letSName = libFun (fsLit "letS") letSIdKey
1794 noBindSName = libFun (fsLit "noBindS") noBindSIdKey
1795 parSName = libFun (fsLit "parS") parSIdKey
1798 funDName, valDName, dataDName, newtypeDName, tySynDName, classDName,
1799 instanceDName, sigDName, forImpDName, pragInlDName, pragSpecDName,
1800 pragSpecInlDName, familyDName, dataInstDName, newtypeInstDName,
1801 tySynInstDName :: Name
1802 funDName = libFun (fsLit "funD") funDIdKey
1803 valDName = libFun (fsLit "valD") valDIdKey
1804 dataDName = libFun (fsLit "dataD") dataDIdKey
1805 newtypeDName = libFun (fsLit "newtypeD") newtypeDIdKey
1806 tySynDName = libFun (fsLit "tySynD") tySynDIdKey
1807 classDName = libFun (fsLit "classD") classDIdKey
1808 instanceDName = libFun (fsLit "instanceD") instanceDIdKey
1809 sigDName = libFun (fsLit "sigD") sigDIdKey
1810 forImpDName = libFun (fsLit "forImpD") forImpDIdKey
1811 pragInlDName = libFun (fsLit "pragInlD") pragInlDIdKey
1812 pragSpecDName = libFun (fsLit "pragSpecD") pragSpecDIdKey
1813 pragSpecInlDName = libFun (fsLit "pragSpecInlD") pragSpecInlDIdKey
1814 familyDName = libFun (fsLit "familyD") familyDIdKey
1815 dataInstDName = libFun (fsLit "dataInstD") dataInstDIdKey
1816 newtypeInstDName = libFun (fsLit "newtypeInstD") newtypeInstDIdKey
1817 tySynInstDName = libFun (fsLit "tySynInstD") tySynInstDIdKey
1821 cxtName = libFun (fsLit "cxt") cxtIdKey
1824 classPName, equalPName :: Name
1825 classPName = libFun (fsLit "classP") classPIdKey
1826 equalPName = libFun (fsLit "equalP") equalPIdKey
1828 -- data Strict = ...
1829 isStrictName, notStrictName :: Name
1830 isStrictName = libFun (fsLit "isStrict") isStrictKey
1831 notStrictName = libFun (fsLit "notStrict") notStrictKey
1834 normalCName, recCName, infixCName, forallCName :: Name
1835 normalCName = libFun (fsLit "normalC") normalCIdKey
1836 recCName = libFun (fsLit "recC") recCIdKey
1837 infixCName = libFun (fsLit "infixC") infixCIdKey
1838 forallCName = libFun (fsLit "forallC") forallCIdKey
1840 -- type StrictType = ...
1841 strictTypeName :: Name
1842 strictTypeName = libFun (fsLit "strictType") strictTKey
1844 -- type VarStrictType = ...
1845 varStrictTypeName :: Name
1846 varStrictTypeName = libFun (fsLit "varStrictType") varStrictTKey
1849 forallTName, varTName, conTName, tupleTName, arrowTName,
1850 listTName, appTName :: Name
1851 forallTName = libFun (fsLit "forallT") forallTIdKey
1852 varTName = libFun (fsLit "varT") varTIdKey
1853 conTName = libFun (fsLit "conT") conTIdKey
1854 tupleTName = libFun (fsLit "tupleT") tupleTIdKey
1855 arrowTName = libFun (fsLit "arrowT") arrowTIdKey
1856 listTName = libFun (fsLit "listT") listTIdKey
1857 appTName = libFun (fsLit "appT") appTIdKey
1859 -- data Callconv = ...
1860 cCallName, stdCallName :: Name
1861 cCallName = libFun (fsLit "cCall") cCallIdKey
1862 stdCallName = libFun (fsLit "stdCall") stdCallIdKey
1864 -- data Safety = ...
1865 unsafeName, safeName, threadsafeName :: Name
1866 unsafeName = libFun (fsLit "unsafe") unsafeIdKey
1867 safeName = libFun (fsLit "safe") safeIdKey
1868 threadsafeName = libFun (fsLit "threadsafe") threadsafeIdKey
1870 -- data InlineSpec = ...
1871 inlineSpecNoPhaseName, inlineSpecPhaseName :: Name
1872 inlineSpecNoPhaseName = libFun (fsLit "inlineSpecNoPhase") inlineSpecNoPhaseIdKey
1873 inlineSpecPhaseName = libFun (fsLit "inlineSpecPhase") inlineSpecPhaseIdKey
1875 -- data FunDep = ...
1877 funDepName = libFun (fsLit "funDep") funDepIdKey
1879 -- data FamFlavour = ...
1880 typeFamName, dataFamName :: Name
1881 typeFamName = libFun (fsLit "typeFam") typeFamIdKey
1882 dataFamName = libFun (fsLit "dataFam") dataFamIdKey
1884 matchQTyConName, clauseQTyConName, expQTyConName, stmtQTyConName,
1885 decQTyConName, conQTyConName, strictTypeQTyConName,
1886 varStrictTypeQTyConName, typeQTyConName, fieldExpQTyConName,
1887 patQTyConName, fieldPatQTyConName, predQTyConName :: Name
1888 matchQTyConName = libTc (fsLit "MatchQ") matchQTyConKey
1889 clauseQTyConName = libTc (fsLit "ClauseQ") clauseQTyConKey
1890 expQTyConName = libTc (fsLit "ExpQ") expQTyConKey
1891 stmtQTyConName = libTc (fsLit "StmtQ") stmtQTyConKey
1892 decQTyConName = libTc (fsLit "DecQ") decQTyConKey
1893 conQTyConName = libTc (fsLit "ConQ") conQTyConKey
1894 strictTypeQTyConName = libTc (fsLit "StrictTypeQ") strictTypeQTyConKey
1895 varStrictTypeQTyConName = libTc (fsLit "VarStrictTypeQ") varStrictTypeQTyConKey
1896 typeQTyConName = libTc (fsLit "TypeQ") typeQTyConKey
1897 fieldExpQTyConName = libTc (fsLit "FieldExpQ") fieldExpQTyConKey
1898 patQTyConName = libTc (fsLit "PatQ") patQTyConKey
1899 fieldPatQTyConName = libTc (fsLit "FieldPatQ") fieldPatQTyConKey
1900 predQTyConName = libTc (fsLit "PredQ") predQTyConKey
1903 quoteExpName, quotePatName :: Name
1904 quoteExpName = qqFun (fsLit "quoteExp") quoteExpKey
1905 quotePatName = qqFun (fsLit "quotePat") quotePatKey
1907 -- TyConUniques available: 100-129
1908 -- Check in PrelNames if you want to change this
1910 expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,
1911 decQTyConKey, patTyConKey, matchQTyConKey, clauseQTyConKey,
1912 stmtQTyConKey, conQTyConKey, typeQTyConKey, typeTyConKey,
1913 decTyConKey, varStrictTypeQTyConKey, strictTypeQTyConKey,
1914 fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey,
1915 fieldPatQTyConKey, fieldExpQTyConKey, funDepTyConKey, predTyConKey,
1916 predQTyConKey :: Unique
1917 expTyConKey = mkPreludeTyConUnique 100
1918 matchTyConKey = mkPreludeTyConUnique 101
1919 clauseTyConKey = mkPreludeTyConUnique 102
1920 qTyConKey = mkPreludeTyConUnique 103
1921 expQTyConKey = mkPreludeTyConUnique 104
1922 decQTyConKey = mkPreludeTyConUnique 105
1923 patTyConKey = mkPreludeTyConUnique 106
1924 matchQTyConKey = mkPreludeTyConUnique 107
1925 clauseQTyConKey = mkPreludeTyConUnique 108
1926 stmtQTyConKey = mkPreludeTyConUnique 109
1927 conQTyConKey = mkPreludeTyConUnique 110
1928 typeQTyConKey = mkPreludeTyConUnique 111
1929 typeTyConKey = mkPreludeTyConUnique 112
1930 decTyConKey = mkPreludeTyConUnique 113
1931 varStrictTypeQTyConKey = mkPreludeTyConUnique 114
1932 strictTypeQTyConKey = mkPreludeTyConUnique 115
1933 fieldExpTyConKey = mkPreludeTyConUnique 116
1934 fieldPatTyConKey = mkPreludeTyConUnique 117
1935 nameTyConKey = mkPreludeTyConUnique 118
1936 patQTyConKey = mkPreludeTyConUnique 119
1937 fieldPatQTyConKey = mkPreludeTyConUnique 120
1938 fieldExpQTyConKey = mkPreludeTyConUnique 121
1939 funDepTyConKey = mkPreludeTyConUnique 122
1940 predTyConKey = mkPreludeTyConUnique 123
1941 predQTyConKey = mkPreludeTyConUnique 124
1943 -- IdUniques available: 200-399
1944 -- If you want to change this, make sure you check in PrelNames
1946 returnQIdKey, bindQIdKey, sequenceQIdKey, liftIdKey, newNameIdKey,
1947 mkNameIdKey, mkNameG_vIdKey, mkNameG_dIdKey, mkNameG_tcIdKey,
1948 mkNameLIdKey :: Unique
1949 returnQIdKey = mkPreludeMiscIdUnique 200
1950 bindQIdKey = mkPreludeMiscIdUnique 201
1951 sequenceQIdKey = mkPreludeMiscIdUnique 202
1952 liftIdKey = mkPreludeMiscIdUnique 203
1953 newNameIdKey = mkPreludeMiscIdUnique 204
1954 mkNameIdKey = mkPreludeMiscIdUnique 205
1955 mkNameG_vIdKey = mkPreludeMiscIdUnique 206
1956 mkNameG_dIdKey = mkPreludeMiscIdUnique 207
1957 mkNameG_tcIdKey = mkPreludeMiscIdUnique 208
1958 mkNameLIdKey = mkPreludeMiscIdUnique 209
1962 charLIdKey, stringLIdKey, integerLIdKey, intPrimLIdKey, wordPrimLIdKey,
1963 floatPrimLIdKey, doublePrimLIdKey, rationalLIdKey :: Unique
1964 charLIdKey = mkPreludeMiscIdUnique 210
1965 stringLIdKey = mkPreludeMiscIdUnique 211
1966 integerLIdKey = mkPreludeMiscIdUnique 212
1967 intPrimLIdKey = mkPreludeMiscIdUnique 213
1968 wordPrimLIdKey = mkPreludeMiscIdUnique 214
1969 floatPrimLIdKey = mkPreludeMiscIdUnique 215
1970 doublePrimLIdKey = mkPreludeMiscIdUnique 216
1971 rationalLIdKey = mkPreludeMiscIdUnique 217
1974 litPIdKey, varPIdKey, tupPIdKey, conPIdKey, infixPIdKey, tildePIdKey,
1975 asPIdKey, wildPIdKey, recPIdKey, listPIdKey, sigPIdKey :: Unique
1976 litPIdKey = mkPreludeMiscIdUnique 220
1977 varPIdKey = mkPreludeMiscIdUnique 221
1978 tupPIdKey = mkPreludeMiscIdUnique 222
1979 conPIdKey = mkPreludeMiscIdUnique 223
1980 infixPIdKey = mkPreludeMiscIdUnique 312
1981 tildePIdKey = mkPreludeMiscIdUnique 224
1982 asPIdKey = mkPreludeMiscIdUnique 225
1983 wildPIdKey = mkPreludeMiscIdUnique 226
1984 recPIdKey = mkPreludeMiscIdUnique 227
1985 listPIdKey = mkPreludeMiscIdUnique 228
1986 sigPIdKey = mkPreludeMiscIdUnique 229
1988 -- type FieldPat = ...
1989 fieldPatIdKey :: Unique
1990 fieldPatIdKey = mkPreludeMiscIdUnique 230
1993 matchIdKey :: Unique
1994 matchIdKey = mkPreludeMiscIdUnique 231
1996 -- data Clause = ...
1997 clauseIdKey :: Unique
1998 clauseIdKey = mkPreludeMiscIdUnique 232
2001 varEIdKey, conEIdKey, litEIdKey, appEIdKey, infixEIdKey, infixAppIdKey,
2002 sectionLIdKey, sectionRIdKey, lamEIdKey, tupEIdKey, condEIdKey,
2003 letEIdKey, caseEIdKey, doEIdKey, compEIdKey,
2004 fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey,
2005 listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey :: Unique
2006 varEIdKey = mkPreludeMiscIdUnique 240
2007 conEIdKey = mkPreludeMiscIdUnique 241
2008 litEIdKey = mkPreludeMiscIdUnique 242
2009 appEIdKey = mkPreludeMiscIdUnique 243
2010 infixEIdKey = mkPreludeMiscIdUnique 244
2011 infixAppIdKey = mkPreludeMiscIdUnique 245
2012 sectionLIdKey = mkPreludeMiscIdUnique 246
2013 sectionRIdKey = mkPreludeMiscIdUnique 247
2014 lamEIdKey = mkPreludeMiscIdUnique 248
2015 tupEIdKey = mkPreludeMiscIdUnique 249
2016 condEIdKey = mkPreludeMiscIdUnique 250
2017 letEIdKey = mkPreludeMiscIdUnique 251
2018 caseEIdKey = mkPreludeMiscIdUnique 252
2019 doEIdKey = mkPreludeMiscIdUnique 253
2020 compEIdKey = mkPreludeMiscIdUnique 254
2021 fromEIdKey = mkPreludeMiscIdUnique 255
2022 fromThenEIdKey = mkPreludeMiscIdUnique 256
2023 fromToEIdKey = mkPreludeMiscIdUnique 257
2024 fromThenToEIdKey = mkPreludeMiscIdUnique 258
2025 listEIdKey = mkPreludeMiscIdUnique 259
2026 sigEIdKey = mkPreludeMiscIdUnique 260
2027 recConEIdKey = mkPreludeMiscIdUnique 261
2028 recUpdEIdKey = mkPreludeMiscIdUnique 262
2030 -- type FieldExp = ...
2031 fieldExpIdKey :: Unique
2032 fieldExpIdKey = mkPreludeMiscIdUnique 265
2035 guardedBIdKey, normalBIdKey :: Unique
2036 guardedBIdKey = mkPreludeMiscIdUnique 266
2037 normalBIdKey = mkPreludeMiscIdUnique 267
2040 normalGEIdKey, patGEIdKey :: Unique
2041 normalGEIdKey = mkPreludeMiscIdUnique 310
2042 patGEIdKey = mkPreludeMiscIdUnique 311
2045 bindSIdKey, letSIdKey, noBindSIdKey, parSIdKey :: Unique
2046 bindSIdKey = mkPreludeMiscIdUnique 268
2047 letSIdKey = mkPreludeMiscIdUnique 269
2048 noBindSIdKey = mkPreludeMiscIdUnique 270
2049 parSIdKey = mkPreludeMiscIdUnique 271
2052 funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey,
2053 classDIdKey, instanceDIdKey, sigDIdKey, forImpDIdKey, pragInlDIdKey,
2054 pragSpecDIdKey, pragSpecInlDIdKey, familyDIdKey, dataInstDIdKey,
2055 newtypeInstDIdKey, tySynInstDIdKey :: Unique
2056 funDIdKey = mkPreludeMiscIdUnique 272
2057 valDIdKey = mkPreludeMiscIdUnique 273
2058 dataDIdKey = mkPreludeMiscIdUnique 274
2059 newtypeDIdKey = mkPreludeMiscIdUnique 275
2060 tySynDIdKey = mkPreludeMiscIdUnique 276
2061 classDIdKey = mkPreludeMiscIdUnique 277
2062 instanceDIdKey = mkPreludeMiscIdUnique 278
2063 sigDIdKey = mkPreludeMiscIdUnique 279
2064 forImpDIdKey = mkPreludeMiscIdUnique 297
2065 pragInlDIdKey = mkPreludeMiscIdUnique 348
2066 pragSpecDIdKey = mkPreludeMiscIdUnique 349
2067 pragSpecInlDIdKey = mkPreludeMiscIdUnique 352
2068 familyDIdKey = mkPreludeMiscIdUnique 340
2069 dataInstDIdKey = mkPreludeMiscIdUnique 341
2070 newtypeInstDIdKey = mkPreludeMiscIdUnique 342
2071 tySynInstDIdKey = mkPreludeMiscIdUnique 343
2075 cxtIdKey = mkPreludeMiscIdUnique 280
2078 classPIdKey, equalPIdKey :: Unique
2079 classPIdKey = mkPreludeMiscIdUnique 346
2080 equalPIdKey = mkPreludeMiscIdUnique 347
2082 -- data Strict = ...
2083 isStrictKey, notStrictKey :: Unique
2084 isStrictKey = mkPreludeMiscIdUnique 281
2085 notStrictKey = mkPreludeMiscIdUnique 282
2088 normalCIdKey, recCIdKey, infixCIdKey, forallCIdKey :: Unique
2089 normalCIdKey = mkPreludeMiscIdUnique 283
2090 recCIdKey = mkPreludeMiscIdUnique 284
2091 infixCIdKey = mkPreludeMiscIdUnique 285
2092 forallCIdKey = mkPreludeMiscIdUnique 288
2094 -- type StrictType = ...
2095 strictTKey :: Unique
2096 strictTKey = mkPreludeMiscIdUnique 286
2098 -- type VarStrictType = ...
2099 varStrictTKey :: Unique
2100 varStrictTKey = mkPreludeMiscIdUnique 287
2103 forallTIdKey, varTIdKey, conTIdKey, tupleTIdKey, arrowTIdKey,
2104 listTIdKey, appTIdKey :: Unique
2105 forallTIdKey = mkPreludeMiscIdUnique 290
2106 varTIdKey = mkPreludeMiscIdUnique 291
2107 conTIdKey = mkPreludeMiscIdUnique 292
2108 tupleTIdKey = mkPreludeMiscIdUnique 294
2109 arrowTIdKey = mkPreludeMiscIdUnique 295
2110 listTIdKey = mkPreludeMiscIdUnique 296
2111 appTIdKey = mkPreludeMiscIdUnique 293
2113 -- data Callconv = ...
2114 cCallIdKey, stdCallIdKey :: Unique
2115 cCallIdKey = mkPreludeMiscIdUnique 300
2116 stdCallIdKey = mkPreludeMiscIdUnique 301
2118 -- data Safety = ...
2119 unsafeIdKey, safeIdKey, threadsafeIdKey :: Unique
2120 unsafeIdKey = mkPreludeMiscIdUnique 305
2121 safeIdKey = mkPreludeMiscIdUnique 306
2122 threadsafeIdKey = mkPreludeMiscIdUnique 307
2124 -- data InlineSpec =
2125 inlineSpecNoPhaseIdKey, inlineSpecPhaseIdKey :: Unique
2126 inlineSpecNoPhaseIdKey = mkPreludeMiscIdUnique 350
2127 inlineSpecPhaseIdKey = mkPreludeMiscIdUnique 351
2129 -- data FunDep = ...
2130 funDepIdKey :: Unique
2131 funDepIdKey = mkPreludeMiscIdUnique 320
2133 -- data FamFlavour = ...
2134 typeFamIdKey, dataFamIdKey :: Unique
2135 typeFamIdKey = mkPreludeMiscIdUnique 344
2136 dataFamIdKey = mkPreludeMiscIdUnique 345
2139 quoteExpKey, quotePatKey :: Unique
2140 quoteExpKey = mkPreludeMiscIdUnique 321
2141 quotePatKey = mkPreludeMiscIdUnique 322