Merge branch 'master' of http://darcs.haskell.org//ghc
[ghc.git] / compiler / deSugar / DsMeta.hs
1 -----------------------------------------------------------------------------
2 --
3 -- (c) The University of Glasgow 2006
4 --
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.
9 --
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 -----------------------------------------------------------------------------
15
16 {-# OPTIONS -fno-warn-tabs #-}
17 -- The above warning supression flag is a temporary kludge.
18 -- While working on this module you are encouraged to remove it and
19 -- detab the module (please do the detabbing in a separate patch). See
20 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
21 -- for details
22
23 module DsMeta( dsBracket,
24 templateHaskellNames, qTyConName, nameTyConName,
25 liftName, liftStringName, expQTyConName, patQTyConName,
26 decQTyConName, decsQTyConName, typeQTyConName,
27 decTyConName, typeTyConName, mkNameG_dName, mkNameG_vName, mkNameG_tcName,
28 quoteExpName, quotePatName, quoteDecName, quoteTypeName
29 ) where
30
31 #include "HsVersions.h"
32
33 import {-# SOURCE #-} DsExpr ( dsExpr )
34
35 import MatchLit
36 import DsMonad
37
38 import qualified Language.Haskell.TH as TH
39
40 import HsSyn
41 import Class
42 import PrelNames
43 -- To avoid clashes with DsMeta.varName we must make a local alias for
44 -- OccName.varName we do this by removing varName from the import of
45 -- OccName above, making a qualified instance of OccName and using
46 -- OccNameAlias.varName where varName ws previously used in this file.
47 import qualified OccName( isDataOcc, isVarOcc, isTcOcc, varName, tcName )
48
49 import Module
50 import Id
51 import Name hiding( isVarOcc, isTcOcc, varName, tcName )
52 import NameEnv
53 import TcType
54 import TyCon
55 import TysWiredIn
56 import TysPrim ( liftedTypeKindTyConName )
57 import CoreSyn
58 import MkCore
59 import CoreUtils
60 import SrcLoc
61 import Unique
62 import BasicTypes
63 import Outputable
64 import Bag
65 import FastString
66 import ForeignCall
67 import MonadUtils
68 import Util( equalLength, filterOut )
69
70 import Data.Maybe
71 import Control.Monad
72 import Data.List
73
74 -----------------------------------------------------------------------------
75 dsBracket :: HsBracket Name -> [PendingSplice] -> DsM CoreExpr
76 -- Returns a CoreExpr of type TH.ExpQ
77 -- The quoted thing is parameterised over Name, even though it has
78 -- been type checked. We don't want all those type decorations!
79
80 dsBracket brack splices
81 = dsExtendMetaEnv new_bit (do_brack brack)
82 where
83 new_bit = mkNameEnv [(n, Splice (unLoc e)) | (n,e) <- splices]
84
85 do_brack (VarBr _ n) = do { MkC e1 <- lookupOcc n ; return e1 }
86 do_brack (ExpBr e) = do { MkC e1 <- repLE e ; return e1 }
87 do_brack (PatBr p) = do { MkC p1 <- repTopP p ; return p1 }
88 do_brack (TypBr t) = do { MkC t1 <- repLTy t ; return t1 }
89 do_brack (DecBrG gp) = do { MkC ds1 <- repTopDs gp ; return ds1 }
90 do_brack (DecBrL _) = panic "dsBracket: unexpected DecBrL"
91
92 {- -------------- Examples --------------------
93
94 [| \x -> x |]
95 ====>
96 gensym (unpackString "x"#) `bindQ` \ x1::String ->
97 lam (pvar x1) (var x1)
98
99
100 [| \x -> $(f [| x |]) |]
101 ====>
102 gensym (unpackString "x"#) `bindQ` \ x1::String ->
103 lam (pvar x1) (f (var x1))
104 -}
105
106
107 -------------------------------------------------------
108 -- Declarations
109 -------------------------------------------------------
110
111 repTopP :: LPat Name -> DsM (Core TH.PatQ)
112 repTopP pat = do { ss <- mkGenSyms (collectPatBinders pat)
113 ; pat' <- addBinds ss (repLP pat)
114 ; wrapGenSyms ss pat' }
115
116 repTopDs :: HsGroup Name -> DsM (Core (TH.Q [TH.Dec]))
117 repTopDs group
118 = do { let { tv_bndrs = hsSigTvBinders (hs_valds group)
119 ; bndrs = tv_bndrs ++ hsGroupBinders group } ;
120 ss <- mkGenSyms bndrs ;
121
122 -- Bind all the names mainly to avoid repeated use of explicit strings.
123 -- Thus we get
124 -- do { t :: String <- genSym "T" ;
125 -- return (Data t [] ...more t's... }
126 -- The other important reason is that the output must mention
127 -- only "T", not "Foo:T" where Foo is the current module
128
129 decls <- addBinds ss (do {
130 fix_ds <- mapM repFixD (hs_fixds group) ;
131 val_ds <- rep_val_binds (hs_valds group) ;
132 tycl_ds <- mapM repTyClD (concat (hs_tyclds group)) ;
133 inst_ds <- mapM repInstD (hs_instds group) ;
134 for_ds <- mapM repForD (hs_fords group) ;
135 -- more needed
136 return (de_loc $ sort_by_loc $
137 val_ds ++ catMaybes tycl_ds ++ fix_ds
138 ++ inst_ds ++ for_ds) }) ;
139
140 decl_ty <- lookupType decQTyConName ;
141 let { core_list = coreList' decl_ty decls } ;
142
143 dec_ty <- lookupType decTyConName ;
144 q_decs <- repSequenceQ dec_ty core_list ;
145
146 wrapGenSyms ss q_decs
147 }
148
149
150 hsSigTvBinders :: HsValBinds Name -> [Name]
151 -- See Note [Scoped type variables in bindings]
152 hsSigTvBinders binds
153 = [hsLTyVarName tv | L _ (TypeSig _ (L _ (HsForAllTy Explicit tvs _ _))) <- sigs, tv <- tvs]
154 where
155 sigs = case binds of
156 ValBindsIn _ sigs -> sigs
157 ValBindsOut _ sigs -> sigs
158
159
160 {- Notes
161
162 Note [Scoped type variables in bindings]
163 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
164 Consider
165 f :: forall a. a -> a
166 f x = x::a
167 Here the 'forall a' brings 'a' into scope over the binding group.
168 To achieve this we
169
170 a) Gensym a binding for 'a' at the same time as we do one for 'f'
171 collecting the relevant binders with hsSigTvBinders
172
173 b) When processing the 'forall', don't gensym
174
175 The relevant places are signposted with references to this Note
176
177 Note [Binders and occurrences]
178 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
179 When we desugar [d| data T = MkT |]
180 we want to get
181 Data "T" [] [Con "MkT" []] []
182 and *not*
183 Data "Foo:T" [] [Con "Foo:MkT" []] []
184 That is, the new data decl should fit into whatever new module it is
185 asked to fit in. We do *not* clone, though; no need for this:
186 Data "T79" ....
187
188 But if we see this:
189 data T = MkT
190 foo = reifyDecl T
191
192 then we must desugar to
193 foo = Data "Foo:T" [] [Con "Foo:MkT" []] []
194
195 So in repTopDs we bring the binders into scope with mkGenSyms and addBinds.
196 And we use lookupOcc, rather than lookupBinder
197 in repTyClD and repC.
198
199 -}
200
201 -- represent associated family instances
202 --
203 repTyClDs :: [LTyClDecl Name] -> DsM [Core TH.DecQ]
204 repTyClDs ds = liftM de_loc (mapMaybeM repTyClD ds)
205
206
207 repTyClD :: LTyClDecl Name -> DsM (Maybe (SrcSpan, Core TH.DecQ))
208
209 repTyClD (L loc (TyFamily { tcdFlavour = flavour,
210 tcdLName = tc, tcdTyVars = tvs,
211 tcdKindSig = opt_kind }))
212 = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences]
213 ; dec <- addTyClTyVarBinds tvs $ \bndrs ->
214 do { flav <- repFamilyFlavour flavour
215 ; case opt_kind of
216 Nothing -> repFamilyNoKind flav tc1 bndrs
217 Just (HsBSig ki _)
218 -> do { ki1 <- repKind ki
219 ; repFamilyKind flav tc1 bndrs ki1 }
220 }
221 ; return $ Just (loc, dec)
222 }
223
224 repTyClD (L loc (TyDecl { tcdLName = tc, tcdTyVars = tvs, tcdTyDefn = defn }))
225 = do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences]
226 ; tc_tvs <- mk_extra_tvs tc tvs defn
227 ; dec <- addTyClTyVarBinds tc_tvs $ \bndrs ->
228 repTyDefn tc1 bndrs Nothing (hsLTyVarNames tc_tvs) defn
229 ; return (Just (loc, dec)) }
230
231 repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
232 tcdTyVars = tvs, tcdFDs = fds,
233 tcdSigs = sigs, tcdMeths = meth_binds,
234 tcdATs = ats, tcdATDefs = [] }))
235 = do { cls1 <- lookupLOcc cls -- See note [Binders and occurrences]
236 ; dec <- addTyVarBinds tvs $ \bndrs ->
237 do { cxt1 <- repLContext cxt
238 ; sigs1 <- rep_sigs sigs
239 ; binds1 <- rep_binds meth_binds
240 ; fds1 <- repLFunDeps fds
241 ; ats1 <- repTyClDs ats
242 ; decls1 <- coreList decQTyConName (ats1 ++ sigs1 ++ binds1)
243 ; repClass cxt1 cls1 bndrs fds1 decls1
244 }
245 ; return $ Just (loc, dec)
246 }
247
248 -- Un-handled cases
249 repTyClD (L loc d) = putSrcSpanDs loc $
250 do { warnDs (hang ds_msg 4 (ppr d))
251 ; return Nothing }
252
253 -------------------------
254 repTyDefn :: Core TH.Name -> Core [TH.TyVarBndr]
255 -> Maybe (Core [TH.TypeQ])
256 -> [Name] -> HsTyDefn Name
257 -> DsM (Core TH.DecQ)
258 repTyDefn tc bndrs opt_tys tv_names
259 (TyData { td_ND = new_or_data, td_ctxt = cxt
260 , td_cons = cons, td_derivs = mb_derivs })
261 = do { cxt1 <- repLContext cxt
262 ; derivs1 <- repDerivs mb_derivs
263 ; case new_or_data of
264 NewType -> do { con1 <- repC tv_names (head cons)
265 ; repNewtype cxt1 tc bndrs opt_tys con1 derivs1 }
266 DataType -> do { cons1 <- mapM (repC tv_names) cons
267 ; cons2 <- coreList conQTyConName cons1
268 ; repData cxt1 tc bndrs opt_tys cons2 derivs1 } }
269
270 repTyDefn tc bndrs opt_tys _ (TySynonym { td_synRhs = ty })
271 = do { ty1 <- repLTy ty
272 ; repTySyn tc bndrs opt_tys ty1 }
273
274 -------------------------
275 mk_extra_tvs :: Located Name -> [LHsTyVarBndr Name]
276 -> HsTyDefn Name -> DsM [LHsTyVarBndr Name]
277 -- If there is a kind signature it must be of form
278 -- k1 -> .. -> kn -> *
279 -- Return type variables [tv1:k1, tv2:k2, .., tvn:kn]
280 mk_extra_tvs tc tvs defn
281 | TyData { td_kindSig = Just (HsBSig hs_kind _) } <- defn
282 = do { extra_tvs <- go hs_kind
283 ; return (tvs ++ extra_tvs) }
284 | otherwise
285 = return tvs
286 where
287 go :: LHsKind Name -> DsM [LHsTyVarBndr Name]
288 go (L loc (HsFunTy kind rest))
289 = do { uniq <- newUnique
290 ; let { occ = mkTyVarOccFS (fsLit "t")
291 ; nm = mkInternalName uniq occ loc
292 ; hs_tv = L loc (KindedTyVar nm (mkHsBSig kind)) }
293 ; hs_tvs <- go rest
294 ; return (hs_tv : hs_tvs) }
295
296 go (L _ (HsTyVar n))
297 | n == liftedTypeKindTyConName
298 = return []
299
300 go _ = failWithDs (ptext (sLit "Malformed kind signature for") <+> ppr tc)
301
302 -------------------------
303 -- represent fundeps
304 --
305 repLFunDeps :: [Located (FunDep Name)] -> DsM (Core [TH.FunDep])
306 repLFunDeps fds = do fds' <- mapM repLFunDep fds
307 fdList <- coreList funDepTyConName fds'
308 return fdList
309
310 repLFunDep :: Located (FunDep Name) -> DsM (Core TH.FunDep)
311 repLFunDep (L _ (xs, ys)) = do xs' <- mapM lookupBinder xs
312 ys' <- mapM lookupBinder ys
313 xs_list <- coreList nameTyConName xs'
314 ys_list <- coreList nameTyConName ys'
315 repFunDep xs_list ys_list
316
317 -- represent family declaration flavours
318 --
319 repFamilyFlavour :: FamilyFlavour -> DsM (Core TH.FamFlavour)
320 repFamilyFlavour TypeFamily = rep2 typeFamName []
321 repFamilyFlavour DataFamily = rep2 dataFamName []
322
323 -- Represent instance declarations
324 --
325 repInstD :: LInstDecl Name -> DsM (SrcSpan, Core TH.DecQ)
326 repInstD (L loc (FamInstD { lid_inst = fi_decl }))
327 = do { dec <- repFamInstD fi_decl
328 ; return (loc, dec) }
329
330 repInstD (L loc (ClsInstD { cid_poly_ty = ty, cid_binds = binds
331 , cid_sigs = prags, cid_fam_insts = ats }))
332 = do { dec <- addTyVarBinds tvs $ \_ ->
333 -- We must bring the type variables into scope, so their
334 -- occurrences don't fail, even though the binders don't
335 -- appear in the resulting data structure
336 --
337 -- But we do NOT bring the binders of 'binds' into scope
338 -- becuase they are properly regarded as occurrences
339 -- For example, the method names should be bound to
340 -- the selector Ids, not to fresh names (Trac #5410)
341 --
342 do { cxt1 <- repContext cxt
343 ; cls_tcon <- repTy (HsTyVar cls)
344 ; cls_tys <- repLTys tys
345 ; inst_ty1 <- repTapps cls_tcon cls_tys
346 ; binds1 <- rep_binds binds
347 ; prags1 <- rep_sigs prags
348 ; ats1 <- mapM (repFamInstD . unLoc) ats
349 ; decls <- coreList decQTyConName (ats1 ++ binds1 ++ prags1)
350 ; repInst cxt1 inst_ty1 decls }
351 ; return (loc, dec) }
352 where
353 Just (tvs, cxt, cls, tys) = splitHsInstDeclTy_maybe (unLoc ty)
354
355 repFamInstD :: FamInstDecl Name -> DsM (Core TH.DecQ)
356 repFamInstD (FamInstDecl { fid_tycon = tc_name
357 , fid_pats = HsBSig tys (kv_names, tv_names)
358 , fid_defn = defn })
359 = WARN( not (null kv_names), ppr kv_names ) -- We have not yet dealt with kind
360 -- polymorphism in Template Haskell (sigh)
361 do { tc <- lookupLOcc tc_name -- See note [Binders and occurrences]
362 ; let loc = getLoc tc_name
363 hs_tvs = [ L loc (UserTyVar n) | n <- tv_names] -- Yuk
364 ; addTyClTyVarBinds hs_tvs $ \ bndrs ->
365 do { tys1 <- repLTys tys
366 ; tys2 <- coreList typeQTyConName tys1
367 ; repTyDefn tc bndrs (Just tys2) tv_names defn } }
368
369 repForD :: Located (ForeignDecl Name) -> DsM (SrcSpan, Core TH.DecQ)
370 repForD (L loc (ForeignImport name typ _ (CImport cc s mch cis)))
371 = do MkC name' <- lookupLOcc name
372 MkC typ' <- repLTy typ
373 MkC cc' <- repCCallConv cc
374 MkC s' <- repSafety s
375 cis' <- conv_cimportspec cis
376 MkC str <- coreStringLit (static ++ chStr ++ cis')
377 dec <- rep2 forImpDName [cc', s', str, name', typ']
378 return (loc, dec)
379 where
380 conv_cimportspec (CLabel cls) = notHandled "Foreign label" (doubleQuotes (ppr cls))
381 conv_cimportspec (CFunction DynamicTarget) = return "dynamic"
382 conv_cimportspec (CFunction (StaticTarget fs _ True)) = return (unpackFS fs)
383 conv_cimportspec (CFunction (StaticTarget _ _ False)) = panic "conv_cimportspec: values not supported yet"
384 conv_cimportspec CWrapper = return "wrapper"
385 static = case cis of
386 CFunction (StaticTarget _ _ _) -> "static "
387 _ -> ""
388 chStr = case mch of
389 Nothing -> ""
390 Just (Header h) -> unpackFS h ++ " "
391 repForD decl = notHandled "Foreign declaration" (ppr decl)
392
393 repCCallConv :: CCallConv -> DsM (Core TH.Callconv)
394 repCCallConv CCallConv = rep2 cCallName []
395 repCCallConv StdCallConv = rep2 stdCallName []
396 repCCallConv callConv = notHandled "repCCallConv" (ppr callConv)
397
398 repSafety :: Safety -> DsM (Core TH.Safety)
399 repSafety PlayRisky = rep2 unsafeName []
400 repSafety PlayInterruptible = rep2 interruptibleName []
401 repSafety PlaySafe = rep2 safeName []
402
403 repFixD :: LFixitySig Name -> DsM (SrcSpan, Core TH.DecQ)
404 repFixD (L loc (FixitySig name (Fixity prec dir)))
405 = do { MkC name' <- lookupLOcc name
406 ; MkC prec' <- coreIntLit prec
407 ; let rep_fn = case dir of
408 InfixL -> infixLDName
409 InfixR -> infixRDName
410 InfixN -> infixNDName
411 ; dec <- rep2 rep_fn [prec', name']
412 ; return (loc, dec) }
413
414 ds_msg :: SDoc
415 ds_msg = ptext (sLit "Cannot desugar this Template Haskell declaration:")
416
417 -------------------------------------------------------
418 -- Constructors
419 -------------------------------------------------------
420
421 repC :: [Name] -> LConDecl Name -> DsM (Core TH.ConQ)
422 repC _ (L _ (ConDecl { con_name = con, con_qvars = [], con_cxt = L _ []
423 , con_details = details, con_res = ResTyH98 }))
424 = do { con1 <- lookupLOcc con -- See note [Binders and occurrences]
425 ; repConstr con1 details }
426 repC tvs (L _ (ConDecl { con_name = con
427 , con_qvars = con_tvs, con_cxt = L _ ctxt
428 , con_details = details
429 , con_res = res_ty }))
430 = do { (eq_ctxt, con_tv_subst) <- mkGadtCtxt tvs res_ty
431 ; let ex_tvs = [ tv | tv <- con_tvs, not (hsLTyVarName tv `in_subst` con_tv_subst)]
432 ; binds <- mapM dupBinder con_tv_subst
433 ; dsExtendMetaEnv (mkNameEnv binds) $ -- Binds some of the con_tvs
434 addTyVarBinds ex_tvs $ \ ex_bndrs -> -- Binds the remaining con_tvs
435 do { con1 <- lookupLOcc con -- See note [Binders and occurrences]
436 ; c' <- repConstr con1 details
437 ; ctxt' <- repContext (eq_ctxt ++ ctxt)
438 ; rep2 forallCName [unC ex_bndrs, unC ctxt', unC c'] } }
439
440 in_subst :: Name -> [(Name,Name)] -> Bool
441 in_subst _ [] = False
442 in_subst n ((n',_):ns) = n==n' || in_subst n ns
443
444 mkGadtCtxt :: [Name] -- Tyvars of the data type
445 -> ResType (LHsType Name)
446 -> DsM (HsContext Name, [(Name,Name)])
447 -- Given a data type in GADT syntax, figure out the equality
448 -- context, so that we can represent it with an explicit
449 -- equality context, because that is the only way to express
450 -- the GADT in TH syntax
451 --
452 -- Example:
453 -- data T a b c where { MkT :: forall d e. d -> e -> T d [e] e
454 -- mkGadtCtxt [a,b,c] [d,e] (T d [e] e)
455 -- returns
456 -- (b~[e], c~e), [d->a]
457 --
458 -- This function is fiddly, but not really hard
459 mkGadtCtxt _ ResTyH98
460 = return ([], [])
461 mkGadtCtxt data_tvs (ResTyGADT res_ty)
462 | let (head_ty, tys) = splitHsAppTys res_ty []
463 , Just _ <- is_hs_tyvar head_ty
464 , data_tvs `equalLength` tys
465 = return (go [] [] (data_tvs `zip` tys))
466
467 | otherwise
468 = failWithDs (ptext (sLit "Malformed constructor result type:") <+> ppr res_ty)
469 where
470 go cxt subst [] = (cxt, subst)
471 go cxt subst ((data_tv, ty) : rest)
472 | Just con_tv <- is_hs_tyvar ty
473 , isTyVarName con_tv
474 , not (in_subst con_tv subst)
475 = go cxt ((con_tv, data_tv) : subst) rest
476 | otherwise
477 = go (eq_pred : cxt) subst rest
478 where
479 loc = getLoc ty
480 eq_pred = L loc (HsEqTy (L loc (HsTyVar data_tv)) ty)
481
482 is_hs_tyvar (L _ (HsTyVar n)) = Just n -- Type variables *and* tycons
483 is_hs_tyvar (L _ (HsParTy ty)) = is_hs_tyvar ty
484 is_hs_tyvar _ = Nothing
485
486
487 repBangTy :: LBangType Name -> DsM (Core (TH.StrictTypeQ))
488 repBangTy ty= do
489 MkC s <- rep2 str []
490 MkC t <- repLTy ty'
491 rep2 strictTypeName [s, t]
492 where
493 (str, ty') = case ty of
494 L _ (HsBangTy HsUnpack ty) -> (unpackedName, ty)
495 L _ (HsBangTy _ ty) -> (isStrictName, ty)
496 _ -> (notStrictName, ty)
497
498 -------------------------------------------------------
499 -- Deriving clause
500 -------------------------------------------------------
501
502 repDerivs :: Maybe [LHsType Name] -> DsM (Core [TH.Name])
503 repDerivs Nothing = coreList nameTyConName []
504 repDerivs (Just ctxt)
505 = do { strs <- mapM rep_deriv ctxt ;
506 coreList nameTyConName strs }
507 where
508 rep_deriv :: LHsType Name -> DsM (Core TH.Name)
509 -- Deriving clauses must have the simple H98 form
510 rep_deriv ty
511 | Just (cls, []) <- splitHsClassTy_maybe (unLoc ty)
512 = lookupOcc cls
513 | otherwise
514 = notHandled "Non-H98 deriving clause" (ppr ty)
515
516
517 -------------------------------------------------------
518 -- Signatures in a class decl, or a group of bindings
519 -------------------------------------------------------
520
521 rep_sigs :: [LSig Name] -> DsM [Core TH.DecQ]
522 rep_sigs sigs = do locs_cores <- rep_sigs' sigs
523 return $ de_loc $ sort_by_loc locs_cores
524
525 rep_sigs' :: [LSig Name] -> DsM [(SrcSpan, Core TH.DecQ)]
526 -- We silently ignore ones we don't recognise
527 rep_sigs' sigs = do { sigs1 <- mapM rep_sig sigs ;
528 return (concat sigs1) }
529
530 rep_sig :: LSig Name -> DsM [(SrcSpan, Core TH.DecQ)]
531 -- Singleton => Ok
532 -- Empty => Too hard, signature ignored
533 rep_sig (L loc (TypeSig nms ty)) = mapM (rep_ty_sig loc ty) nms
534 rep_sig (L _ (GenericSig nm _)) = failWithDs msg
535 where msg = vcat [ ptext (sLit "Illegal default signature for") <+> quotes (ppr nm)
536 , ptext (sLit "Default signatures are not supported by Template Haskell") ]
537
538 rep_sig (L loc (InlineSig nm ispec)) = rep_inline nm ispec loc
539 rep_sig (L loc (SpecSig nm ty ispec)) = rep_specialise nm ty ispec loc
540 rep_sig _ = return []
541
542 rep_ty_sig :: SrcSpan -> LHsType Name -> Located Name
543 -> DsM (SrcSpan, Core TH.DecQ)
544 rep_ty_sig loc (L _ ty) nm
545 = do { nm1 <- lookupLOcc nm
546 ; ty1 <- rep_ty ty
547 ; sig <- repProto nm1 ty1
548 ; return (loc, sig) }
549 where
550 -- We must special-case the top-level explicit for-all of a TypeSig
551 -- See Note [Scoped type variables in bindings]
552 rep_ty (HsForAllTy Explicit tvs ctxt ty)
553 = do { let rep_in_scope_tv tv = do { name <- lookupBinder (hsLTyVarName tv)
554 ; repTyVarBndrWithKind tv name }
555 ; bndrs1 <- mapM rep_in_scope_tv tvs
556 ; bndrs2 <- coreList tyVarBndrTyConName bndrs1
557 ; ctxt1 <- repLContext ctxt
558 ; ty1 <- repLTy ty
559 ; repTForall bndrs2 ctxt1 ty1 }
560
561 rep_ty ty = repTy ty
562
563
564 rep_inline :: Located Name
565 -> InlinePragma -- Never defaultInlinePragma
566 -> SrcSpan
567 -> DsM [(SrcSpan, Core TH.DecQ)]
568 rep_inline nm ispec loc
569 = do { nm1 <- lookupLOcc nm
570 ; ispec1 <- rep_InlinePrag ispec
571 ; pragma <- repPragInl nm1 ispec1
572 ; return [(loc, pragma)]
573 }
574
575 rep_specialise :: Located Name -> LHsType Name -> InlinePragma -> SrcSpan
576 -> DsM [(SrcSpan, Core TH.DecQ)]
577 rep_specialise nm ty ispec loc
578 = do { nm1 <- lookupLOcc nm
579 ; ty1 <- repLTy ty
580 ; pragma <- if isDefaultInlinePragma ispec
581 then repPragSpec nm1 ty1 -- SPECIALISE
582 else do { ispec1 <- rep_InlinePrag ispec -- SPECIALISE INLINE
583 ; repPragSpecInl nm1 ty1 ispec1 }
584 ; return [(loc, pragma)]
585 }
586
587 -- Extract all the information needed to build a TH.InlinePrag
588 --
589 rep_InlinePrag :: InlinePragma -- Never defaultInlinePragma
590 -> DsM (Core TH.InlineSpecQ)
591 rep_InlinePrag (InlinePragma { inl_act = activation, inl_rule = match, inl_inline = inline })
592 | Just (flag, phase) <- activation1
593 = repInlineSpecPhase inline1 match1 flag phase
594 | otherwise
595 = repInlineSpecNoPhase inline1 match1
596 where
597 match1 = coreBool (rep_RuleMatchInfo match)
598 activation1 = rep_Activation activation
599 inline1 = case inline of
600 Inline -> coreBool True
601 _other -> coreBool False
602 -- We have no representation for Inlinable
603
604 rep_RuleMatchInfo FunLike = False
605 rep_RuleMatchInfo ConLike = True
606
607 rep_Activation NeverActive = Nothing -- We never have NOINLINE/AlwaysActive
608 rep_Activation AlwaysActive = Nothing -- or INLINE/NeverActive
609 rep_Activation (ActiveBefore phase) = Just (coreBool False,
610 MkC $ mkIntExprInt phase)
611 rep_Activation (ActiveAfter phase) = Just (coreBool True,
612 MkC $ mkIntExprInt phase)
613
614
615 -------------------------------------------------------
616 -- Types
617 -------------------------------------------------------
618
619 addTyVarBinds :: [LHsTyVarBndr Name] -- the binders to be added
620 -> (Core [TH.TyVarBndr] -> DsM (Core (TH.Q a))) -- action in the ext env
621 -> DsM (Core (TH.Q a))
622 -- gensym a list of type variables and enter them into the meta environment;
623 -- the computations passed as the second argument is executed in that extended
624 -- meta environment and gets the *new* names on Core-level as an argument
625
626 addTyVarBinds tvs m
627 = do { freshNames <- mkGenSyms (hsLTyVarNames tvs)
628 ; term <- addBinds freshNames $
629 do { kbs1 <- mapM mk_tv_bndr (tvs `zip` freshNames)
630 ; kbs2 <- coreList tyVarBndrTyConName kbs1
631 ; m kbs2 }
632 ; wrapGenSyms freshNames term }
633 where
634 mk_tv_bndr (tv, (_,v)) = repTyVarBndrWithKind tv (coreVar v)
635
636 addTyClTyVarBinds :: [LHsTyVarBndr Name]
637 -> (Core [TH.TyVarBndr] -> DsM (Core (TH.Q a)))
638 -> DsM (Core (TH.Q a))
639
640 -- Used for data/newtype declarations, and family instances,
641 -- so that the nested type variables work right
642 -- instance C (T a) where
643 -- type W (T a) = blah
644 -- The 'a' in the type instance is the one bound by the instance decl
645 addTyClTyVarBinds tvs m
646 = do { let tv_names = hsLTyVarNames tvs
647 ; env <- dsGetMetaEnv
648 ; freshNames <- mkGenSyms (filterOut (`elemNameEnv` env) tv_names)
649 -- Make fresh names for the ones that are not already in scope
650 -- This makes things work for family declarations
651
652 ; term <- addBinds freshNames $
653 do { kbs1 <- mapM mk_tv_bndr tvs
654 ; kbs2 <- coreList tyVarBndrTyConName kbs1
655 ; m kbs2 }
656
657 ; wrapGenSyms freshNames term }
658 where
659 mk_tv_bndr tv = do { v <- lookupOcc (hsLTyVarName tv)
660 ; repTyVarBndrWithKind tv v }
661
662 -- Produce kinded binder constructors from the Haskell tyvar binders
663 --
664 repTyVarBndrWithKind :: LHsTyVarBndr Name
665 -> Core TH.Name -> DsM (Core TH.TyVarBndr)
666 repTyVarBndrWithKind (L _ (UserTyVar {})) nm
667 = repPlainTV nm
668 repTyVarBndrWithKind (L _ (KindedTyVar _ (HsBSig ki _))) nm
669 = repKind ki >>= repKindedTV nm
670
671 -- represent a type context
672 --
673 repLContext :: LHsContext Name -> DsM (Core TH.CxtQ)
674 repLContext (L _ ctxt) = repContext ctxt
675
676 repContext :: HsContext Name -> DsM (Core TH.CxtQ)
677 repContext ctxt = do
678 preds <- mapM repLPred ctxt
679 predList <- coreList predQTyConName preds
680 repCtxt predList
681
682 -- represent a type predicate
683 --
684 repLPred :: LHsType Name -> DsM (Core TH.PredQ)
685 repLPred (L _ p) = repPred p
686
687 repPred :: HsType Name -> DsM (Core TH.PredQ)
688 repPred ty
689 | Just (cls, tys) <- splitHsClassTy_maybe ty
690 = do
691 cls1 <- lookupOcc cls
692 tys1 <- repLTys tys
693 tys2 <- coreList typeQTyConName tys1
694 repClassP cls1 tys2
695 repPred (HsEqTy tyleft tyright)
696 = do
697 tyleft1 <- repLTy tyleft
698 tyright1 <- repLTy tyright
699 repEqualP tyleft1 tyright1
700 repPred ty
701 = notHandled "Exotic predicate type" (ppr ty)
702
703 -- yield the representation of a list of types
704 --
705 repLTys :: [LHsType Name] -> DsM [Core TH.TypeQ]
706 repLTys tys = mapM repLTy tys
707
708 -- represent a type
709 --
710 repLTy :: LHsType Name -> DsM (Core TH.TypeQ)
711 repLTy (L _ ty) = repTy ty
712
713 repTy :: HsType Name -> DsM (Core TH.TypeQ)
714 repTy (HsForAllTy _ tvs ctxt ty) =
715 addTyVarBinds tvs $ \bndrs -> do
716 ctxt1 <- repLContext ctxt
717 ty1 <- repLTy ty
718 repTForall bndrs ctxt1 ty1
719
720 repTy (HsTyVar n)
721 | isTvOcc (nameOccName n) = do
722 tv1 <- lookupOcc n
723 repTvar tv1
724 | otherwise = do
725 tc1 <- lookupOcc n
726 repNamedTyCon tc1
727 repTy (HsAppTy f a) = do
728 f1 <- repLTy f
729 a1 <- repLTy a
730 repTapp f1 a1
731 repTy (HsFunTy f a) = do
732 f1 <- repLTy f
733 a1 <- repLTy a
734 tcon <- repArrowTyCon
735 repTapps tcon [f1, a1]
736 repTy (HsListTy t) = do
737 t1 <- repLTy t
738 tcon <- repListTyCon
739 repTapp tcon t1
740 repTy (HsPArrTy t) = do
741 t1 <- repLTy t
742 tcon <- repTy (HsTyVar (tyConName parrTyCon))
743 repTapp tcon t1
744 repTy (HsTupleTy HsUnboxedTuple tys) = do
745 tys1 <- repLTys tys
746 tcon <- repUnboxedTupleTyCon (length tys)
747 repTapps tcon tys1
748 repTy (HsTupleTy _ tys) = do tys1 <- repLTys tys
749 tcon <- repTupleTyCon (length tys)
750 repTapps tcon tys1
751 repTy (HsOpTy ty1 (_, n) ty2) = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1)
752 `nlHsAppTy` ty2)
753 repTy (HsParTy t) = repLTy t
754 repTy (HsKindSig t k) = do
755 t1 <- repLTy t
756 k1 <- repKind k
757 repTSig t1 k1
758 repTy (HsSpliceTy splice _ _) = repSplice splice
759 repTy ty = notHandled "Exotic form of type" (ppr ty)
760
761 -- represent a kind
762 --
763 repKind :: LHsKind Name -> DsM (Core TH.Kind)
764 repKind ki
765 = do { let (kis, ki') = splitHsFunType ki
766 ; kis_rep <- mapM repKind kis
767 ; ki'_rep <- repNonArrowKind ki'
768 ; foldrM repArrowK ki'_rep kis_rep
769 }
770 where
771 repNonArrowKind (L _ (HsTyVar name)) | name == liftedTypeKindTyConName = repStarK
772 repNonArrowKind k = notHandled "Exotic form of kind" (ppr k)
773
774 -----------------------------------------------------------------------------
775 -- Splices
776 -----------------------------------------------------------------------------
777
778 repSplice :: HsSplice Name -> DsM (Core a)
779 -- See Note [How brackets and nested splices are handled] in TcSplice
780 -- We return a CoreExpr of any old type; the context should know
781 repSplice (HsSplice n _)
782 = do { mb_val <- dsLookupMetaEnv n
783 ; case mb_val of
784 Just (Splice e) -> do { e' <- dsExpr e
785 ; return (MkC e') }
786 _ -> pprPanic "HsSplice" (ppr n) }
787 -- Should not happen; statically checked
788
789 -----------------------------------------------------------------------------
790 -- Expressions
791 -----------------------------------------------------------------------------
792
793 repLEs :: [LHsExpr Name] -> DsM (Core [TH.ExpQ])
794 repLEs es = do { es' <- mapM repLE es ;
795 coreList expQTyConName es' }
796
797 -- FIXME: some of these panics should be converted into proper error messages
798 -- unless we can make sure that constructs, which are plainly not
799 -- supported in TH already lead to error messages at an earlier stage
800 repLE :: LHsExpr Name -> DsM (Core TH.ExpQ)
801 repLE (L loc e) = putSrcSpanDs loc (repE e)
802
803 repE :: HsExpr Name -> DsM (Core TH.ExpQ)
804 repE (HsVar x) =
805 do { mb_val <- dsLookupMetaEnv x
806 ; case mb_val of
807 Nothing -> do { str <- globalVar x
808 ; repVarOrCon x str }
809 Just (Bound y) -> repVarOrCon x (coreVar y)
810 Just (Splice e) -> do { e' <- dsExpr e
811 ; return (MkC e') } }
812 repE e@(HsIPVar _) = notHandled "Implicit parameters" (ppr e)
813
814 -- Remember, we're desugaring renamer output here, so
815 -- HsOverlit can definitely occur
816 repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
817 repE (HsLit l) = do { a <- repLiteral l; repLit a }
818 repE (HsLam (MatchGroup [m] _)) = repLambda m
819 repE (HsApp x y) = do {a <- repLE x; b <- repLE y; repApp a b}
820
821 repE (OpApp e1 op _ e2) =
822 do { arg1 <- repLE e1;
823 arg2 <- repLE e2;
824 the_op <- repLE op ;
825 repInfixApp arg1 the_op arg2 }
826 repE (NegApp x _) = do
827 a <- repLE x
828 negateVar <- lookupOcc negateName >>= repVar
829 negateVar `repApp` a
830 repE (HsPar x) = repLE x
831 repE (SectionL x y) = do { a <- repLE x; b <- repLE y; repSectionL a b }
832 repE (SectionR x y) = do { a <- repLE x; b <- repLE y; repSectionR a b }
833 repE (HsCase e (MatchGroup ms _)) = do { arg <- repLE e
834 ; ms2 <- mapM repMatchTup ms
835 ; repCaseE arg (nonEmptyCoreList ms2) }
836 repE (HsIf _ x y z) = do
837 a <- repLE x
838 b <- repLE y
839 c <- repLE z
840 repCond a b c
841 repE (HsLet bs e) = do { (ss,ds) <- repBinds bs
842 ; e2 <- addBinds ss (repLE e)
843 ; z <- repLetE ds e2
844 ; wrapGenSyms ss z }
845
846 -- FIXME: I haven't got the types here right yet
847 repE e@(HsDo ctxt sts _)
848 | case ctxt of { DoExpr -> True; GhciStmt -> True; _ -> False }
849 = do { (ss,zs) <- repLSts sts;
850 e' <- repDoE (nonEmptyCoreList zs);
851 wrapGenSyms ss e' }
852
853 | ListComp <- ctxt
854 = do { (ss,zs) <- repLSts sts;
855 e' <- repComp (nonEmptyCoreList zs);
856 wrapGenSyms ss e' }
857
858 | otherwise
859 = notHandled "mdo, monad comprehension and [: :]" (ppr e)
860
861 repE (ExplicitList _ es) = do { xs <- repLEs es; repListExp xs }
862 repE e@(ExplicitPArr _ _) = notHandled "Parallel arrays" (ppr e)
863 repE e@(ExplicitTuple es boxed)
864 | not (all tupArgPresent es) = notHandled "Tuple sections" (ppr e)
865 | isBoxed boxed = do { xs <- repLEs [e | Present e <- es]; repTup xs }
866 | otherwise = do { xs <- repLEs [e | Present e <- es]; repUnboxedTup xs }
867
868 repE (RecordCon c _ flds)
869 = do { x <- lookupLOcc c;
870 fs <- repFields flds;
871 repRecCon x fs }
872 repE (RecordUpd e flds _ _ _)
873 = do { x <- repLE e;
874 fs <- repFields flds;
875 repRecUpd x fs }
876
877 repE (ExprWithTySig e ty) = do { e1 <- repLE e; t1 <- repLTy ty; repSigExp e1 t1 }
878 repE (ArithSeq _ aseq) =
879 case aseq of
880 From e -> do { ds1 <- repLE e; repFrom ds1 }
881 FromThen e1 e2 -> do
882 ds1 <- repLE e1
883 ds2 <- repLE e2
884 repFromThen ds1 ds2
885 FromTo e1 e2 -> do
886 ds1 <- repLE e1
887 ds2 <- repLE e2
888 repFromTo ds1 ds2
889 FromThenTo e1 e2 e3 -> do
890 ds1 <- repLE e1
891 ds2 <- repLE e2
892 ds3 <- repLE e3
893 repFromThenTo ds1 ds2 ds3
894
895 repE (HsSpliceE splice) = repSplice splice
896 repE e@(PArrSeq {}) = notHandled "Parallel arrays" (ppr e)
897 repE e@(HsCoreAnn {}) = notHandled "Core annotations" (ppr e)
898 repE e@(HsSCC {}) = notHandled "Cost centres" (ppr e)
899 repE e@(HsTickPragma {}) = notHandled "Tick Pragma" (ppr e)
900 repE e@(HsBracketOut {}) = notHandled "TH brackets" (ppr e)
901 repE e = notHandled "Expression form" (ppr e)
902
903 -----------------------------------------------------------------------------
904 -- Building representations of auxillary structures like Match, Clause, Stmt,
905
906 repMatchTup :: LMatch Name -> DsM (Core TH.MatchQ)
907 repMatchTup (L _ (Match [p] _ (GRHSs guards wheres))) =
908 do { ss1 <- mkGenSyms (collectPatBinders p)
909 ; addBinds ss1 $ do {
910 ; p1 <- repLP p
911 ; (ss2,ds) <- repBinds wheres
912 ; addBinds ss2 $ do {
913 ; gs <- repGuards guards
914 ; match <- repMatch p1 gs ds
915 ; wrapGenSyms (ss1++ss2) match }}}
916 repMatchTup _ = panic "repMatchTup: case alt with more than one arg"
917
918 repClauseTup :: LMatch Name -> DsM (Core TH.ClauseQ)
919 repClauseTup (L _ (Match ps _ (GRHSs guards wheres))) =
920 do { ss1 <- mkGenSyms (collectPatsBinders ps)
921 ; addBinds ss1 $ do {
922 ps1 <- repLPs ps
923 ; (ss2,ds) <- repBinds wheres
924 ; addBinds ss2 $ do {
925 gs <- repGuards guards
926 ; clause <- repClause ps1 gs ds
927 ; wrapGenSyms (ss1++ss2) clause }}}
928
929 repGuards :: [LGRHS Name] -> DsM (Core TH.BodyQ)
930 repGuards [L _ (GRHS [] e)]
931 = do {a <- repLE e; repNormal a }
932 repGuards other
933 = do { zs <- mapM process other;
934 let {(xs, ys) = unzip zs};
935 gd <- repGuarded (nonEmptyCoreList ys);
936 wrapGenSyms (concat xs) gd }
937 where
938 process :: LGRHS Name -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp))))
939 process (L _ (GRHS [L _ (ExprStmt e1 _ _ _)] e2))
940 = do { x <- repLNormalGE e1 e2;
941 return ([], x) }
942 process (L _ (GRHS ss rhs))
943 = do (gs, ss') <- repLSts ss
944 rhs' <- addBinds gs $ repLE rhs
945 g <- repPatGE (nonEmptyCoreList ss') rhs'
946 return (gs, g)
947
948 repFields :: HsRecordBinds Name -> DsM (Core [TH.Q TH.FieldExp])
949 repFields (HsRecFields { rec_flds = flds })
950 = do { fnames <- mapM lookupLOcc (map hsRecFieldId flds)
951 ; es <- mapM repLE (map hsRecFieldArg flds)
952 ; fs <- zipWithM repFieldExp fnames es
953 ; coreList fieldExpQTyConName fs }
954
955
956 -----------------------------------------------------------------------------
957 -- Representing Stmt's is tricky, especially if bound variables
958 -- shadow each other. Consider: [| do { x <- f 1; x <- f x; g x } |]
959 -- First gensym new names for every variable in any of the patterns.
960 -- both static (x'1 and x'2), and dynamic ((gensym "x") and (gensym "y"))
961 -- if variables didn't shaddow, the static gensym wouldn't be necessary
962 -- and we could reuse the original names (x and x).
963 --
964 -- do { x'1 <- gensym "x"
965 -- ; x'2 <- gensym "x"
966 -- ; doE [ BindSt (pvar x'1) [| f 1 |]
967 -- , BindSt (pvar x'2) [| f x |]
968 -- , NoBindSt [| g x |]
969 -- ]
970 -- }
971
972 -- The strategy is to translate a whole list of do-bindings by building a
973 -- bigger environment, and a bigger set of meta bindings
974 -- (like: x'1 <- gensym "x" ) and then combining these with the translations
975 -- of the expressions within the Do
976
977 -----------------------------------------------------------------------------
978 -- The helper function repSts computes the translation of each sub expression
979 -- and a bunch of prefix bindings denoting the dynamic renaming.
980
981 repLSts :: [LStmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
982 repLSts stmts = repSts (map unLoc stmts)
983
984 repSts :: [Stmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
985 repSts (BindStmt p e _ _ : ss) =
986 do { e2 <- repLE e
987 ; ss1 <- mkGenSyms (collectPatBinders p)
988 ; addBinds ss1 $ do {
989 ; p1 <- repLP p;
990 ; (ss2,zs) <- repSts ss
991 ; z <- repBindSt p1 e2
992 ; return (ss1++ss2, z : zs) }}
993 repSts (LetStmt bs : ss) =
994 do { (ss1,ds) <- repBinds bs
995 ; z <- repLetSt ds
996 ; (ss2,zs) <- addBinds ss1 (repSts ss)
997 ; return (ss1++ss2, z : zs) }
998 repSts (ExprStmt e _ _ _ : ss) =
999 do { e2 <- repLE e
1000 ; z <- repNoBindSt e2
1001 ; (ss2,zs) <- repSts ss
1002 ; return (ss2, z : zs) }
1003 repSts [LastStmt e _]
1004 = do { e2 <- repLE e
1005 ; z <- repNoBindSt e2
1006 ; return ([], [z]) }
1007 repSts [] = return ([],[])
1008 repSts other = notHandled "Exotic statement" (ppr other)
1009
1010
1011 -----------------------------------------------------------
1012 -- Bindings
1013 -----------------------------------------------------------
1014
1015 repBinds :: HsLocalBinds Name -> DsM ([GenSymBind], Core [TH.DecQ])
1016 repBinds EmptyLocalBinds
1017 = do { core_list <- coreList decQTyConName []
1018 ; return ([], core_list) }
1019
1020 repBinds b@(HsIPBinds _) = notHandled "Implicit parameters" (ppr b)
1021
1022 repBinds (HsValBinds decs)
1023 = do { let { bndrs = hsSigTvBinders decs ++ collectHsValBinders decs }
1024 -- No need to worrry about detailed scopes within
1025 -- the binding group, because we are talking Names
1026 -- here, so we can safely treat it as a mutually
1027 -- recursive group
1028 -- For hsSigTvBinders see Note [Scoped type variables in bindings]
1029 ; ss <- mkGenSyms bndrs
1030 ; prs <- addBinds ss (rep_val_binds decs)
1031 ; core_list <- coreList decQTyConName
1032 (de_loc (sort_by_loc prs))
1033 ; return (ss, core_list) }
1034
1035 rep_val_binds :: HsValBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
1036 -- Assumes: all the binders of the binding are alrady in the meta-env
1037 rep_val_binds (ValBindsOut binds sigs)
1038 = do { core1 <- rep_binds' (unionManyBags (map snd binds))
1039 ; core2 <- rep_sigs' sigs
1040 ; return (core1 ++ core2) }
1041 rep_val_binds (ValBindsIn _ _)
1042 = panic "rep_val_binds: ValBindsIn"
1043
1044 rep_binds :: LHsBinds Name -> DsM [Core TH.DecQ]
1045 rep_binds binds = do { binds_w_locs <- rep_binds' binds
1046 ; return (de_loc (sort_by_loc binds_w_locs)) }
1047
1048 rep_binds' :: LHsBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
1049 rep_binds' binds = mapM rep_bind (bagToList binds)
1050
1051 rep_bind :: LHsBind Name -> DsM (SrcSpan, Core TH.DecQ)
1052 -- Assumes: all the binders of the binding are alrady in the meta-env
1053
1054 -- Note GHC treats declarations of a variable (not a pattern)
1055 -- e.g. x = g 5 as a Fun MonoBinds. This is indicated by a single match
1056 -- with an empty list of patterns
1057 rep_bind (L loc (FunBind { fun_id = fn,
1058 fun_matches = MatchGroup [L _ (Match [] _ (GRHSs guards wheres))] _ }))
1059 = do { (ss,wherecore) <- repBinds wheres
1060 ; guardcore <- addBinds ss (repGuards guards)
1061 ; fn' <- lookupLBinder fn
1062 ; p <- repPvar fn'
1063 ; ans <- repVal p guardcore wherecore
1064 ; ans' <- wrapGenSyms ss ans
1065 ; return (loc, ans') }
1066
1067 rep_bind (L loc (FunBind { fun_id = fn, fun_matches = MatchGroup ms _ }))
1068 = do { ms1 <- mapM repClauseTup ms
1069 ; fn' <- lookupLBinder fn
1070 ; ans <- repFun fn' (nonEmptyCoreList ms1)
1071 ; return (loc, ans) }
1072
1073 rep_bind (L loc (PatBind { pat_lhs = pat, pat_rhs = GRHSs guards wheres }))
1074 = do { patcore <- repLP pat
1075 ; (ss,wherecore) <- repBinds wheres
1076 ; guardcore <- addBinds ss (repGuards guards)
1077 ; ans <- repVal patcore guardcore wherecore
1078 ; ans' <- wrapGenSyms ss ans
1079 ; return (loc, ans') }
1080
1081 rep_bind (L _ (VarBind { var_id = v, var_rhs = e}))
1082 = do { v' <- lookupBinder v
1083 ; e2 <- repLE e
1084 ; x <- repNormal e2
1085 ; patcore <- repPvar v'
1086 ; empty_decls <- coreList decQTyConName []
1087 ; ans <- repVal patcore x empty_decls
1088 ; return (srcLocSpan (getSrcLoc v), ans) }
1089
1090 rep_bind (L _ (AbsBinds {})) = panic "rep_bind: AbsBinds"
1091
1092 -----------------------------------------------------------------------------
1093 -- Since everything in a Bind is mutually recursive we need rename all
1094 -- all the variables simultaneously. For example:
1095 -- [| AndMonoBinds (f x = x + g 2) (g x = f 1 + 2) |] would translate to
1096 -- do { f'1 <- gensym "f"
1097 -- ; g'2 <- gensym "g"
1098 -- ; [ do { x'3 <- gensym "x"; fun f'1 [pvar x'3] [| x + g2 |]},
1099 -- do { x'4 <- gensym "x"; fun g'2 [pvar x'4] [| f 1 + 2 |]}
1100 -- ]}
1101 -- This requires collecting the bindings (f'1 <- gensym "f"), and the
1102 -- environment ( f |-> f'1 ) from each binding, and then unioning them
1103 -- together. As we do this we collect GenSymBinds's which represent the renamed
1104 -- variables bound by the Bindings. In order not to lose track of these
1105 -- representations we build a shadow datatype MB with the same structure as
1106 -- MonoBinds, but which has slots for the representations
1107
1108
1109 -----------------------------------------------------------------------------
1110 -- GHC allows a more general form of lambda abstraction than specified
1111 -- by Haskell 98. In particular it allows guarded lambda's like :
1112 -- (\ x | even x -> 0 | odd x -> 1) at the moment we can't represent this in
1113 -- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like
1114 -- (\ p1 .. pn -> exp) by causing an error.
1115
1116 repLambda :: LMatch Name -> DsM (Core TH.ExpQ)
1117 repLambda (L _ (Match ps _ (GRHSs [L _ (GRHS [] e)] EmptyLocalBinds)))
1118 = do { let bndrs = collectPatsBinders ps ;
1119 ; ss <- mkGenSyms bndrs
1120 ; lam <- addBinds ss (
1121 do { xs <- repLPs ps; body <- repLE e; repLam xs body })
1122 ; wrapGenSyms ss lam }
1123
1124 repLambda (L _ m) = notHandled "Guarded labmdas" (pprMatch (LambdaExpr :: HsMatchContext Name) m)
1125
1126
1127 -----------------------------------------------------------------------------
1128 -- Patterns
1129 -- repP deals with patterns. It assumes that we have already
1130 -- walked over the pattern(s) once to collect the binders, and
1131 -- have extended the environment. So every pattern-bound
1132 -- variable should already appear in the environment.
1133
1134 -- Process a list of patterns
1135 repLPs :: [LPat Name] -> DsM (Core [TH.PatQ])
1136 repLPs ps = do { ps' <- mapM repLP ps ;
1137 coreList patQTyConName ps' }
1138
1139 repLP :: LPat Name -> DsM (Core TH.PatQ)
1140 repLP (L _ p) = repP p
1141
1142 repP :: Pat Name -> DsM (Core TH.PatQ)
1143 repP (WildPat _) = repPwild
1144 repP (LitPat l) = do { l2 <- repLiteral l; repPlit l2 }
1145 repP (VarPat x) = do { x' <- lookupBinder x; repPvar x' }
1146 repP (LazyPat p) = do { p1 <- repLP p; repPtilde p1 }
1147 repP (BangPat p) = do { p1 <- repLP p; repPbang p1 }
1148 repP (AsPat x p) = do { x' <- lookupLBinder x; p1 <- repLP p; repPaspat x' p1 }
1149 repP (ParPat p) = repLP p
1150 repP (ListPat ps _) = do { qs <- repLPs ps; repPlist qs }
1151 repP (TuplePat ps boxed _)
1152 | isBoxed boxed = do { qs <- repLPs ps; repPtup qs }
1153 | otherwise = do { qs <- repLPs ps; repPunboxedTup qs }
1154 repP (ConPatIn dc details)
1155 = do { con_str <- lookupLOcc dc
1156 ; case details of
1157 PrefixCon ps -> do { qs <- repLPs ps; repPcon con_str qs }
1158 RecCon rec -> do { let flds = rec_flds rec
1159 ; vs <- sequence $ map lookupLOcc (map hsRecFieldId flds)
1160 ; ps <- sequence $ map repLP (map hsRecFieldArg flds)
1161 ; fps <- zipWithM (\x y -> rep2 fieldPatName [unC x,unC y]) vs ps
1162 ; fps' <- coreList fieldPatQTyConName fps
1163 ; repPrec con_str fps' }
1164 InfixCon p1 p2 -> do { p1' <- repLP p1;
1165 p2' <- repLP p2;
1166 repPinfix p1' con_str p2' }
1167 }
1168 repP (NPat l Nothing _) = do { a <- repOverloadedLiteral l; repPlit a }
1169 repP (ViewPat e p _) = do { e' <- repLE e; p' <- repLP p; repPview e' p' }
1170 repP p@(NPat _ (Just _) _) = notHandled "Negative overloaded patterns" (ppr p)
1171 repP p@(SigPatIn {}) = notHandled "Type signatures in patterns" (ppr p)
1172 -- The problem is to do with scoped type variables.
1173 -- To implement them, we have to implement the scoping rules
1174 -- here in DsMeta, and I don't want to do that today!
1175 -- do { p' <- repLP p; t' <- repLTy t; repPsig p' t' }
1176 -- repPsig :: Core TH.PatQ -> Core TH.TypeQ -> DsM (Core TH.PatQ)
1177 -- repPsig (MkC p) (MkC t) = rep2 sigPName [p, t]
1178
1179 repP other = notHandled "Exotic pattern" (ppr other)
1180
1181 ----------------------------------------------------------
1182 -- Declaration ordering helpers
1183
1184 sort_by_loc :: [(SrcSpan, a)] -> [(SrcSpan, a)]
1185 sort_by_loc xs = sortBy comp xs
1186 where comp x y = compare (fst x) (fst y)
1187
1188 de_loc :: [(a, b)] -> [b]
1189 de_loc = map snd
1190
1191 ----------------------------------------------------------
1192 -- The meta-environment
1193
1194 -- A name/identifier association for fresh names of locally bound entities
1195 type GenSymBind = (Name, Id) -- Gensym the string and bind it to the Id
1196 -- I.e. (x, x_id) means
1197 -- let x_id = gensym "x" in ...
1198
1199 -- Generate a fresh name for a locally bound entity
1200
1201 mkGenSyms :: [Name] -> DsM [GenSymBind]
1202 -- We can use the existing name. For example:
1203 -- [| \x_77 -> x_77 + x_77 |]
1204 -- desugars to
1205 -- do { x_77 <- genSym "x"; .... }
1206 -- We use the same x_77 in the desugared program, but with the type Bndr
1207 -- instead of Int
1208 --
1209 -- We do make it an Internal name, though (hence localiseName)
1210 --
1211 -- Nevertheless, it's monadic because we have to generate nameTy
1212 mkGenSyms ns = do { var_ty <- lookupType nameTyConName
1213 ; return [(nm, mkLocalId (localiseName nm) var_ty) | nm <- ns] }
1214
1215
1216 addBinds :: [GenSymBind] -> DsM a -> DsM a
1217 -- Add a list of fresh names for locally bound entities to the
1218 -- meta environment (which is part of the state carried around
1219 -- by the desugarer monad)
1220 addBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,Bound id) | (n,id) <- bs]) m
1221
1222 dupBinder :: (Name, Name) -> DsM (Name, DsMetaVal)
1223 dupBinder (new, old)
1224 = do { mb_val <- dsLookupMetaEnv old
1225 ; case mb_val of
1226 Just val -> return (new, val)
1227 Nothing -> pprPanic "dupBinder" (ppr old) }
1228
1229 -- Look up a locally bound name
1230 --
1231 lookupLBinder :: Located Name -> DsM (Core TH.Name)
1232 lookupLBinder (L _ n) = lookupBinder n
1233
1234 lookupBinder :: Name -> DsM (Core TH.Name)
1235 lookupBinder = lookupOcc
1236 -- Binders are brought into scope before the pattern or what-not is
1237 -- desugared. Moreover, in instance declaration the binder of a method
1238 -- will be the selector Id and hence a global; so we need the
1239 -- globalVar case of lookupOcc
1240
1241 -- Look up a name that is either locally bound or a global name
1242 --
1243 -- * If it is a global name, generate the "original name" representation (ie,
1244 -- the <module>:<name> form) for the associated entity
1245 --
1246 lookupLOcc :: Located Name -> DsM (Core TH.Name)
1247 -- Lookup an occurrence; it can't be a splice.
1248 -- Use the in-scope bindings if they exist
1249 lookupLOcc (L _ n) = lookupOcc n
1250
1251 lookupOcc :: Name -> DsM (Core TH.Name)
1252 lookupOcc n
1253 = do { mb_val <- dsLookupMetaEnv n ;
1254 case mb_val of
1255 Nothing -> globalVar n
1256 Just (Bound x) -> return (coreVar x)
1257 Just (Splice _) -> pprPanic "repE:lookupOcc" (ppr n)
1258 }
1259
1260 globalVar :: Name -> DsM (Core TH.Name)
1261 -- Not bound by the meta-env
1262 -- Could be top-level; or could be local
1263 -- f x = $(g [| x |])
1264 -- Here the x will be local
1265 globalVar name
1266 | isExternalName name
1267 = do { MkC mod <- coreStringLit name_mod
1268 ; MkC pkg <- coreStringLit name_pkg
1269 ; MkC occ <- occNameLit name
1270 ; rep2 mk_varg [pkg,mod,occ] }
1271 | otherwise
1272 = do { MkC occ <- occNameLit name
1273 ; MkC uni <- coreIntLit (getKey (getUnique name))
1274 ; rep2 mkNameLName [occ,uni] }
1275 where
1276 mod = ASSERT( isExternalName name) nameModule name
1277 name_mod = moduleNameString (moduleName mod)
1278 name_pkg = packageIdString (modulePackageId mod)
1279 name_occ = nameOccName name
1280 mk_varg | OccName.isDataOcc name_occ = mkNameG_dName
1281 | OccName.isVarOcc name_occ = mkNameG_vName
1282 | OccName.isTcOcc name_occ = mkNameG_tcName
1283 | otherwise = pprPanic "DsMeta.globalVar" (ppr name)
1284
1285 lookupType :: Name -- Name of type constructor (e.g. TH.ExpQ)
1286 -> DsM Type -- The type
1287 lookupType tc_name = do { tc <- dsLookupTyCon tc_name ;
1288 return (mkTyConApp tc []) }
1289
1290 wrapGenSyms :: [GenSymBind]
1291 -> Core (TH.Q a) -> DsM (Core (TH.Q a))
1292 -- wrapGenSyms [(nm1,id1), (nm2,id2)] y
1293 -- --> bindQ (gensym nm1) (\ id1 ->
1294 -- bindQ (gensym nm2 (\ id2 ->
1295 -- y))
1296
1297 wrapGenSyms binds body@(MkC b)
1298 = do { var_ty <- lookupType nameTyConName
1299 ; go var_ty binds }
1300 where
1301 [elt_ty] = tcTyConAppArgs (exprType b)
1302 -- b :: Q a, so we can get the type 'a' by looking at the
1303 -- argument type. NB: this relies on Q being a data/newtype,
1304 -- not a type synonym
1305
1306 go _ [] = return body
1307 go var_ty ((name,id) : binds)
1308 = do { MkC body' <- go var_ty binds
1309 ; lit_str <- occNameLit name
1310 ; gensym_app <- repGensym lit_str
1311 ; repBindQ var_ty elt_ty
1312 gensym_app (MkC (Lam id body')) }
1313
1314 occNameLit :: Name -> DsM (Core String)
1315 occNameLit n = coreStringLit (occNameString (nameOccName n))
1316
1317
1318 -- %*********************************************************************
1319 -- %* *
1320 -- Constructing code
1321 -- %* *
1322 -- %*********************************************************************
1323
1324 -----------------------------------------------------------------------------
1325 -- PHANTOM TYPES for consistency. In order to make sure we do this correct
1326 -- we invent a new datatype which uses phantom types.
1327
1328 newtype Core a = MkC CoreExpr
1329 unC :: Core a -> CoreExpr
1330 unC (MkC x) = x
1331
1332 rep2 :: Name -> [ CoreExpr ] -> DsM (Core a)
1333 rep2 n xs = do { id <- dsLookupGlobalId n
1334 ; return (MkC (foldl App (Var id) xs)) }
1335
1336 -- Then we make "repConstructors" which use the phantom types for each of the
1337 -- smart constructors of the Meta.Meta datatypes.
1338
1339
1340 -- %*********************************************************************
1341 -- %* *
1342 -- The 'smart constructors'
1343 -- %* *
1344 -- %*********************************************************************
1345
1346 --------------- Patterns -----------------
1347 repPlit :: Core TH.Lit -> DsM (Core TH.PatQ)
1348 repPlit (MkC l) = rep2 litPName [l]
1349
1350 repPvar :: Core TH.Name -> DsM (Core TH.PatQ)
1351 repPvar (MkC s) = rep2 varPName [s]
1352
1353 repPtup :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
1354 repPtup (MkC ps) = rep2 tupPName [ps]
1355
1356 repPunboxedTup :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
1357 repPunboxedTup (MkC ps) = rep2 unboxedTupPName [ps]
1358
1359 repPcon :: Core TH.Name -> Core [TH.PatQ] -> DsM (Core TH.PatQ)
1360 repPcon (MkC s) (MkC ps) = rep2 conPName [s, ps]
1361
1362 repPrec :: Core TH.Name -> Core [(TH.Name,TH.PatQ)] -> DsM (Core TH.PatQ)
1363 repPrec (MkC c) (MkC rps) = rep2 recPName [c,rps]
1364
1365 repPinfix :: Core TH.PatQ -> Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
1366 repPinfix (MkC p1) (MkC n) (MkC p2) = rep2 infixPName [p1, n, p2]
1367
1368 repPtilde :: Core TH.PatQ -> DsM (Core TH.PatQ)
1369 repPtilde (MkC p) = rep2 tildePName [p]
1370
1371 repPbang :: Core TH.PatQ -> DsM (Core TH.PatQ)
1372 repPbang (MkC p) = rep2 bangPName [p]
1373
1374 repPaspat :: Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
1375 repPaspat (MkC s) (MkC p) = rep2 asPName [s, p]
1376
1377 repPwild :: DsM (Core TH.PatQ)
1378 repPwild = rep2 wildPName []
1379
1380 repPlist :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
1381 repPlist (MkC ps) = rep2 listPName [ps]
1382
1383 repPview :: Core TH.ExpQ -> Core TH.PatQ -> DsM (Core TH.PatQ)
1384 repPview (MkC e) (MkC p) = rep2 viewPName [e,p]
1385
1386 --------------- Expressions -----------------
1387 repVarOrCon :: Name -> Core TH.Name -> DsM (Core TH.ExpQ)
1388 repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
1389 | otherwise = repVar str
1390
1391 repVar :: Core TH.Name -> DsM (Core TH.ExpQ)
1392 repVar (MkC s) = rep2 varEName [s]
1393
1394 repCon :: Core TH.Name -> DsM (Core TH.ExpQ)
1395 repCon (MkC s) = rep2 conEName [s]
1396
1397 repLit :: Core TH.Lit -> DsM (Core TH.ExpQ)
1398 repLit (MkC c) = rep2 litEName [c]
1399
1400 repApp :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1401 repApp (MkC x) (MkC y) = rep2 appEName [x,y]
1402
1403 repLam :: Core [TH.PatQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1404 repLam (MkC ps) (MkC e) = rep2 lamEName [ps, e]
1405
1406 repTup :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
1407 repTup (MkC es) = rep2 tupEName [es]
1408
1409 repUnboxedTup :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
1410 repUnboxedTup (MkC es) = rep2 unboxedTupEName [es]
1411
1412 repCond :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1413 repCond (MkC x) (MkC y) (MkC z) = rep2 condEName [x,y,z]
1414
1415 repLetE :: Core [TH.DecQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1416 repLetE (MkC ds) (MkC e) = rep2 letEName [ds, e]
1417
1418 repCaseE :: Core TH.ExpQ -> Core [TH.MatchQ] -> DsM( Core TH.ExpQ)
1419 repCaseE (MkC e) (MkC ms) = rep2 caseEName [e, ms]
1420
1421 repDoE :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
1422 repDoE (MkC ss) = rep2 doEName [ss]
1423
1424 repComp :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
1425 repComp (MkC ss) = rep2 compEName [ss]
1426
1427 repListExp :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
1428 repListExp (MkC es) = rep2 listEName [es]
1429
1430 repSigExp :: Core TH.ExpQ -> Core TH.TypeQ -> DsM (Core TH.ExpQ)
1431 repSigExp (MkC e) (MkC t) = rep2 sigEName [e,t]
1432
1433 repRecCon :: Core TH.Name -> Core [TH.Q TH.FieldExp]-> DsM (Core TH.ExpQ)
1434 repRecCon (MkC c) (MkC fs) = rep2 recConEName [c,fs]
1435
1436 repRecUpd :: Core TH.ExpQ -> Core [TH.Q TH.FieldExp] -> DsM (Core TH.ExpQ)
1437 repRecUpd (MkC e) (MkC fs) = rep2 recUpdEName [e,fs]
1438
1439 repFieldExp :: Core TH.Name -> Core TH.ExpQ -> DsM (Core (TH.Q TH.FieldExp))
1440 repFieldExp (MkC n) (MkC x) = rep2 fieldExpName [n,x]
1441
1442 repInfixApp :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1443 repInfixApp (MkC x) (MkC y) (MkC z) = rep2 infixAppName [x,y,z]
1444
1445 repSectionL :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1446 repSectionL (MkC x) (MkC y) = rep2 sectionLName [x,y]
1447
1448 repSectionR :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1449 repSectionR (MkC x) (MkC y) = rep2 sectionRName [x,y]
1450
1451 ------------ Right hand sides (guarded expressions) ----
1452 repGuarded :: Core [TH.Q (TH.Guard, TH.Exp)] -> DsM (Core TH.BodyQ)
1453 repGuarded (MkC pairs) = rep2 guardedBName [pairs]
1454
1455 repNormal :: Core TH.ExpQ -> DsM (Core TH.BodyQ)
1456 repNormal (MkC e) = rep2 normalBName [e]
1457
1458 ------------ Guards ----
1459 repLNormalGE :: LHsExpr Name -> LHsExpr Name -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1460 repLNormalGE g e = do g' <- repLE g
1461 e' <- repLE e
1462 repNormalGE g' e'
1463
1464 repNormalGE :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1465 repNormalGE (MkC g) (MkC e) = rep2 normalGEName [g, e]
1466
1467 repPatGE :: Core [TH.StmtQ] -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1468 repPatGE (MkC ss) (MkC e) = rep2 patGEName [ss, e]
1469
1470 ------------- Stmts -------------------
1471 repBindSt :: Core TH.PatQ -> Core TH.ExpQ -> DsM (Core TH.StmtQ)
1472 repBindSt (MkC p) (MkC e) = rep2 bindSName [p,e]
1473
1474 repLetSt :: Core [TH.DecQ] -> DsM (Core TH.StmtQ)
1475 repLetSt (MkC ds) = rep2 letSName [ds]
1476
1477 repNoBindSt :: Core TH.ExpQ -> DsM (Core TH.StmtQ)
1478 repNoBindSt (MkC e) = rep2 noBindSName [e]
1479
1480 -------------- Range (Arithmetic sequences) -----------
1481 repFrom :: Core TH.ExpQ -> DsM (Core TH.ExpQ)
1482 repFrom (MkC x) = rep2 fromEName [x]
1483
1484 repFromThen :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1485 repFromThen (MkC x) (MkC y) = rep2 fromThenEName [x,y]
1486
1487 repFromTo :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1488 repFromTo (MkC x) (MkC y) = rep2 fromToEName [x,y]
1489
1490 repFromThenTo :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1491 repFromThenTo (MkC x) (MkC y) (MkC z) = rep2 fromThenToEName [x,y,z]
1492
1493 ------------ Match and Clause Tuples -----------
1494 repMatch :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.MatchQ)
1495 repMatch (MkC p) (MkC bod) (MkC ds) = rep2 matchName [p, bod, ds]
1496
1497 repClause :: Core [TH.PatQ] -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.ClauseQ)
1498 repClause (MkC ps) (MkC bod) (MkC ds) = rep2 clauseName [ps, bod, ds]
1499
1500 -------------- Dec -----------------------------
1501 repVal :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1502 repVal (MkC p) (MkC b) (MkC ds) = rep2 valDName [p, b, ds]
1503
1504 repFun :: Core TH.Name -> Core [TH.ClauseQ] -> DsM (Core TH.DecQ)
1505 repFun (MkC nm) (MkC b) = rep2 funDName [nm, b]
1506
1507 repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr]
1508 -> Maybe (Core [TH.TypeQ])
1509 -> Core [TH.ConQ] -> Core [TH.Name] -> DsM (Core TH.DecQ)
1510 repData (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC cons) (MkC derivs)
1511 = rep2 dataDName [cxt, nm, tvs, cons, derivs]
1512 repData (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC cons) (MkC derivs)
1513 = rep2 dataInstDName [cxt, nm, tys, cons, derivs]
1514
1515 repNewtype :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr]
1516 -> Maybe (Core [TH.TypeQ])
1517 -> Core TH.ConQ -> Core [TH.Name] -> DsM (Core TH.DecQ)
1518 repNewtype (MkC cxt) (MkC nm) (MkC tvs) Nothing (MkC con) (MkC derivs)
1519 = rep2 newtypeDName [cxt, nm, tvs, con, derivs]
1520 repNewtype (MkC cxt) (MkC nm) (MkC _) (Just (MkC tys)) (MkC con) (MkC derivs)
1521 = rep2 newtypeInstDName [cxt, nm, tys, con, derivs]
1522
1523 repTySyn :: Core TH.Name -> Core [TH.TyVarBndr]
1524 -> Maybe (Core [TH.TypeQ])
1525 -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1526 repTySyn (MkC nm) (MkC tvs) Nothing (MkC rhs)
1527 = rep2 tySynDName [nm, tvs, rhs]
1528 repTySyn (MkC nm) (MkC _) (Just (MkC tys)) (MkC rhs)
1529 = rep2 tySynInstDName [nm, tys, rhs]
1530
1531 repInst :: Core TH.CxtQ -> Core TH.TypeQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1532 repInst (MkC cxt) (MkC ty) (MkC ds) = rep2 instanceDName [cxt, ty, ds]
1533
1534 repClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.TyVarBndr]
1535 -> Core [TH.FunDep] -> Core [TH.DecQ]
1536 -> DsM (Core TH.DecQ)
1537 repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds)
1538 = rep2 classDName [cxt, cls, tvs, fds, ds]
1539
1540 repPragInl :: Core TH.Name -> Core TH.InlineSpecQ -> DsM (Core TH.DecQ)
1541 repPragInl (MkC nm) (MkC ispec) = rep2 pragInlDName [nm, ispec]
1542
1543 repPragSpec :: Core TH.Name -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1544 repPragSpec (MkC nm) (MkC ty) = rep2 pragSpecDName [nm, ty]
1545
1546 repPragSpecInl :: Core TH.Name -> Core TH.TypeQ -> Core TH.InlineSpecQ
1547 -> DsM (Core TH.DecQ)
1548 repPragSpecInl (MkC nm) (MkC ty) (MkC ispec)
1549 = rep2 pragSpecInlDName [nm, ty, ispec]
1550
1551 repFamilyNoKind :: Core TH.FamFlavour -> Core TH.Name -> Core [TH.TyVarBndr]
1552 -> DsM (Core TH.DecQ)
1553 repFamilyNoKind (MkC flav) (MkC nm) (MkC tvs)
1554 = rep2 familyNoKindDName [flav, nm, tvs]
1555
1556 repFamilyKind :: Core TH.FamFlavour -> Core TH.Name -> Core [TH.TyVarBndr]
1557 -> Core TH.Kind
1558 -> DsM (Core TH.DecQ)
1559 repFamilyKind (MkC flav) (MkC nm) (MkC tvs) (MkC ki)
1560 = rep2 familyKindDName [flav, nm, tvs, ki]
1561
1562 repInlineSpecNoPhase :: Core Bool -> Core Bool -> DsM (Core TH.InlineSpecQ)
1563 repInlineSpecNoPhase (MkC inline) (MkC conlike)
1564 = rep2 inlineSpecNoPhaseName [inline, conlike]
1565
1566 repInlineSpecPhase :: Core Bool -> Core Bool -> Core Bool -> Core Int
1567 -> DsM (Core TH.InlineSpecQ)
1568 repInlineSpecPhase (MkC inline) (MkC conlike) (MkC beforeFrom) (MkC phase)
1569 = rep2 inlineSpecPhaseName [inline, conlike, beforeFrom, phase]
1570
1571 repFunDep :: Core [TH.Name] -> Core [TH.Name] -> DsM (Core TH.FunDep)
1572 repFunDep (MkC xs) (MkC ys) = rep2 funDepName [xs, ys]
1573
1574 repProto :: Core TH.Name -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1575 repProto (MkC s) (MkC ty) = rep2 sigDName [s, ty]
1576
1577 repCtxt :: Core [TH.PredQ] -> DsM (Core TH.CxtQ)
1578 repCtxt (MkC tys) = rep2 cxtName [tys]
1579
1580 repClassP :: Core TH.Name -> Core [TH.TypeQ] -> DsM (Core TH.PredQ)
1581 repClassP (MkC cla) (MkC tys) = rep2 classPName [cla, tys]
1582
1583 repEqualP :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.PredQ)
1584 repEqualP (MkC ty1) (MkC ty2) = rep2 equalPName [ty1, ty2]
1585
1586 repConstr :: Core TH.Name -> HsConDeclDetails Name
1587 -> DsM (Core TH.ConQ)
1588 repConstr con (PrefixCon ps)
1589 = do arg_tys <- mapM repBangTy ps
1590 arg_tys1 <- coreList strictTypeQTyConName arg_tys
1591 rep2 normalCName [unC con, unC arg_tys1]
1592 repConstr con (RecCon ips)
1593 = do arg_vs <- mapM lookupLOcc (map cd_fld_name ips)
1594 arg_tys <- mapM repBangTy (map cd_fld_type ips)
1595 arg_vtys <- zipWithM (\x y -> rep2 varStrictTypeName [unC x, unC y])
1596 arg_vs arg_tys
1597 arg_vtys' <- coreList varStrictTypeQTyConName arg_vtys
1598 rep2 recCName [unC con, unC arg_vtys']
1599 repConstr con (InfixCon st1 st2)
1600 = do arg1 <- repBangTy st1
1601 arg2 <- repBangTy st2
1602 rep2 infixCName [unC arg1, unC con, unC arg2]
1603
1604 ------------ Types -------------------
1605
1606 repTForall :: Core [TH.TyVarBndr] -> Core TH.CxtQ -> Core TH.TypeQ
1607 -> DsM (Core TH.TypeQ)
1608 repTForall (MkC tvars) (MkC ctxt) (MkC ty)
1609 = rep2 forallTName [tvars, ctxt, ty]
1610
1611 repTvar :: Core TH.Name -> DsM (Core TH.TypeQ)
1612 repTvar (MkC s) = rep2 varTName [s]
1613
1614 repTapp :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)
1615 repTapp (MkC t1) (MkC t2) = rep2 appTName [t1, t2]
1616
1617 repTapps :: Core TH.TypeQ -> [Core TH.TypeQ] -> DsM (Core TH.TypeQ)
1618 repTapps f [] = return f
1619 repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
1620
1621 repTSig :: Core TH.TypeQ -> Core TH.Kind -> DsM (Core TH.TypeQ)
1622 repTSig (MkC ty) (MkC ki) = rep2 sigTName [ty, ki]
1623
1624 --------- Type constructors --------------
1625
1626 repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
1627 repNamedTyCon (MkC s) = rep2 conTName [s]
1628
1629 repTupleTyCon :: Int -> DsM (Core TH.TypeQ)
1630 -- Note: not Core Int; it's easier to be direct here
1631 repTupleTyCon i = rep2 tupleTName [mkIntExprInt i]
1632
1633 repUnboxedTupleTyCon :: Int -> DsM (Core TH.TypeQ)
1634 -- Note: not Core Int; it's easier to be direct here
1635 repUnboxedTupleTyCon i = rep2 unboxedTupleTName [mkIntExprInt i]
1636
1637 repArrowTyCon :: DsM (Core TH.TypeQ)
1638 repArrowTyCon = rep2 arrowTName []
1639
1640 repListTyCon :: DsM (Core TH.TypeQ)
1641 repListTyCon = rep2 listTName []
1642
1643 ------------ Kinds -------------------
1644
1645 repPlainTV :: Core TH.Name -> DsM (Core TH.TyVarBndr)
1646 repPlainTV (MkC nm) = rep2 plainTVName [nm]
1647
1648 repKindedTV :: Core TH.Name -> Core TH.Kind -> DsM (Core TH.TyVarBndr)
1649 repKindedTV (MkC nm) (MkC ki) = rep2 kindedTVName [nm, ki]
1650
1651 repStarK :: DsM (Core TH.Kind)
1652 repStarK = rep2 starKName []
1653
1654 repArrowK :: Core TH.Kind -> Core TH.Kind -> DsM (Core TH.Kind)
1655 repArrowK (MkC ki1) (MkC ki2) = rep2 arrowKName [ki1, ki2]
1656
1657 ----------------------------------------------------------
1658 -- Literals
1659
1660 repLiteral :: HsLit -> DsM (Core TH.Lit)
1661 repLiteral lit
1662 = do lit' <- case lit of
1663 HsIntPrim i -> mk_integer i
1664 HsWordPrim w -> mk_integer w
1665 HsInt i -> mk_integer i
1666 HsFloatPrim r -> mk_rational r
1667 HsDoublePrim r -> mk_rational r
1668 _ -> return lit
1669 lit_expr <- dsLit lit'
1670 case mb_lit_name of
1671 Just lit_name -> rep2 lit_name [lit_expr]
1672 Nothing -> notHandled "Exotic literal" (ppr lit)
1673 where
1674 mb_lit_name = case lit of
1675 HsInteger _ _ -> Just integerLName
1676 HsInt _ -> Just integerLName
1677 HsIntPrim _ -> Just intPrimLName
1678 HsWordPrim _ -> Just wordPrimLName
1679 HsFloatPrim _ -> Just floatPrimLName
1680 HsDoublePrim _ -> Just doublePrimLName
1681 HsChar _ -> Just charLName
1682 HsString _ -> Just stringLName
1683 HsRat _ _ -> Just rationalLName
1684 _ -> Nothing
1685
1686 mk_integer :: Integer -> DsM HsLit
1687 mk_integer i = do integer_ty <- lookupType integerTyConName
1688 return $ HsInteger i integer_ty
1689 mk_rational :: FractionalLit -> DsM HsLit
1690 mk_rational r = do rat_ty <- lookupType rationalTyConName
1691 return $ HsRat r rat_ty
1692 mk_string :: FastString -> DsM HsLit
1693 mk_string s = return $ HsString s
1694
1695 repOverloadedLiteral :: HsOverLit Name -> DsM (Core TH.Lit)
1696 repOverloadedLiteral (OverLit { ol_val = val})
1697 = do { lit <- mk_lit val; repLiteral lit }
1698 -- The type Rational will be in the environment, becuase
1699 -- the smart constructor 'TH.Syntax.rationalL' uses it in its type,
1700 -- and rationalL is sucked in when any TH stuff is used
1701
1702 mk_lit :: OverLitVal -> DsM HsLit
1703 mk_lit (HsIntegral i) = mk_integer i
1704 mk_lit (HsFractional f) = mk_rational f
1705 mk_lit (HsIsString s) = mk_string s
1706
1707 --------------- Miscellaneous -------------------
1708
1709 repGensym :: Core String -> DsM (Core (TH.Q TH.Name))
1710 repGensym (MkC lit_str) = rep2 newNameName [lit_str]
1711
1712 repBindQ :: Type -> Type -- a and b
1713 -> Core (TH.Q a) -> Core (a -> TH.Q b) -> DsM (Core (TH.Q b))
1714 repBindQ ty_a ty_b (MkC x) (MkC y)
1715 = rep2 bindQName [Type ty_a, Type ty_b, x, y]
1716
1717 repSequenceQ :: Type -> Core [TH.Q a] -> DsM (Core (TH.Q [a]))
1718 repSequenceQ ty_a (MkC list)
1719 = rep2 sequenceQName [Type ty_a, list]
1720
1721 ------------ Lists and Tuples -------------------
1722 -- turn a list of patterns into a single pattern matching a list
1723
1724 coreList :: Name -- Of the TyCon of the element type
1725 -> [Core a] -> DsM (Core [a])
1726 coreList tc_name es
1727 = do { elt_ty <- lookupType tc_name; return (coreList' elt_ty es) }
1728
1729 coreList' :: Type -- The element type
1730 -> [Core a] -> Core [a]
1731 coreList' elt_ty es = MkC (mkListExpr elt_ty (map unC es ))
1732
1733 nonEmptyCoreList :: [Core a] -> Core [a]
1734 -- The list must be non-empty so we can get the element type
1735 -- Otherwise use coreList
1736 nonEmptyCoreList [] = panic "coreList: empty argument"
1737 nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs))
1738
1739 coreStringLit :: String -> DsM (Core String)
1740 coreStringLit s = do { z <- mkStringExpr s; return(MkC z) }
1741
1742 ------------ Bool, Literals & Variables -------------------
1743
1744 coreBool :: Bool -> Core Bool
1745 coreBool False = MkC $ mkConApp falseDataCon []
1746 coreBool True = MkC $ mkConApp trueDataCon []
1747
1748 coreIntLit :: Int -> DsM (Core Int)
1749 coreIntLit i = return (MkC (mkIntExprInt i))
1750
1751 coreVar :: Id -> Core TH.Name -- The Id has type Name
1752 coreVar id = MkC (Var id)
1753
1754 ----------------- Failure -----------------------
1755 notHandled :: String -> SDoc -> DsM a
1756 notHandled what doc = failWithDs msg
1757 where
1758 msg = hang (text what <+> ptext (sLit "not (yet) handled by Template Haskell"))
1759 2 doc
1760
1761
1762 -- %************************************************************************
1763 -- %* *
1764 -- The known-key names for Template Haskell
1765 -- %* *
1766 -- %************************************************************************
1767
1768 -- To add a name, do three things
1769 --
1770 -- 1) Allocate a key
1771 -- 2) Make a "Name"
1772 -- 3) Add the name to knownKeyNames
1773
1774 templateHaskellNames :: [Name]
1775 -- The names that are implicitly mentioned by ``bracket''
1776 -- Should stay in sync with the import list of DsMeta
1777
1778 templateHaskellNames = [
1779 returnQName, bindQName, sequenceQName, newNameName, liftName,
1780 mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
1781 liftStringName,
1782
1783 -- Lit
1784 charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
1785 floatPrimLName, doublePrimLName, rationalLName,
1786 -- Pat
1787 litPName, varPName, tupPName, unboxedTupPName,
1788 conPName, tildePName, bangPName, infixPName,
1789 asPName, wildPName, recPName, listPName, sigPName, viewPName,
1790 -- FieldPat
1791 fieldPatName,
1792 -- Match
1793 matchName,
1794 -- Clause
1795 clauseName,
1796 -- Exp
1797 varEName, conEName, litEName, appEName, infixEName,
1798 infixAppName, sectionLName, sectionRName, lamEName,
1799 tupEName, unboxedTupEName,
1800 condEName, letEName, caseEName, doEName, compEName,
1801 fromEName, fromThenEName, fromToEName, fromThenToEName,
1802 listEName, sigEName, recConEName, recUpdEName,
1803 -- FieldExp
1804 fieldExpName,
1805 -- Body
1806 guardedBName, normalBName,
1807 -- Guard
1808 normalGEName, patGEName,
1809 -- Stmt
1810 bindSName, letSName, noBindSName, parSName,
1811 -- Dec
1812 funDName, valDName, dataDName, newtypeDName, tySynDName,
1813 classDName, instanceDName, sigDName, forImpDName,
1814 pragInlDName, pragSpecDName, pragSpecInlDName,
1815 familyNoKindDName, familyKindDName, dataInstDName, newtypeInstDName,
1816 tySynInstDName, infixLDName, infixRDName, infixNDName,
1817 -- Cxt
1818 cxtName,
1819 -- Pred
1820 classPName, equalPName,
1821 -- Strict
1822 isStrictName, notStrictName, unpackedName,
1823 -- Con
1824 normalCName, recCName, infixCName, forallCName,
1825 -- StrictType
1826 strictTypeName,
1827 -- VarStrictType
1828 varStrictTypeName,
1829 -- Type
1830 forallTName, varTName, conTName, appTName,
1831 tupleTName, unboxedTupleTName, arrowTName, listTName, sigTName,
1832 -- TyVarBndr
1833 plainTVName, kindedTVName,
1834 -- Kind
1835 starKName, arrowKName,
1836 -- Callconv
1837 cCallName, stdCallName,
1838 -- Safety
1839 unsafeName,
1840 safeName,
1841 interruptibleName,
1842 -- InlineSpec
1843 inlineSpecNoPhaseName, inlineSpecPhaseName,
1844 -- FunDep
1845 funDepName,
1846 -- FamFlavour
1847 typeFamName, dataFamName,
1848
1849 -- And the tycons
1850 qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchQTyConName,
1851 clauseQTyConName, expQTyConName, fieldExpTyConName, predTyConName,
1852 stmtQTyConName, decQTyConName, conQTyConName, strictTypeQTyConName,
1853 varStrictTypeQTyConName, typeQTyConName, expTyConName, decTyConName,
1854 typeTyConName, tyVarBndrTyConName, matchTyConName, clauseTyConName,
1855 patQTyConName, fieldPatQTyConName, fieldExpQTyConName, funDepTyConName,
1856 predQTyConName, decsQTyConName,
1857
1858 -- Quasiquoting
1859 quoteDecName, quoteTypeName, quoteExpName, quotePatName]
1860
1861 thSyn, thLib, qqLib :: Module
1862 thSyn = mkTHModule (fsLit "Language.Haskell.TH.Syntax")
1863 thLib = mkTHModule (fsLit "Language.Haskell.TH.Lib")
1864 qqLib = mkTHModule (fsLit "Language.Haskell.TH.Quote")
1865
1866 mkTHModule :: FastString -> Module
1867 mkTHModule m = mkModule thPackageId (mkModuleNameFS m)
1868
1869 libFun, libTc, thFun, thTc, qqFun :: FastString -> Unique -> Name
1870 libFun = mk_known_key_name OccName.varName thLib
1871 libTc = mk_known_key_name OccName.tcName thLib
1872 thFun = mk_known_key_name OccName.varName thSyn
1873 thTc = mk_known_key_name OccName.tcName thSyn
1874 qqFun = mk_known_key_name OccName.varName qqLib
1875
1876 -------------------- TH.Syntax -----------------------
1877 qTyConName, nameTyConName, fieldExpTyConName, patTyConName,
1878 fieldPatTyConName, expTyConName, decTyConName, typeTyConName,
1879 tyVarBndrTyConName, matchTyConName, clauseTyConName, funDepTyConName,
1880 predTyConName :: Name
1881 qTyConName = thTc (fsLit "Q") qTyConKey
1882 nameTyConName = thTc (fsLit "Name") nameTyConKey
1883 fieldExpTyConName = thTc (fsLit "FieldExp") fieldExpTyConKey
1884 patTyConName = thTc (fsLit "Pat") patTyConKey
1885 fieldPatTyConName = thTc (fsLit "FieldPat") fieldPatTyConKey
1886 expTyConName = thTc (fsLit "Exp") expTyConKey
1887 decTyConName = thTc (fsLit "Dec") decTyConKey
1888 typeTyConName = thTc (fsLit "Type") typeTyConKey
1889 tyVarBndrTyConName= thTc (fsLit "TyVarBndr") tyVarBndrTyConKey
1890 matchTyConName = thTc (fsLit "Match") matchTyConKey
1891 clauseTyConName = thTc (fsLit "Clause") clauseTyConKey
1892 funDepTyConName = thTc (fsLit "FunDep") funDepTyConKey
1893 predTyConName = thTc (fsLit "Pred") predTyConKey
1894
1895 returnQName, bindQName, sequenceQName, newNameName, liftName,
1896 mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName,
1897 mkNameLName, liftStringName :: Name
1898 returnQName = thFun (fsLit "returnQ") returnQIdKey
1899 bindQName = thFun (fsLit "bindQ") bindQIdKey
1900 sequenceQName = thFun (fsLit "sequenceQ") sequenceQIdKey
1901 newNameName = thFun (fsLit "newName") newNameIdKey
1902 liftName = thFun (fsLit "lift") liftIdKey
1903 liftStringName = thFun (fsLit "liftString") liftStringIdKey
1904 mkNameName = thFun (fsLit "mkName") mkNameIdKey
1905 mkNameG_vName = thFun (fsLit "mkNameG_v") mkNameG_vIdKey
1906 mkNameG_dName = thFun (fsLit "mkNameG_d") mkNameG_dIdKey
1907 mkNameG_tcName = thFun (fsLit "mkNameG_tc") mkNameG_tcIdKey
1908 mkNameLName = thFun (fsLit "mkNameL") mkNameLIdKey
1909
1910
1911 -------------------- TH.Lib -----------------------
1912 -- data Lit = ...
1913 charLName, stringLName, integerLName, intPrimLName, wordPrimLName,
1914 floatPrimLName, doublePrimLName, rationalLName :: Name
1915 charLName = libFun (fsLit "charL") charLIdKey
1916 stringLName = libFun (fsLit "stringL") stringLIdKey
1917 integerLName = libFun (fsLit "integerL") integerLIdKey
1918 intPrimLName = libFun (fsLit "intPrimL") intPrimLIdKey
1919 wordPrimLName = libFun (fsLit "wordPrimL") wordPrimLIdKey
1920 floatPrimLName = libFun (fsLit "floatPrimL") floatPrimLIdKey
1921 doublePrimLName = libFun (fsLit "doublePrimL") doublePrimLIdKey
1922 rationalLName = libFun (fsLit "rationalL") rationalLIdKey
1923
1924 -- data Pat = ...
1925 litPName, varPName, tupPName, unboxedTupPName, conPName, infixPName, tildePName, bangPName,
1926 asPName, wildPName, recPName, listPName, sigPName, viewPName :: Name
1927 litPName = libFun (fsLit "litP") litPIdKey
1928 varPName = libFun (fsLit "varP") varPIdKey
1929 tupPName = libFun (fsLit "tupP") tupPIdKey
1930 unboxedTupPName = libFun (fsLit "unboxedTupP") unboxedTupPIdKey
1931 conPName = libFun (fsLit "conP") conPIdKey
1932 infixPName = libFun (fsLit "infixP") infixPIdKey
1933 tildePName = libFun (fsLit "tildeP") tildePIdKey
1934 bangPName = libFun (fsLit "bangP") bangPIdKey
1935 asPName = libFun (fsLit "asP") asPIdKey
1936 wildPName = libFun (fsLit "wildP") wildPIdKey
1937 recPName = libFun (fsLit "recP") recPIdKey
1938 listPName = libFun (fsLit "listP") listPIdKey
1939 sigPName = libFun (fsLit "sigP") sigPIdKey
1940 viewPName = libFun (fsLit "viewP") viewPIdKey
1941
1942 -- type FieldPat = ...
1943 fieldPatName :: Name
1944 fieldPatName = libFun (fsLit "fieldPat") fieldPatIdKey
1945
1946 -- data Match = ...
1947 matchName :: Name
1948 matchName = libFun (fsLit "match") matchIdKey
1949
1950 -- data Clause = ...
1951 clauseName :: Name
1952 clauseName = libFun (fsLit "clause") clauseIdKey
1953
1954 -- data Exp = ...
1955 varEName, conEName, litEName, appEName, infixEName, infixAppName,
1956 sectionLName, sectionRName, lamEName, tupEName, unboxedTupEName, condEName,
1957 letEName, caseEName, doEName, compEName :: Name
1958 varEName = libFun (fsLit "varE") varEIdKey
1959 conEName = libFun (fsLit "conE") conEIdKey
1960 litEName = libFun (fsLit "litE") litEIdKey
1961 appEName = libFun (fsLit "appE") appEIdKey
1962 infixEName = libFun (fsLit "infixE") infixEIdKey
1963 infixAppName = libFun (fsLit "infixApp") infixAppIdKey
1964 sectionLName = libFun (fsLit "sectionL") sectionLIdKey
1965 sectionRName = libFun (fsLit "sectionR") sectionRIdKey
1966 lamEName = libFun (fsLit "lamE") lamEIdKey
1967 tupEName = libFun (fsLit "tupE") tupEIdKey
1968 unboxedTupEName = libFun (fsLit "unboxedTupE") unboxedTupEIdKey
1969 condEName = libFun (fsLit "condE") condEIdKey
1970 letEName = libFun (fsLit "letE") letEIdKey
1971 caseEName = libFun (fsLit "caseE") caseEIdKey
1972 doEName = libFun (fsLit "doE") doEIdKey
1973 compEName = libFun (fsLit "compE") compEIdKey
1974 -- ArithSeq skips a level
1975 fromEName, fromThenEName, fromToEName, fromThenToEName :: Name
1976 fromEName = libFun (fsLit "fromE") fromEIdKey
1977 fromThenEName = libFun (fsLit "fromThenE") fromThenEIdKey
1978 fromToEName = libFun (fsLit "fromToE") fromToEIdKey
1979 fromThenToEName = libFun (fsLit "fromThenToE") fromThenToEIdKey
1980 -- end ArithSeq
1981 listEName, sigEName, recConEName, recUpdEName :: Name
1982 listEName = libFun (fsLit "listE") listEIdKey
1983 sigEName = libFun (fsLit "sigE") sigEIdKey
1984 recConEName = libFun (fsLit "recConE") recConEIdKey
1985 recUpdEName = libFun (fsLit "recUpdE") recUpdEIdKey
1986
1987 -- type FieldExp = ...
1988 fieldExpName :: Name
1989 fieldExpName = libFun (fsLit "fieldExp") fieldExpIdKey
1990
1991 -- data Body = ...
1992 guardedBName, normalBName :: Name
1993 guardedBName = libFun (fsLit "guardedB") guardedBIdKey
1994 normalBName = libFun (fsLit "normalB") normalBIdKey
1995
1996 -- data Guard = ...
1997 normalGEName, patGEName :: Name
1998 normalGEName = libFun (fsLit "normalGE") normalGEIdKey
1999 patGEName = libFun (fsLit "patGE") patGEIdKey
2000
2001 -- data Stmt = ...
2002 bindSName, letSName, noBindSName, parSName :: Name
2003 bindSName = libFun (fsLit "bindS") bindSIdKey
2004 letSName = libFun (fsLit "letS") letSIdKey
2005 noBindSName = libFun (fsLit "noBindS") noBindSIdKey
2006 parSName = libFun (fsLit "parS") parSIdKey
2007
2008 -- data Dec = ...
2009 funDName, valDName, dataDName, newtypeDName, tySynDName, classDName,
2010 instanceDName, sigDName, forImpDName, pragInlDName, pragSpecDName,
2011 pragSpecInlDName, familyNoKindDName, familyKindDName, dataInstDName,
2012 newtypeInstDName, tySynInstDName,
2013 infixLDName, infixRDName, infixNDName :: Name
2014 funDName = libFun (fsLit "funD") funDIdKey
2015 valDName = libFun (fsLit "valD") valDIdKey
2016 dataDName = libFun (fsLit "dataD") dataDIdKey
2017 newtypeDName = libFun (fsLit "newtypeD") newtypeDIdKey
2018 tySynDName = libFun (fsLit "tySynD") tySynDIdKey
2019 classDName = libFun (fsLit "classD") classDIdKey
2020 instanceDName = libFun (fsLit "instanceD") instanceDIdKey
2021 sigDName = libFun (fsLit "sigD") sigDIdKey
2022 forImpDName = libFun (fsLit "forImpD") forImpDIdKey
2023 pragInlDName = libFun (fsLit "pragInlD") pragInlDIdKey
2024 pragSpecDName = libFun (fsLit "pragSpecD") pragSpecDIdKey
2025 pragSpecInlDName = libFun (fsLit "pragSpecInlD") pragSpecInlDIdKey
2026 familyNoKindDName= libFun (fsLit "familyNoKindD")familyNoKindDIdKey
2027 familyKindDName = libFun (fsLit "familyKindD") familyKindDIdKey
2028 dataInstDName = libFun (fsLit "dataInstD") dataInstDIdKey
2029 newtypeInstDName = libFun (fsLit "newtypeInstD") newtypeInstDIdKey
2030 tySynInstDName = libFun (fsLit "tySynInstD") tySynInstDIdKey
2031 infixLDName = libFun (fsLit "infixLD") infixLDIdKey
2032 infixRDName = libFun (fsLit "infixRD") infixRDIdKey
2033 infixNDName = libFun (fsLit "infixND") infixNDIdKey
2034
2035 -- type Ctxt = ...
2036 cxtName :: Name
2037 cxtName = libFun (fsLit "cxt") cxtIdKey
2038
2039 -- data Pred = ...
2040 classPName, equalPName :: Name
2041 classPName = libFun (fsLit "classP") classPIdKey
2042 equalPName = libFun (fsLit "equalP") equalPIdKey
2043
2044 -- data Strict = ...
2045 isStrictName, notStrictName, unpackedName :: Name
2046 isStrictName = libFun (fsLit "isStrict") isStrictKey
2047 notStrictName = libFun (fsLit "notStrict") notStrictKey
2048 unpackedName = libFun (fsLit "unpacked") unpackedKey
2049
2050 -- data Con = ...
2051 normalCName, recCName, infixCName, forallCName :: Name
2052 normalCName = libFun (fsLit "normalC") normalCIdKey
2053 recCName = libFun (fsLit "recC") recCIdKey
2054 infixCName = libFun (fsLit "infixC") infixCIdKey
2055 forallCName = libFun (fsLit "forallC") forallCIdKey
2056
2057 -- type StrictType = ...
2058 strictTypeName :: Name
2059 strictTypeName = libFun (fsLit "strictType") strictTKey
2060
2061 -- type VarStrictType = ...
2062 varStrictTypeName :: Name
2063 varStrictTypeName = libFun (fsLit "varStrictType") varStrictTKey
2064
2065 -- data Type = ...
2066 forallTName, varTName, conTName, tupleTName, unboxedTupleTName, arrowTName,
2067 listTName, appTName, sigTName :: Name
2068 forallTName = libFun (fsLit "forallT") forallTIdKey
2069 varTName = libFun (fsLit "varT") varTIdKey
2070 conTName = libFun (fsLit "conT") conTIdKey
2071 tupleTName = libFun (fsLit "tupleT") tupleTIdKey
2072 unboxedTupleTName = libFun (fsLit "unboxedTupleT") unboxedTupleTIdKey
2073 arrowTName = libFun (fsLit "arrowT") arrowTIdKey
2074 listTName = libFun (fsLit "listT") listTIdKey
2075 appTName = libFun (fsLit "appT") appTIdKey
2076 sigTName = libFun (fsLit "sigT") sigTIdKey
2077
2078 -- data TyVarBndr = ...
2079 plainTVName, kindedTVName :: Name
2080 plainTVName = libFun (fsLit "plainTV") plainTVIdKey
2081 kindedTVName = libFun (fsLit "kindedTV") kindedTVIdKey
2082
2083 -- data Kind = ...
2084 starKName, arrowKName :: Name
2085 starKName = libFun (fsLit "starK") starKIdKey
2086 arrowKName = libFun (fsLit "arrowK") arrowKIdKey
2087
2088 -- data Callconv = ...
2089 cCallName, stdCallName :: Name
2090 cCallName = libFun (fsLit "cCall") cCallIdKey
2091 stdCallName = libFun (fsLit "stdCall") stdCallIdKey
2092
2093 -- data Safety = ...
2094 unsafeName, safeName, interruptibleName :: Name
2095 unsafeName = libFun (fsLit "unsafe") unsafeIdKey
2096 safeName = libFun (fsLit "safe") safeIdKey
2097 interruptibleName = libFun (fsLit "interruptible") interruptibleIdKey
2098
2099 -- data InlineSpec = ...
2100 inlineSpecNoPhaseName, inlineSpecPhaseName :: Name
2101 inlineSpecNoPhaseName = libFun (fsLit "inlineSpecNoPhase") inlineSpecNoPhaseIdKey
2102 inlineSpecPhaseName = libFun (fsLit "inlineSpecPhase") inlineSpecPhaseIdKey
2103
2104 -- data FunDep = ...
2105 funDepName :: Name
2106 funDepName = libFun (fsLit "funDep") funDepIdKey
2107
2108 -- data FamFlavour = ...
2109 typeFamName, dataFamName :: Name
2110 typeFamName = libFun (fsLit "typeFam") typeFamIdKey
2111 dataFamName = libFun (fsLit "dataFam") dataFamIdKey
2112
2113 matchQTyConName, clauseQTyConName, expQTyConName, stmtQTyConName,
2114 decQTyConName, conQTyConName, strictTypeQTyConName,
2115 varStrictTypeQTyConName, typeQTyConName, fieldExpQTyConName,
2116 patQTyConName, fieldPatQTyConName, predQTyConName, decsQTyConName :: Name
2117 matchQTyConName = libTc (fsLit "MatchQ") matchQTyConKey
2118 clauseQTyConName = libTc (fsLit "ClauseQ") clauseQTyConKey
2119 expQTyConName = libTc (fsLit "ExpQ") expQTyConKey
2120 stmtQTyConName = libTc (fsLit "StmtQ") stmtQTyConKey
2121 decQTyConName = libTc (fsLit "DecQ") decQTyConKey
2122 decsQTyConName = libTc (fsLit "DecsQ") decsQTyConKey -- Q [Dec]
2123 conQTyConName = libTc (fsLit "ConQ") conQTyConKey
2124 strictTypeQTyConName = libTc (fsLit "StrictTypeQ") strictTypeQTyConKey
2125 varStrictTypeQTyConName = libTc (fsLit "VarStrictTypeQ") varStrictTypeQTyConKey
2126 typeQTyConName = libTc (fsLit "TypeQ") typeQTyConKey
2127 fieldExpQTyConName = libTc (fsLit "FieldExpQ") fieldExpQTyConKey
2128 patQTyConName = libTc (fsLit "PatQ") patQTyConKey
2129 fieldPatQTyConName = libTc (fsLit "FieldPatQ") fieldPatQTyConKey
2130 predQTyConName = libTc (fsLit "PredQ") predQTyConKey
2131
2132 -- quasiquoting
2133 quoteExpName, quotePatName, quoteDecName, quoteTypeName :: Name
2134 quoteExpName = qqFun (fsLit "quoteExp") quoteExpKey
2135 quotePatName = qqFun (fsLit "quotePat") quotePatKey
2136 quoteDecName = qqFun (fsLit "quoteDec") quoteDecKey
2137 quoteTypeName = qqFun (fsLit "quoteType") quoteTypeKey
2138
2139 -- TyConUniques available: 200-299
2140 -- Check in PrelNames if you want to change this
2141
2142 expTyConKey, matchTyConKey, clauseTyConKey, qTyConKey, expQTyConKey,
2143 decQTyConKey, patTyConKey, matchQTyConKey, clauseQTyConKey,
2144 stmtQTyConKey, conQTyConKey, typeQTyConKey, typeTyConKey, tyVarBndrTyConKey,
2145 decTyConKey, varStrictTypeQTyConKey, strictTypeQTyConKey,
2146 fieldExpTyConKey, fieldPatTyConKey, nameTyConKey, patQTyConKey,
2147 fieldPatQTyConKey, fieldExpQTyConKey, funDepTyConKey, predTyConKey,
2148 predQTyConKey, decsQTyConKey :: Unique
2149 expTyConKey = mkPreludeTyConUnique 200
2150 matchTyConKey = mkPreludeTyConUnique 201
2151 clauseTyConKey = mkPreludeTyConUnique 202
2152 qTyConKey = mkPreludeTyConUnique 203
2153 expQTyConKey = mkPreludeTyConUnique 204
2154 decQTyConKey = mkPreludeTyConUnique 205
2155 patTyConKey = mkPreludeTyConUnique 206
2156 matchQTyConKey = mkPreludeTyConUnique 207
2157 clauseQTyConKey = mkPreludeTyConUnique 208
2158 stmtQTyConKey = mkPreludeTyConUnique 209
2159 conQTyConKey = mkPreludeTyConUnique 210
2160 typeQTyConKey = mkPreludeTyConUnique 211
2161 typeTyConKey = mkPreludeTyConUnique 212
2162 decTyConKey = mkPreludeTyConUnique 213
2163 varStrictTypeQTyConKey = mkPreludeTyConUnique 214
2164 strictTypeQTyConKey = mkPreludeTyConUnique 215
2165 fieldExpTyConKey = mkPreludeTyConUnique 216
2166 fieldPatTyConKey = mkPreludeTyConUnique 217
2167 nameTyConKey = mkPreludeTyConUnique 218
2168 patQTyConKey = mkPreludeTyConUnique 219
2169 fieldPatQTyConKey = mkPreludeTyConUnique 220
2170 fieldExpQTyConKey = mkPreludeTyConUnique 221
2171 funDepTyConKey = mkPreludeTyConUnique 222
2172 predTyConKey = mkPreludeTyConUnique 223
2173 predQTyConKey = mkPreludeTyConUnique 224
2174 tyVarBndrTyConKey = mkPreludeTyConUnique 225
2175 decsQTyConKey = mkPreludeTyConUnique 226
2176
2177 -- IdUniques available: 200-399
2178 -- If you want to change this, make sure you check in PrelNames
2179
2180 returnQIdKey, bindQIdKey, sequenceQIdKey, liftIdKey, newNameIdKey,
2181 mkNameIdKey, mkNameG_vIdKey, mkNameG_dIdKey, mkNameG_tcIdKey,
2182 mkNameLIdKey :: Unique
2183 returnQIdKey = mkPreludeMiscIdUnique 200
2184 bindQIdKey = mkPreludeMiscIdUnique 201
2185 sequenceQIdKey = mkPreludeMiscIdUnique 202
2186 liftIdKey = mkPreludeMiscIdUnique 203
2187 newNameIdKey = mkPreludeMiscIdUnique 204
2188 mkNameIdKey = mkPreludeMiscIdUnique 205
2189 mkNameG_vIdKey = mkPreludeMiscIdUnique 206
2190 mkNameG_dIdKey = mkPreludeMiscIdUnique 207
2191 mkNameG_tcIdKey = mkPreludeMiscIdUnique 208
2192 mkNameLIdKey = mkPreludeMiscIdUnique 209
2193
2194
2195 -- data Lit = ...
2196 charLIdKey, stringLIdKey, integerLIdKey, intPrimLIdKey, wordPrimLIdKey,
2197 floatPrimLIdKey, doublePrimLIdKey, rationalLIdKey :: Unique
2198 charLIdKey = mkPreludeMiscIdUnique 220
2199 stringLIdKey = mkPreludeMiscIdUnique 221
2200 integerLIdKey = mkPreludeMiscIdUnique 222
2201 intPrimLIdKey = mkPreludeMiscIdUnique 223
2202 wordPrimLIdKey = mkPreludeMiscIdUnique 224
2203 floatPrimLIdKey = mkPreludeMiscIdUnique 225
2204 doublePrimLIdKey = mkPreludeMiscIdUnique 226
2205 rationalLIdKey = mkPreludeMiscIdUnique 227
2206
2207 liftStringIdKey :: Unique
2208 liftStringIdKey = mkPreludeMiscIdUnique 228
2209
2210 -- data Pat = ...
2211 litPIdKey, varPIdKey, tupPIdKey, unboxedTupPIdKey, conPIdKey, infixPIdKey, tildePIdKey, bangPIdKey,
2212 asPIdKey, wildPIdKey, recPIdKey, listPIdKey, sigPIdKey, viewPIdKey :: Unique
2213 litPIdKey = mkPreludeMiscIdUnique 240
2214 varPIdKey = mkPreludeMiscIdUnique 241
2215 tupPIdKey = mkPreludeMiscIdUnique 242
2216 unboxedTupPIdKey = mkPreludeMiscIdUnique 243
2217 conPIdKey = mkPreludeMiscIdUnique 244
2218 infixPIdKey = mkPreludeMiscIdUnique 245
2219 tildePIdKey = mkPreludeMiscIdUnique 246
2220 bangPIdKey = mkPreludeMiscIdUnique 247
2221 asPIdKey = mkPreludeMiscIdUnique 248
2222 wildPIdKey = mkPreludeMiscIdUnique 249
2223 recPIdKey = mkPreludeMiscIdUnique 250
2224 listPIdKey = mkPreludeMiscIdUnique 251
2225 sigPIdKey = mkPreludeMiscIdUnique 252
2226 viewPIdKey = mkPreludeMiscIdUnique 253
2227
2228 -- type FieldPat = ...
2229 fieldPatIdKey :: Unique
2230 fieldPatIdKey = mkPreludeMiscIdUnique 260
2231
2232 -- data Match = ...
2233 matchIdKey :: Unique
2234 matchIdKey = mkPreludeMiscIdUnique 261
2235
2236 -- data Clause = ...
2237 clauseIdKey :: Unique
2238 clauseIdKey = mkPreludeMiscIdUnique 262
2239
2240
2241 -- data Exp = ...
2242 varEIdKey, conEIdKey, litEIdKey, appEIdKey, infixEIdKey, infixAppIdKey,
2243 sectionLIdKey, sectionRIdKey, lamEIdKey, tupEIdKey, unboxedTupEIdKey,
2244 condEIdKey,
2245 letEIdKey, caseEIdKey, doEIdKey, compEIdKey,
2246 fromEIdKey, fromThenEIdKey, fromToEIdKey, fromThenToEIdKey,
2247 listEIdKey, sigEIdKey, recConEIdKey, recUpdEIdKey :: Unique
2248 varEIdKey = mkPreludeMiscIdUnique 270
2249 conEIdKey = mkPreludeMiscIdUnique 271
2250 litEIdKey = mkPreludeMiscIdUnique 272
2251 appEIdKey = mkPreludeMiscIdUnique 273
2252 infixEIdKey = mkPreludeMiscIdUnique 274
2253 infixAppIdKey = mkPreludeMiscIdUnique 275
2254 sectionLIdKey = mkPreludeMiscIdUnique 276
2255 sectionRIdKey = mkPreludeMiscIdUnique 277
2256 lamEIdKey = mkPreludeMiscIdUnique 278
2257 tupEIdKey = mkPreludeMiscIdUnique 279
2258 unboxedTupEIdKey = mkPreludeMiscIdUnique 280
2259 condEIdKey = mkPreludeMiscIdUnique 281
2260 letEIdKey = mkPreludeMiscIdUnique 282
2261 caseEIdKey = mkPreludeMiscIdUnique 283
2262 doEIdKey = mkPreludeMiscIdUnique 284
2263 compEIdKey = mkPreludeMiscIdUnique 285
2264 fromEIdKey = mkPreludeMiscIdUnique 286
2265 fromThenEIdKey = mkPreludeMiscIdUnique 287
2266 fromToEIdKey = mkPreludeMiscIdUnique 288
2267 fromThenToEIdKey = mkPreludeMiscIdUnique 289
2268 listEIdKey = mkPreludeMiscIdUnique 290
2269 sigEIdKey = mkPreludeMiscIdUnique 291
2270 recConEIdKey = mkPreludeMiscIdUnique 292
2271 recUpdEIdKey = mkPreludeMiscIdUnique 293
2272
2273 -- type FieldExp = ...
2274 fieldExpIdKey :: Unique
2275 fieldExpIdKey = mkPreludeMiscIdUnique 310
2276
2277 -- data Body = ...
2278 guardedBIdKey, normalBIdKey :: Unique
2279 guardedBIdKey = mkPreludeMiscIdUnique 311
2280 normalBIdKey = mkPreludeMiscIdUnique 312
2281
2282 -- data Guard = ...
2283 normalGEIdKey, patGEIdKey :: Unique
2284 normalGEIdKey = mkPreludeMiscIdUnique 313
2285 patGEIdKey = mkPreludeMiscIdUnique 314
2286
2287 -- data Stmt = ...
2288 bindSIdKey, letSIdKey, noBindSIdKey, parSIdKey :: Unique
2289 bindSIdKey = mkPreludeMiscIdUnique 320
2290 letSIdKey = mkPreludeMiscIdUnique 321
2291 noBindSIdKey = mkPreludeMiscIdUnique 322
2292 parSIdKey = mkPreludeMiscIdUnique 323
2293
2294 -- data Dec = ...
2295 funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey,
2296 classDIdKey, instanceDIdKey, sigDIdKey, forImpDIdKey, pragInlDIdKey,
2297 pragSpecDIdKey, pragSpecInlDIdKey, familyNoKindDIdKey, familyKindDIdKey,
2298 dataInstDIdKey, newtypeInstDIdKey, tySynInstDIdKey,
2299 infixLDIdKey, infixRDIdKey, infixNDIdKey :: Unique
2300 funDIdKey = mkPreludeMiscIdUnique 330
2301 valDIdKey = mkPreludeMiscIdUnique 331
2302 dataDIdKey = mkPreludeMiscIdUnique 332
2303 newtypeDIdKey = mkPreludeMiscIdUnique 333
2304 tySynDIdKey = mkPreludeMiscIdUnique 334
2305 classDIdKey = mkPreludeMiscIdUnique 335
2306 instanceDIdKey = mkPreludeMiscIdUnique 336
2307 sigDIdKey = mkPreludeMiscIdUnique 337
2308 forImpDIdKey = mkPreludeMiscIdUnique 338
2309 pragInlDIdKey = mkPreludeMiscIdUnique 339
2310 pragSpecDIdKey = mkPreludeMiscIdUnique 340
2311 pragSpecInlDIdKey = mkPreludeMiscIdUnique 341
2312 familyNoKindDIdKey = mkPreludeMiscIdUnique 342
2313 familyKindDIdKey = mkPreludeMiscIdUnique 343
2314 dataInstDIdKey = mkPreludeMiscIdUnique 344
2315 newtypeInstDIdKey = mkPreludeMiscIdUnique 345
2316 tySynInstDIdKey = mkPreludeMiscIdUnique 346
2317 infixLDIdKey = mkPreludeMiscIdUnique 347
2318 infixRDIdKey = mkPreludeMiscIdUnique 348
2319 infixNDIdKey = mkPreludeMiscIdUnique 349
2320
2321 -- type Cxt = ...
2322 cxtIdKey :: Unique
2323 cxtIdKey = mkPreludeMiscIdUnique 360
2324
2325 -- data Pred = ...
2326 classPIdKey, equalPIdKey :: Unique
2327 classPIdKey = mkPreludeMiscIdUnique 361
2328 equalPIdKey = mkPreludeMiscIdUnique 362
2329
2330 -- data Strict = ...
2331 isStrictKey, notStrictKey, unpackedKey :: Unique
2332 isStrictKey = mkPreludeMiscIdUnique 363
2333 notStrictKey = mkPreludeMiscIdUnique 364
2334 unpackedKey = mkPreludeMiscIdUnique 365
2335
2336 -- data Con = ...
2337 normalCIdKey, recCIdKey, infixCIdKey, forallCIdKey :: Unique
2338 normalCIdKey = mkPreludeMiscIdUnique 370
2339 recCIdKey = mkPreludeMiscIdUnique 371
2340 infixCIdKey = mkPreludeMiscIdUnique 372
2341 forallCIdKey = mkPreludeMiscIdUnique 373
2342
2343 -- type StrictType = ...
2344 strictTKey :: Unique
2345 strictTKey = mkPreludeMiscIdUnique 374
2346
2347 -- type VarStrictType = ...
2348 varStrictTKey :: Unique
2349 varStrictTKey = mkPreludeMiscIdUnique 375
2350
2351 -- data Type = ...
2352 forallTIdKey, varTIdKey, conTIdKey, tupleTIdKey, unboxedTupleTIdKey, arrowTIdKey,
2353 listTIdKey, appTIdKey, sigTIdKey :: Unique
2354 forallTIdKey = mkPreludeMiscIdUnique 380
2355 varTIdKey = mkPreludeMiscIdUnique 381
2356 conTIdKey = mkPreludeMiscIdUnique 382
2357 tupleTIdKey = mkPreludeMiscIdUnique 383
2358 unboxedTupleTIdKey = mkPreludeMiscIdUnique 384
2359 arrowTIdKey = mkPreludeMiscIdUnique 385
2360 listTIdKey = mkPreludeMiscIdUnique 386
2361 appTIdKey = mkPreludeMiscIdUnique 387
2362 sigTIdKey = mkPreludeMiscIdUnique 388
2363
2364 -- data TyVarBndr = ...
2365 plainTVIdKey, kindedTVIdKey :: Unique
2366 plainTVIdKey = mkPreludeMiscIdUnique 390
2367 kindedTVIdKey = mkPreludeMiscIdUnique 391
2368
2369 -- data Kind = ...
2370 starKIdKey, arrowKIdKey :: Unique
2371 starKIdKey = mkPreludeMiscIdUnique 392
2372 arrowKIdKey = mkPreludeMiscIdUnique 393
2373
2374 -- data Callconv = ...
2375 cCallIdKey, stdCallIdKey :: Unique
2376 cCallIdKey = mkPreludeMiscIdUnique 394
2377 stdCallIdKey = mkPreludeMiscIdUnique 395
2378
2379 -- data Safety = ...
2380 unsafeIdKey, safeIdKey, interruptibleIdKey :: Unique
2381 unsafeIdKey = mkPreludeMiscIdUnique 400
2382 safeIdKey = mkPreludeMiscIdUnique 401
2383 interruptibleIdKey = mkPreludeMiscIdUnique 403
2384
2385 -- data InlineSpec =
2386 inlineSpecNoPhaseIdKey, inlineSpecPhaseIdKey :: Unique
2387 inlineSpecNoPhaseIdKey = mkPreludeMiscIdUnique 404
2388 inlineSpecPhaseIdKey = mkPreludeMiscIdUnique 405
2389
2390 -- data FunDep = ...
2391 funDepIdKey :: Unique
2392 funDepIdKey = mkPreludeMiscIdUnique 406
2393
2394 -- data FamFlavour = ...
2395 typeFamIdKey, dataFamIdKey :: Unique
2396 typeFamIdKey = mkPreludeMiscIdUnique 407
2397 dataFamIdKey = mkPreludeMiscIdUnique 408
2398
2399 -- quasiquoting
2400 quoteExpKey, quotePatKey, quoteDecKey, quoteTypeKey :: Unique
2401 quoteExpKey = mkPreludeMiscIdUnique 410
2402 quotePatKey = mkPreludeMiscIdUnique 411
2403 quoteDecKey = mkPreludeMiscIdUnique 412
2404 quoteTypeKey = mkPreludeMiscIdUnique 413