1 -----------------------------------------------------------------------------
2 -- The purpose of this module is to transform an HsExpr into a CoreExpr which
3 -- when evaluated, returns a (Meta.Q Meta.Exp) computation analogous to the
4 -- input HsExpr. We do this in the DsM monad, which supplies access to
5 -- CoreExpr's of the "smart constructors" of the Meta.Exp datatype.
7 -- It also defines a bunch of knownKeyNames, in the same way as is done
8 -- in prelude/PrelNames. It's much more convenient to do it here, becuase
9 -- otherwise we have to recompile PrelNames whenever we add a Name, which is
10 -- a Royal Pain (triggers other recompilation).
11 -----------------------------------------------------------------------------
14 module DsMeta( dsBracket,
15 templateHaskellNames, qTyConName, nameTyConName,
16 liftName, expQTyConName, decQTyConName, typeQTyConName,
17 decTyConName, typeTyConName, mkNameG_dName, mkNameG_vName, mkNameG_tcName
20 #include "HsVersions.h"
22 import {-# SOURCE #-} DsExpr ( dsExpr )
24 import MatchLit ( dsLit )
25 import DsUtils ( mkListExpr, mkStringExpr, mkCoreTup, mkIntExpr )
28 import qualified Language.Haskell.TH as TH
32 import PrelNames ( rationalTyConName, integerTyConName, negateName )
33 import OccName ( isDataOcc, isTvOcc, occNameUserString )
34 -- To avoid clashes with DsMeta.varName we must make a local alias for OccName.varName
35 -- we do this by removing varName from the import of OccName above, making
36 -- a qualified instance of OccName and using OccNameAlias.varName where varName
37 -- ws previously used in this file.
38 import qualified OccName
40 import Module ( Module, mkModule, moduleUserString )
41 import Id ( Id, mkLocalId )
42 import OccName ( mkOccFS )
43 import Name ( Name, mkExternalName, localiseName, nameOccName, nameModule,
44 isExternalName, getSrcLoc )
46 import Type ( Type, mkGenTyConApp )
47 import TcType ( tcTyConAppArgs )
48 import TyCon ( tyConName )
49 import TysWiredIn ( parrTyCon )
51 import CoreUtils ( exprType )
52 import SrcLoc ( noSrcLoc, unLoc, Located(..), SrcSpan, srcLocSpan )
53 import Maybe ( catMaybes )
54 import Unique ( mkPreludeTyConUnique, mkPreludeMiscIdUnique, getKey, Uniquable(..) )
55 import BasicTypes ( isBoxed )
57 import Bag ( bagToList, unionManyBags )
58 import FastString ( unpackFS )
59 import ForeignCall ( Safety(..), CCallConv(..), CCallTarget(..) )
61 import Monad ( zipWithM )
62 import List ( sortBy )
64 -----------------------------------------------------------------------------
65 dsBracket :: HsBracket Name -> [PendingSplice] -> DsM CoreExpr
66 -- Returns a CoreExpr of type TH.ExpQ
67 -- The quoted thing is parameterised over Name, even though it has
68 -- been type checked. We don't want all those type decorations!
70 dsBracket brack splices
71 = dsExtendMetaEnv new_bit (do_brack brack)
73 new_bit = mkNameEnv [(n, Splice (unLoc e)) | (n,e) <- splices]
75 do_brack (VarBr n) = do { MkC e1 <- lookupOcc n ; return e1 }
76 do_brack (ExpBr e) = do { MkC e1 <- repLE e ; return e1 }
77 do_brack (PatBr p) = do { MkC p1 <- repLP p ; return p1 }
78 do_brack (TypBr t) = do { MkC t1 <- repLTy t ; return t1 }
79 do_brack (DecBr ds) = do { MkC ds1 <- repTopDs ds ; return ds1 }
81 {- -------------- Examples --------------------
85 gensym (unpackString "x"#) `bindQ` \ x1::String ->
86 lam (pvar x1) (var x1)
89 [| \x -> $(f [| x |]) |]
91 gensym (unpackString "x"#) `bindQ` \ x1::String ->
92 lam (pvar x1) (f (var x1))
96 -------------------------------------------------------
98 -------------------------------------------------------
100 repTopDs :: HsGroup Name -> DsM (Core (TH.Q [TH.Dec]))
102 = do { let { bndrs = map unLoc (groupBinders group) } ;
103 ss <- mkGenSyms bndrs ;
105 -- Bind all the names mainly to avoid repeated use of explicit strings.
107 -- do { t :: String <- genSym "T" ;
108 -- return (Data t [] ...more t's... }
109 -- The other important reason is that the output must mention
110 -- only "T", not "Foo:T" where Foo is the current module
113 decls <- addBinds ss (do {
114 val_ds <- rep_val_binds (hs_valds group) ;
115 tycl_ds <- mapM repTyClD (hs_tyclds group) ;
116 inst_ds <- mapM repInstD' (hs_instds group) ;
117 for_ds <- mapM repForD (hs_fords group) ;
119 return (de_loc $ sort_by_loc $ val_ds ++ catMaybes tycl_ds ++ inst_ds ++ for_ds) }) ;
121 decl_ty <- lookupType decQTyConName ;
122 let { core_list = coreList' decl_ty decls } ;
124 dec_ty <- lookupType decTyConName ;
125 q_decs <- repSequenceQ dec_ty core_list ;
127 wrapNongenSyms ss q_decs
128 -- Do *not* gensym top-level binders
131 groupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
132 hs_fords = foreign_decls })
133 -- Collect the binders of a Group
134 = collectHsValBinders val_decls ++
135 [n | d <- tycl_decls, n <- tyClDeclNames (unLoc d)] ++
136 [n | L _ (ForeignImport n _ _ _) <- foreign_decls]
139 {- Note [Binders and occurrences]
140 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
141 When we desugar [d| data T = MkT |]
143 Data "T" [] [Con "MkT" []] []
145 Data "Foo:T" [] [Con "Foo:MkT" []] []
146 That is, the new data decl should fit into whatever new module it is
147 asked to fit in. We do *not* clone, though; no need for this:
154 then we must desugar to
155 foo = Data "Foo:T" [] [Con "Foo:MkT" []] []
157 So in repTopDs we bring the binders into scope with mkGenSyms and addBinds.
158 And we use lookupOcc, rather than lookupBinder
159 in repTyClD and repC.
163 repTyClD :: LTyClDecl Name -> DsM (Maybe (SrcSpan, Core TH.DecQ))
165 repTyClD (L loc (TyData { tcdND = DataType, tcdCtxt = cxt,
166 tcdLName = tc, tcdTyVars = tvs,
167 tcdCons = cons, tcdDerivs = mb_derivs }))
168 = do { tc1 <- lookupLOcc tc ; -- See note [Binders and occurrences]
169 dec <- addTyVarBinds tvs $ \bndrs -> do {
170 cxt1 <- repLContext cxt ;
171 cons1 <- mapM repC cons ;
172 cons2 <- coreList conQTyConName cons1 ;
173 derivs1 <- repDerivs mb_derivs ;
174 bndrs1 <- coreList nameTyConName bndrs ;
175 repData cxt1 tc1 bndrs1 cons2 derivs1 } ;
176 return $ Just (loc, dec) }
178 repTyClD (L loc (TyData { tcdND = NewType, tcdCtxt = cxt,
179 tcdLName = tc, tcdTyVars = tvs,
180 tcdCons = [con], tcdDerivs = mb_derivs }))
181 = do { tc1 <- lookupLOcc tc ; -- See note [Binders and occurrences]
182 dec <- addTyVarBinds tvs $ \bndrs -> do {
183 cxt1 <- repLContext cxt ;
185 derivs1 <- repDerivs mb_derivs ;
186 bndrs1 <- coreList nameTyConName bndrs ;
187 repNewtype cxt1 tc1 bndrs1 con1 derivs1 } ;
188 return $ Just (loc, dec) }
190 repTyClD (L loc (TySynonym { tcdLName = tc, tcdTyVars = tvs, tcdSynRhs = ty }))
191 = do { tc1 <- lookupLOcc tc ; -- See note [Binders and occurrences]
192 dec <- addTyVarBinds tvs $ \bndrs -> do {
194 bndrs1 <- coreList nameTyConName bndrs ;
195 repTySyn tc1 bndrs1 ty1 } ;
196 return (Just (loc, dec)) }
198 repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
201 tcdSigs = sigs, tcdMeths = meth_binds }))
202 = do { cls1 <- lookupLOcc cls ; -- See note [Binders and occurrences]
203 dec <- addTyVarBinds tvs $ \bndrs -> do {
204 cxt1 <- repLContext cxt ;
205 sigs1 <- rep_sigs sigs ;
206 binds1 <- rep_binds meth_binds ;
207 fds1 <- repLFunDeps fds;
208 decls1 <- coreList decQTyConName (sigs1 ++ binds1) ;
209 bndrs1 <- coreList nameTyConName bndrs ;
210 repClass cxt1 cls1 bndrs1 fds1 decls1 } ;
211 return $ Just (loc, dec) }
214 repTyClD (L loc d) = putSrcSpanDs loc $
215 do { dsWarn (hang ds_msg 4 (ppr d))
220 repLFunDeps :: [Located (FunDep Name)] -> DsM (Core [TH.FunDep])
221 repLFunDeps fds = do fds' <- mapM repLFunDep fds
222 fdList <- coreList funDepTyConName fds'
225 repLFunDep :: Located (FunDep Name) -> DsM (Core TH.FunDep)
226 repLFunDep (L _ (xs, ys)) = do xs' <- mapM lookupBinder xs
227 ys' <- mapM lookupBinder ys
228 xs_list <- coreList nameTyConName xs'
229 ys_list <- coreList nameTyConName ys'
230 repFunDep xs_list ys_list
232 repInstD' (L loc (InstDecl ty binds _)) -- Ignore user pragmas for now
233 = do { i <- addTyVarBinds tvs $ \tv_bndrs ->
234 -- We must bring the type variables into scope, so their occurrences
235 -- don't fail, even though the binders don't appear in the resulting
237 do { cxt1 <- repContext cxt
238 ; inst_ty1 <- repPred (HsClassP cls tys)
239 ; ss <- mkGenSyms (collectHsBindBinders binds)
240 ; binds1 <- addBinds ss (rep_binds binds)
241 ; decls1 <- coreList decQTyConName binds1
242 ; decls2 <- wrapNongenSyms ss decls1
243 -- wrapNonGenSyms: do not clone the class op names!
244 -- They must be called 'op' etc, not 'op34'
245 ; repInst cxt1 inst_ty1 decls2 }
249 (tvs, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
251 repForD :: Located (ForeignDecl Name) -> DsM (SrcSpan, Core TH.DecQ)
252 repForD (L loc (ForeignImport name typ (CImport cc s ch cn cis) _))
253 = do MkC name' <- lookupLOcc name
254 MkC typ' <- repLTy typ
255 MkC cc' <- repCCallConv cc
256 MkC s' <- repSafety s
257 MkC str <- coreStringLit $ static
258 ++ unpackFS ch ++ " "
259 ++ unpackFS cn ++ " "
260 ++ conv_cimportspec cis
261 dec <- rep2 forImpDName [cc', s', str, name', typ']
264 conv_cimportspec (CLabel cls) = panic "repForD': CLabel Not handled"
265 conv_cimportspec (CFunction DynamicTarget) = "dynamic"
266 conv_cimportspec (CFunction (StaticTarget fs)) = unpackFS fs
267 conv_cimportspec CWrapper = "wrapper"
269 CFunction (StaticTarget _) -> "static "
272 repCCallConv :: CCallConv -> DsM (Core TH.Callconv)
273 repCCallConv CCallConv = rep2 cCallName []
274 repCCallConv StdCallConv = rep2 stdCallName []
276 repSafety :: Safety -> DsM (Core TH.Safety)
277 repSafety PlayRisky = rep2 unsafeName []
278 repSafety (PlaySafe False) = rep2 safeName []
279 repSafety (PlaySafe True) = rep2 threadsafeName []
281 ds_msg = ptext SLIT("Cannot desugar this Template Haskell declaration:")
283 -------------------------------------------------------
285 -------------------------------------------------------
287 repC :: LConDecl Name -> DsM (Core TH.ConQ)
288 repC (L loc (ConDecl con expl [] (L _ []) details ResTyH98))
289 = do { con1 <- lookupLOcc con ; -- See note [Binders and occurrences]
290 repConstr con1 details }
291 repC (L loc (ConDecl con expl tvs (L cloc ctxt) details ResTyH98))
292 = do { addTyVarBinds tvs $ \bndrs -> do {
293 c' <- repC (L loc (ConDecl con expl [] (L cloc []) details ResTyH98));
294 ctxt' <- repContext ctxt;
295 bndrs' <- coreList nameTyConName bndrs;
296 rep2 forallCName [unC bndrs', unC ctxt', unC c']
299 repC (L loc con_decl) -- GADTs
301 do { dsWarn (hang ds_msg 4 (ppr con_decl))
302 ; return (panic "DsMeta:repC") }
304 repBangTy :: LBangType Name -> DsM (Core (TH.StrictTypeQ))
308 rep2 strictTypeName [s, t]
310 (str, ty') = case ty of
311 L _ (HsBangTy _ ty) -> (isStrictName, ty)
312 other -> (notStrictName, ty)
314 -------------------------------------------------------
316 -------------------------------------------------------
318 repDerivs :: Maybe [LHsType Name] -> DsM (Core [TH.Name])
319 repDerivs Nothing = coreList nameTyConName []
320 repDerivs (Just ctxt)
321 = do { strs <- mapM rep_deriv ctxt ;
322 coreList nameTyConName strs }
324 rep_deriv :: LHsType Name -> DsM (Core TH.Name)
325 -- Deriving clauses must have the simple H98 form
326 rep_deriv (L _ (HsPredTy (HsClassP cls []))) = lookupOcc cls
327 rep_deriv other = panic "rep_deriv"
330 -------------------------------------------------------
331 -- Signatures in a class decl, or a group of bindings
332 -------------------------------------------------------
334 rep_sigs :: [LSig Name] -> DsM [Core TH.DecQ]
335 rep_sigs sigs = do locs_cores <- rep_sigs' sigs
336 return $ de_loc $ sort_by_loc locs_cores
338 rep_sigs' :: [LSig Name] -> DsM [(SrcSpan, Core TH.DecQ)]
339 -- We silently ignore ones we don't recognise
340 rep_sigs' sigs = do { sigs1 <- mapM rep_sig sigs ;
341 return (concat sigs1) }
343 rep_sig :: LSig Name -> DsM [(SrcSpan, Core TH.DecQ)]
345 -- Empty => Too hard, signature ignored
346 rep_sig (L loc (TypeSig nm ty)) = rep_proto nm ty loc
347 rep_sig other = return []
349 rep_proto :: Located Name -> LHsType Name -> SrcSpan -> DsM [(SrcSpan, Core TH.DecQ)]
350 rep_proto nm ty loc = do { nm1 <- lookupLOcc nm ;
352 sig <- repProto nm1 ty1 ;
353 return [(loc, sig)] }
356 -------------------------------------------------------
358 -------------------------------------------------------
360 -- gensym a list of type variables and enter them into the meta environment;
361 -- the computations passed as the second argument is executed in that extended
362 -- meta environment and gets the *new* names on Core-level as an argument
364 addTyVarBinds :: [LHsTyVarBndr Name] -- the binders to be added
365 -> ([Core TH.Name] -> DsM (Core (TH.Q a))) -- action in the ext env
366 -> DsM (Core (TH.Q a))
367 addTyVarBinds tvs m =
369 let names = map (hsTyVarName.unLoc) tvs
370 freshNames <- mkGenSyms names
371 term <- addBinds freshNames $ do
372 bndrs <- mapM lookupBinder names
374 wrapGenSyns freshNames term
376 -- represent a type context
378 repLContext :: LHsContext Name -> DsM (Core TH.CxtQ)
379 repLContext (L _ ctxt) = repContext ctxt
381 repContext :: HsContext Name -> DsM (Core TH.CxtQ)
383 preds <- mapM repLPred ctxt
384 predList <- coreList typeQTyConName preds
387 -- represent a type predicate
389 repLPred :: LHsPred Name -> DsM (Core TH.TypeQ)
390 repLPred (L _ p) = repPred p
392 repPred :: HsPred Name -> DsM (Core TH.TypeQ)
393 repPred (HsClassP cls tys) = do
394 tcon <- repTy (HsTyVar cls)
397 repPred (HsIParam _ _) =
398 panic "DsMeta.repTy: Can't represent predicates with implicit parameters"
400 -- yield the representation of a list of types
402 repLTys :: [LHsType Name] -> DsM [Core TH.TypeQ]
403 repLTys tys = mapM repLTy tys
407 repLTy :: LHsType Name -> DsM (Core TH.TypeQ)
408 repLTy (L _ ty) = repTy ty
410 repTy :: HsType Name -> DsM (Core TH.TypeQ)
411 repTy (HsForAllTy _ tvs ctxt ty) =
412 addTyVarBinds tvs $ \bndrs -> do
413 ctxt1 <- repLContext ctxt
415 bndrs1 <- coreList nameTyConName bndrs
416 repTForall bndrs1 ctxt1 ty1
419 | isTvOcc (nameOccName n) = do
420 tv1 <- lookupBinder n
425 repTy (HsAppTy f a) = do
429 repTy (HsFunTy f a) = do
432 tcon <- repArrowTyCon
433 repTapps tcon [f1, a1]
434 repTy (HsListTy t) = do
438 repTy (HsPArrTy t) = do
440 tcon <- repTy (HsTyVar (tyConName parrTyCon))
442 repTy (HsTupleTy tc tys) = do
444 tcon <- repTupleTyCon (length tys)
446 repTy (HsOpTy ty1 n ty2) = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1)
448 repTy (HsParTy t) = repLTy t
450 panic "DsMeta.repTy: Can't represent number types (for generics)"
451 repTy (HsPredTy pred) = repPred pred
452 repTy (HsKindSig ty kind) =
453 panic "DsMeta.repTy: Can't represent explicit kind signatures yet"
456 -----------------------------------------------------------------------------
458 -----------------------------------------------------------------------------
460 repLEs :: [LHsExpr Name] -> DsM (Core [TH.ExpQ])
461 repLEs es = do { es' <- mapM repLE es ;
462 coreList expQTyConName es' }
464 -- FIXME: some of these panics should be converted into proper error messages
465 -- unless we can make sure that constructs, which are plainly not
466 -- supported in TH already lead to error messages at an earlier stage
467 repLE :: LHsExpr Name -> DsM (Core TH.ExpQ)
468 repLE (L _ e) = repE e
470 repE :: HsExpr Name -> DsM (Core TH.ExpQ)
472 do { mb_val <- dsLookupMetaEnv x
474 Nothing -> do { str <- globalVar x
475 ; repVarOrCon x str }
476 Just (Bound y) -> repVarOrCon x (coreVar y)
477 Just (Splice e) -> do { e' <- dsExpr e
478 ; return (MkC e') } }
479 repE (HsIPVar x) = panic "DsMeta.repE: Can't represent implicit parameters"
481 -- Remember, we're desugaring renamer output here, so
482 -- HsOverlit can definitely occur
483 repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
484 repE (HsLit l) = do { a <- repLiteral l; repLit a }
485 repE (HsLam (MatchGroup [m] _)) = repLambda m
486 repE (HsApp x y) = do {a <- repLE x; b <- repLE y; repApp a b}
488 repE (OpApp e1 op fix e2) =
489 do { arg1 <- repLE e1;
492 repInfixApp arg1 the_op arg2 }
493 repE (NegApp x nm) = do
495 negateVar <- lookupOcc negateName >>= repVar
497 repE (HsPar x) = repLE x
498 repE (SectionL x y) = do { a <- repLE x; b <- repLE y; repSectionL a b }
499 repE (SectionR x y) = do { a <- repLE x; b <- repLE y; repSectionR a b }
500 repE (HsCase e (MatchGroup ms _)) = do { arg <- repLE e
501 ; ms2 <- mapM repMatchTup ms
502 ; repCaseE arg (nonEmptyCoreList ms2) }
503 repE (HsIf x y z) = do
508 repE (HsLet bs e) = do { (ss,ds) <- repBinds bs
509 ; e2 <- addBinds ss (repLE e)
512 -- FIXME: I haven't got the types here right yet
513 repE (HsDo DoExpr sts body ty)
514 = do { (ss,zs) <- repLSts sts;
515 body' <- addBinds ss $ repLE body;
516 ret <- repNoBindSt body';
517 e <- repDoE (nonEmptyCoreList (zs ++ [ret]));
519 repE (HsDo ListComp sts body ty)
520 = do { (ss,zs) <- repLSts sts;
521 body' <- addBinds ss $ repLE body;
522 ret <- repNoBindSt body';
523 e <- repComp (nonEmptyCoreList (zs ++ [ret]));
525 repE (HsDo _ _ _ _) = panic "DsMeta.repE: Can't represent mdo and [: :] yet"
526 repE (ExplicitList ty es) = do { xs <- repLEs es; repListExp xs }
527 repE (ExplicitPArr ty es) =
528 panic "DsMeta.repE: No explicit parallel arrays yet"
529 repE (ExplicitTuple es boxed)
530 | isBoxed boxed = do { xs <- repLEs es; repTup xs }
531 | otherwise = panic "DsMeta.repE: Can't represent unboxed tuples"
532 repE (RecordCon c _ flds)
533 = do { x <- lookupLOcc c;
534 fs <- repFields flds;
536 repE (RecordUpd e flds _ _)
538 fs <- repFields flds;
541 repE (ExprWithTySig e ty) = do { e1 <- repLE e; t1 <- repLTy ty; repSigExp e1 t1 }
542 repE (ArithSeq _ aseq) =
544 From e -> do { ds1 <- repLE e; repFrom ds1 }
553 FromThenTo e1 e2 e3 -> do
557 repFromThenTo ds1 ds2 ds3
558 repE (PArrSeq _ aseq) = panic "DsMeta.repE: parallel array seq.s missing"
559 repE (HsCoreAnn _ _) = panic "DsMeta.repE: Can't represent CoreAnn" -- hdaume: core annotations
560 repE (HsSCC _ _) = panic "DsMeta.repE: Can't represent SCC"
561 repE (HsBracketOut _ _) = panic "DsMeta.repE: Can't represent Oxford brackets"
562 repE (HsSpliceE (HsSplice n _))
563 = do { mb_val <- dsLookupMetaEnv n
565 Just (Splice e) -> do { e' <- dsExpr e
567 other -> pprPanic "HsSplice" (ppr n) }
569 repE e = pprPanic "DsMeta.repE: Illegal expression form" (ppr e)
571 -----------------------------------------------------------------------------
572 -- Building representations of auxillary structures like Match, Clause, Stmt,
574 repMatchTup :: LMatch Name -> DsM (Core TH.MatchQ)
575 repMatchTup (L _ (Match [p] ty (GRHSs guards wheres))) =
576 do { ss1 <- mkGenSyms (collectPatBinders p)
577 ; addBinds ss1 $ do {
579 ; (ss2,ds) <- repBinds wheres
580 ; addBinds ss2 $ do {
581 ; gs <- repGuards guards
582 ; match <- repMatch p1 gs ds
583 ; wrapGenSyns (ss1++ss2) match }}}
585 repClauseTup :: LMatch Name -> DsM (Core TH.ClauseQ)
586 repClauseTup (L _ (Match ps ty (GRHSs guards wheres))) =
587 do { ss1 <- mkGenSyms (collectPatsBinders ps)
588 ; addBinds ss1 $ do {
590 ; (ss2,ds) <- repBinds wheres
591 ; addBinds ss2 $ do {
592 gs <- repGuards guards
593 ; clause <- repClause ps1 gs ds
594 ; wrapGenSyns (ss1++ss2) clause }}}
596 repGuards :: [LGRHS Name] -> DsM (Core TH.BodyQ)
597 repGuards [L _ (GRHS [] e)]
598 = do {a <- repLE e; repNormal a }
600 = do { zs <- mapM process other;
601 let {(xs, ys) = unzip zs};
602 gd <- repGuarded (nonEmptyCoreList ys);
603 wrapGenSyns (concat xs) gd }
605 process :: LGRHS Name -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp))))
606 process (L _ (GRHS [L _ (ExprStmt e1 _ _)] e2))
607 = do { x <- repLNormalGE e1 e2;
609 process (L _ (GRHS ss rhs))
610 = do (gs, ss') <- repLSts ss
611 rhs' <- addBinds gs $ repLE rhs
612 g <- repPatGE (nonEmptyCoreList ss') rhs'
615 repFields :: [(Located Name, LHsExpr Name)] -> DsM (Core [TH.Q TH.FieldExp])
617 fnames <- mapM lookupLOcc (map fst flds)
618 es <- mapM repLE (map snd flds)
619 fs <- zipWithM repFieldExp fnames es
620 coreList fieldExpQTyConName fs
623 -----------------------------------------------------------------------------
624 -- Representing Stmt's is tricky, especially if bound variables
625 -- shadow each other. Consider: [| do { x <- f 1; x <- f x; g x } |]
626 -- First gensym new names for every variable in any of the patterns.
627 -- both static (x'1 and x'2), and dynamic ((gensym "x") and (gensym "y"))
628 -- if variables didn't shaddow, the static gensym wouldn't be necessary
629 -- and we could reuse the original names (x and x).
631 -- do { x'1 <- gensym "x"
632 -- ; x'2 <- gensym "x"
633 -- ; doE [ BindSt (pvar x'1) [| f 1 |]
634 -- , BindSt (pvar x'2) [| f x |]
635 -- , NoBindSt [| g x |]
639 -- The strategy is to translate a whole list of do-bindings by building a
640 -- bigger environment, and a bigger set of meta bindings
641 -- (like: x'1 <- gensym "x" ) and then combining these with the translations
642 -- of the expressions within the Do
644 -----------------------------------------------------------------------------
645 -- The helper function repSts computes the translation of each sub expression
646 -- and a bunch of prefix bindings denoting the dynamic renaming.
648 repLSts :: [LStmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
649 repLSts stmts = repSts (map unLoc stmts)
651 repSts :: [Stmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
652 repSts (BindStmt p e _ _ : ss) =
654 ; ss1 <- mkGenSyms (collectPatBinders p)
655 ; addBinds ss1 $ do {
657 ; (ss2,zs) <- repSts ss
658 ; z <- repBindSt p1 e2
659 ; return (ss1++ss2, z : zs) }}
660 repSts (LetStmt bs : ss) =
661 do { (ss1,ds) <- repBinds bs
663 ; (ss2,zs) <- addBinds ss1 (repSts ss)
664 ; return (ss1++ss2, z : zs) }
665 repSts (ExprStmt e _ _ : ss) =
667 ; z <- repNoBindSt e2
668 ; (ss2,zs) <- repSts ss
669 ; return (ss2, z : zs) }
670 repSts [] = return ([],[])
671 repSts other = panic "Exotic Stmt in meta brackets"
674 -----------------------------------------------------------
676 -----------------------------------------------------------
678 repBinds :: HsLocalBinds Name -> DsM ([GenSymBind], Core [TH.DecQ])
679 repBinds EmptyLocalBinds
680 = do { core_list <- coreList decQTyConName []
681 ; return ([], core_list) }
683 repBinds (HsIPBinds _)
684 = panic "DsMeta:repBinds: can't do implicit parameters"
686 repBinds (HsValBinds decs)
687 = do { let { bndrs = map unLoc (collectHsValBinders decs) }
688 -- No need to worrry about detailed scopes within
689 -- the binding group, because we are talking Names
690 -- here, so we can safely treat it as a mutually
692 ; ss <- mkGenSyms bndrs
693 ; prs <- addBinds ss (rep_val_binds decs)
694 ; core_list <- coreList decQTyConName
695 (de_loc (sort_by_loc prs))
696 ; return (ss, core_list) }
698 rep_val_binds :: HsValBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
699 -- Assumes: all the binders of the binding are alrady in the meta-env
700 rep_val_binds (ValBindsOut binds sigs)
701 = do { core1 <- rep_binds' (unionManyBags (map snd binds))
702 ; core2 <- rep_sigs' sigs
703 ; return (core1 ++ core2) }
705 rep_binds :: LHsBinds Name -> DsM [Core TH.DecQ]
706 rep_binds binds = do { binds_w_locs <- rep_binds' binds
707 ; return (de_loc (sort_by_loc binds_w_locs)) }
709 rep_binds' :: LHsBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
710 rep_binds' binds = mapM rep_bind (bagToList binds)
712 rep_bind :: LHsBind Name -> DsM (SrcSpan, Core TH.DecQ)
713 -- Assumes: all the binders of the binding are alrady in the meta-env
715 -- Note GHC treats declarations of a variable (not a pattern)
716 -- e.g. x = g 5 as a Fun MonoBinds. This is indicated by a single match
717 -- with an empty list of patterns
718 rep_bind (L loc (FunBind fn infx (MatchGroup [L _ (Match [] ty (GRHSs guards wheres))] _) _))
719 = do { (ss,wherecore) <- repBinds wheres
720 ; guardcore <- addBinds ss (repGuards guards)
721 ; fn' <- lookupLBinder fn
723 ; ans <- repVal p guardcore wherecore
724 ; ans' <- wrapGenSyns ss ans
725 ; return (loc, ans') }
727 rep_bind (L loc (FunBind fn infx (MatchGroup ms _) _))
728 = do { ms1 <- mapM repClauseTup ms
729 ; fn' <- lookupLBinder fn
730 ; ans <- repFun fn' (nonEmptyCoreList ms1)
731 ; return (loc, ans) }
733 rep_bind (L loc (PatBind pat (GRHSs guards wheres) ty2 _))
734 = do { patcore <- repLP pat
735 ; (ss,wherecore) <- repBinds wheres
736 ; guardcore <- addBinds ss (repGuards guards)
737 ; ans <- repVal patcore guardcore wherecore
738 ; ans' <- wrapGenSyns ss ans
739 ; return (loc, ans') }
741 rep_bind (L loc (VarBind v e))
742 = do { v' <- lookupBinder v
745 ; patcore <- repPvar v'
746 ; empty_decls <- coreList decQTyConName []
747 ; ans <- repVal patcore x empty_decls
748 ; return (srcLocSpan (getSrcLoc v), ans) }
750 -----------------------------------------------------------------------------
751 -- Since everything in a Bind is mutually recursive we need rename all
752 -- all the variables simultaneously. For example:
753 -- [| AndMonoBinds (f x = x + g 2) (g x = f 1 + 2) |] would translate to
754 -- do { f'1 <- gensym "f"
755 -- ; g'2 <- gensym "g"
756 -- ; [ do { x'3 <- gensym "x"; fun f'1 [pvar x'3] [| x + g2 |]},
757 -- do { x'4 <- gensym "x"; fun g'2 [pvar x'4] [| f 1 + 2 |]}
759 -- This requires collecting the bindings (f'1 <- gensym "f"), and the
760 -- environment ( f |-> f'1 ) from each binding, and then unioning them
761 -- together. As we do this we collect GenSymBinds's which represent the renamed
762 -- variables bound by the Bindings. In order not to lose track of these
763 -- representations we build a shadow datatype MB with the same structure as
764 -- MonoBinds, but which has slots for the representations
767 -----------------------------------------------------------------------------
768 -- GHC allows a more general form of lambda abstraction than specified
769 -- by Haskell 98. In particular it allows guarded lambda's like :
770 -- (\ x | even x -> 0 | odd x -> 1) at the moment we can't represent this in
771 -- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like
772 -- (\ p1 .. pn -> exp) by causing an error.
774 repLambda :: LMatch Name -> DsM (Core TH.ExpQ)
775 repLambda (L _ (Match ps _ (GRHSs [L _ (GRHS [] e)] EmptyLocalBinds)))
776 = do { let bndrs = collectPatsBinders ps ;
777 ; ss <- mkGenSyms bndrs
778 ; lam <- addBinds ss (
779 do { xs <- repLPs ps; body <- repLE e; repLam xs body })
780 ; wrapGenSyns ss lam }
782 repLambda z = panic "Can't represent a guarded lambda in Template Haskell"
785 -----------------------------------------------------------------------------
787 -- repP deals with patterns. It assumes that we have already
788 -- walked over the pattern(s) once to collect the binders, and
789 -- have extended the environment. So every pattern-bound
790 -- variable should already appear in the environment.
792 -- Process a list of patterns
793 repLPs :: [LPat Name] -> DsM (Core [TH.PatQ])
794 repLPs ps = do { ps' <- mapM repLP ps ;
795 coreList patQTyConName ps' }
797 repLP :: LPat Name -> DsM (Core TH.PatQ)
798 repLP (L _ p) = repP p
800 repP :: Pat Name -> DsM (Core TH.PatQ)
801 repP (WildPat _) = repPwild
802 repP (LitPat l) = do { l2 <- repLiteral l; repPlit l2 }
803 repP (VarPat x) = do { x' <- lookupBinder x; repPvar x' }
804 repP (LazyPat p) = do { p1 <- repLP p; repPtilde p1 }
805 repP (AsPat x p) = do { x' <- lookupLBinder x; p1 <- repLP p; repPaspat x' p1 }
806 repP (ParPat p) = repLP p
807 repP (ListPat ps _) = do { qs <- repLPs ps; repPlist qs }
808 repP (TuplePat ps _) = do { qs <- repLPs ps; repPtup qs }
809 repP (ConPatIn dc details)
810 = do { con_str <- lookupLOcc dc
812 PrefixCon ps -> do { qs <- repLPs ps; repPcon con_str qs }
813 RecCon pairs -> do { vs <- sequence $ map lookupLOcc (map fst pairs)
814 ; ps <- sequence $ map repLP (map snd pairs)
815 ; fps <- zipWithM (\x y -> rep2 fieldPatName [unC x,unC y]) vs ps
816 ; fps' <- coreList fieldPatQTyConName fps
817 ; repPrec con_str fps' }
818 InfixCon p1 p2 -> do { p1' <- repLP p1;
820 repPinfix p1' con_str p2' }
822 repP (NPat l (Just _) _ _) = panic "Can't cope with negative overloaded patterns yet (repP (NPat _ (Just _)))"
823 repP (NPat l Nothing _ _) = do { a <- repOverloadedLiteral l; repPlit a }
824 repP (SigPatIn p t) = do { p' <- repLP p; t' <- repLTy t; repPsig p' t' }
825 repP other = panic "Exotic pattern inside meta brackets"
827 ----------------------------------------------------------
828 -- Declaration ordering helpers
830 sort_by_loc :: [(SrcSpan, a)] -> [(SrcSpan, a)]
831 sort_by_loc xs = sortBy comp xs
832 where comp x y = compare (fst x) (fst y)
834 de_loc :: [(a, b)] -> [b]
837 ----------------------------------------------------------
838 -- The meta-environment
840 -- A name/identifier association for fresh names of locally bound entities
841 type GenSymBind = (Name, Id) -- Gensym the string and bind it to the Id
842 -- I.e. (x, x_id) means
843 -- let x_id = gensym "x" in ...
845 -- Generate a fresh name for a locally bound entity
847 mkGenSyms :: [Name] -> DsM [GenSymBind]
848 -- We can use the existing name. For example:
849 -- [| \x_77 -> x_77 + x_77 |]
851 -- do { x_77 <- genSym "x"; .... }
852 -- We use the same x_77 in the desugared program, but with the type Bndr
855 -- We do make it an Internal name, though (hence localiseName)
857 -- Nevertheless, it's monadic because we have to generate nameTy
858 mkGenSyms ns = do { var_ty <- lookupType nameTyConName
859 ; return [(nm, mkLocalId (localiseName nm) var_ty) | nm <- ns] }
862 addBinds :: [GenSymBind] -> DsM a -> DsM a
863 -- Add a list of fresh names for locally bound entities to the
864 -- meta environment (which is part of the state carried around
865 -- by the desugarer monad)
866 addBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,Bound id) | (n,id) <- bs]) m
868 -- Look up a locally bound name
870 lookupLBinder :: Located Name -> DsM (Core TH.Name)
871 lookupLBinder (L _ n) = lookupBinder n
873 lookupBinder :: Name -> DsM (Core TH.Name)
875 = do { mb_val <- dsLookupMetaEnv n;
877 Just (Bound x) -> return (coreVar x)
878 other -> pprPanic "Failed binder lookup:" (ppr n) }
880 -- Look up a name that is either locally bound or a global name
882 -- * If it is a global name, generate the "original name" representation (ie,
883 -- the <module>:<name> form) for the associated entity
885 lookupLOcc :: Located Name -> DsM (Core TH.Name)
886 -- Lookup an occurrence; it can't be a splice.
887 -- Use the in-scope bindings if they exist
888 lookupLOcc (L _ n) = lookupOcc n
890 lookupOcc :: Name -> DsM (Core TH.Name)
892 = do { mb_val <- dsLookupMetaEnv n ;
894 Nothing -> globalVar n
895 Just (Bound x) -> return (coreVar x)
896 Just (Splice _) -> pprPanic "repE:lookupOcc" (ppr n)
899 globalVar :: Name -> DsM (Core TH.Name)
900 -- Not bound by the meta-env
901 -- Could be top-level; or could be local
902 -- f x = $(g [| x |])
903 -- Here the x will be local
905 | isExternalName name
906 = do { MkC mod <- coreStringLit name_mod
907 ; MkC occ <- occNameLit name
908 ; rep2 mk_varg [mod,occ] }
910 = do { MkC occ <- occNameLit name
911 ; MkC uni <- coreIntLit (getKey (getUnique name))
912 ; rep2 mkNameLName [occ,uni] }
914 name_mod = moduleUserString (nameModule name)
915 name_occ = nameOccName name
916 mk_varg | OccName.isDataOcc name_occ = mkNameG_dName
917 | OccName.isVarOcc name_occ = mkNameG_vName
918 | OccName.isTcOcc name_occ = mkNameG_tcName
919 | otherwise = pprPanic "DsMeta.globalVar" (ppr name)
921 lookupType :: Name -- Name of type constructor (e.g. TH.ExpQ)
922 -> DsM Type -- The type
923 lookupType tc_name = do { tc <- dsLookupTyCon tc_name ;
924 return (mkGenTyConApp tc []) }
926 wrapGenSyns :: [GenSymBind]
927 -> Core (TH.Q a) -> DsM (Core (TH.Q a))
928 -- wrapGenSyns [(nm1,id1), (nm2,id2)] y
929 -- --> bindQ (gensym nm1) (\ id1 ->
930 -- bindQ (gensym nm2 (\ id2 ->
933 wrapGenSyns binds body@(MkC b)
934 = do { var_ty <- lookupType nameTyConName
937 [elt_ty] = tcTyConAppArgs (exprType b)
938 -- b :: Q a, so we can get the type 'a' by looking at the
939 -- argument type. NB: this relies on Q being a data/newtype,
940 -- not a type synonym
942 go var_ty [] = return body
943 go var_ty ((name,id) : binds)
944 = do { MkC body' <- go var_ty binds
945 ; lit_str <- occNameLit name
946 ; gensym_app <- repGensym lit_str
947 ; repBindQ var_ty elt_ty
948 gensym_app (MkC (Lam id body')) }
950 -- Just like wrapGenSym, but don't actually do the gensym
951 -- Instead use the existing name:
952 -- let x = "x" in ...
953 -- Only used for [Decl], and for the class ops in class
954 -- and instance decls
955 wrapNongenSyms :: [GenSymBind] -> Core a -> DsM (Core a)
956 wrapNongenSyms binds (MkC body)
957 = do { binds' <- mapM do_one binds ;
958 return (MkC (mkLets binds' body)) }
961 = do { MkC lit_str <- occNameLit name
962 ; MkC var <- rep2 mkNameName [lit_str]
963 ; return (NonRec id var) }
965 occNameLit :: Name -> DsM (Core String)
966 occNameLit n = coreStringLit (occNameUserString (nameOccName n))
969 -- %*********************************************************************
973 -- %*********************************************************************
975 -----------------------------------------------------------------------------
976 -- PHANTOM TYPES for consistency. In order to make sure we do this correct
977 -- we invent a new datatype which uses phantom types.
979 newtype Core a = MkC CoreExpr
982 rep2 :: Name -> [ CoreExpr ] -> DsM (Core a)
983 rep2 n xs = do { id <- dsLookupGlobalId n
984 ; return (MkC (foldl App (Var id) xs)) }
986 -- Then we make "repConstructors" which use the phantom types for each of the
987 -- smart constructors of the Meta.Meta datatypes.
990 -- %*********************************************************************
992 -- The 'smart constructors'
994 -- %*********************************************************************
996 --------------- Patterns -----------------
997 repPlit :: Core TH.Lit -> DsM (Core TH.PatQ)
998 repPlit (MkC l) = rep2 litPName [l]
1000 repPvar :: Core TH.Name -> DsM (Core TH.PatQ)
1001 repPvar (MkC s) = rep2 varPName [s]
1003 repPtup :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
1004 repPtup (MkC ps) = rep2 tupPName [ps]
1006 repPcon :: Core TH.Name -> Core [TH.PatQ] -> DsM (Core TH.PatQ)
1007 repPcon (MkC s) (MkC ps) = rep2 conPName [s, ps]
1009 repPrec :: Core TH.Name -> Core [(TH.Name,TH.PatQ)] -> DsM (Core TH.PatQ)
1010 repPrec (MkC c) (MkC rps) = rep2 recPName [c,rps]
1012 repPinfix :: Core TH.PatQ -> Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
1013 repPinfix (MkC p1) (MkC n) (MkC p2) = rep2 infixPName [p1, n, p2]
1015 repPtilde :: Core TH.PatQ -> DsM (Core TH.PatQ)
1016 repPtilde (MkC p) = rep2 tildePName [p]
1018 repPaspat :: Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
1019 repPaspat (MkC s) (MkC p) = rep2 asPName [s, p]
1021 repPwild :: DsM (Core TH.PatQ)
1022 repPwild = rep2 wildPName []
1024 repPlist :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
1025 repPlist (MkC ps) = rep2 listPName [ps]
1027 repPsig :: Core TH.PatQ -> Core TH.TypeQ -> DsM (Core TH.PatQ)
1028 repPsig (MkC p) (MkC t) = rep2 sigPName [p, t]
1030 --------------- Expressions -----------------
1031 repVarOrCon :: Name -> Core TH.Name -> DsM (Core TH.ExpQ)
1032 repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
1033 | otherwise = repVar str
1035 repVar :: Core TH.Name -> DsM (Core TH.ExpQ)
1036 repVar (MkC s) = rep2 varEName [s]
1038 repCon :: Core TH.Name -> DsM (Core TH.ExpQ)
1039 repCon (MkC s) = rep2 conEName [s]
1041 repLit :: Core TH.Lit -> DsM (Core TH.ExpQ)
1042 repLit (MkC c) = rep2 litEName [c]
1044 repApp :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1045 repApp (MkC x) (MkC y) = rep2 appEName [x,y]
1047 repLam :: Core [TH.PatQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1048 repLam (MkC ps) (MkC e) = rep2 lamEName [ps, e]
1050 repTup :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
1051 repTup (MkC es) = rep2 tupEName [es]
1053 repCond :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1054 repCond (MkC x) (MkC y) (MkC z) = rep2 condEName [x,y,z]
1056 repLetE :: Core [TH.DecQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1057 repLetE (MkC ds) (MkC e) = rep2 letEName [ds, e]
1059 repCaseE :: Core TH.ExpQ -> Core [TH.MatchQ] -> DsM( Core TH.ExpQ)
1060 repCaseE (MkC e) (MkC ms) = rep2 caseEName [e, ms]
1062 repDoE :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
1063 repDoE (MkC ss) = rep2 doEName [ss]
1065 repComp :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
1066 repComp (MkC ss) = rep2 compEName [ss]
1068 repListExp :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
1069 repListExp (MkC es) = rep2 listEName [es]
1071 repSigExp :: Core TH.ExpQ -> Core TH.TypeQ -> DsM (Core TH.ExpQ)
1072 repSigExp (MkC e) (MkC t) = rep2 sigEName [e,t]
1074 repRecCon :: Core TH.Name -> Core [TH.Q TH.FieldExp]-> DsM (Core TH.ExpQ)
1075 repRecCon (MkC c) (MkC fs) = rep2 recConEName [c,fs]
1077 repRecUpd :: Core TH.ExpQ -> Core [TH.Q TH.FieldExp] -> DsM (Core TH.ExpQ)
1078 repRecUpd (MkC e) (MkC fs) = rep2 recUpdEName [e,fs]
1080 repFieldExp :: Core TH.Name -> Core TH.ExpQ -> DsM (Core (TH.Q TH.FieldExp))
1081 repFieldExp (MkC n) (MkC x) = rep2 fieldExpName [n,x]
1083 repInfixApp :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1084 repInfixApp (MkC x) (MkC y) (MkC z) = rep2 infixAppName [x,y,z]
1086 repSectionL :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1087 repSectionL (MkC x) (MkC y) = rep2 sectionLName [x,y]
1089 repSectionR :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1090 repSectionR (MkC x) (MkC y) = rep2 sectionRName [x,y]
1092 ------------ Right hand sides (guarded expressions) ----
1093 repGuarded :: Core [TH.Q (TH.Guard, TH.Exp)] -> DsM (Core TH.BodyQ)
1094 repGuarded (MkC pairs) = rep2 guardedBName [pairs]
1096 repNormal :: Core TH.ExpQ -> DsM (Core TH.BodyQ)
1097 repNormal (MkC e) = rep2 normalBName [e]
1099 ------------ Guards ----
1100 repLNormalGE :: LHsExpr Name -> LHsExpr Name -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1101 repLNormalGE g e = do g' <- repLE g
1105 repNormalGE :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1106 repNormalGE (MkC g) (MkC e) = rep2 normalGEName [g, e]
1108 repPatGE :: Core [TH.StmtQ] -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1109 repPatGE (MkC ss) (MkC e) = rep2 patGEName [ss, e]
1111 ------------- Stmts -------------------
1112 repBindSt :: Core TH.PatQ -> Core TH.ExpQ -> DsM (Core TH.StmtQ)
1113 repBindSt (MkC p) (MkC e) = rep2 bindSName [p,e]
1115 repLetSt :: Core [TH.DecQ] -> DsM (Core TH.StmtQ)
1116 repLetSt (MkC ds) = rep2 letSName [ds]
1118 repNoBindSt :: Core TH.ExpQ -> DsM (Core TH.StmtQ)
1119 repNoBindSt (MkC e) = rep2 noBindSName [e]
1121 -------------- Range (Arithmetic sequences) -----------
1122 repFrom :: Core TH.ExpQ -> DsM (Core TH.ExpQ)
1123 repFrom (MkC x) = rep2 fromEName [x]
1125 repFromThen :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1126 repFromThen (MkC x) (MkC y) = rep2 fromThenEName [x,y]
1128 repFromTo :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1129 repFromTo (MkC x) (MkC y) = rep2 fromToEName [x,y]
1131 repFromThenTo :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1132 repFromThenTo (MkC x) (MkC y) (MkC z) = rep2 fromThenToEName [x,y,z]
1134 ------------ Match and Clause Tuples -----------
1135 repMatch :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.MatchQ)
1136 repMatch (MkC p) (MkC bod) (MkC ds) = rep2 matchName [p, bod, ds]
1138 repClause :: Core [TH.PatQ] -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.ClauseQ)
1139 repClause (MkC ps) (MkC bod) (MkC ds) = rep2 clauseName [ps, bod, ds]
1141 -------------- Dec -----------------------------
1142 repVal :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1143 repVal (MkC p) (MkC b) (MkC ds) = rep2 valDName [p, b, ds]
1145 repFun :: Core TH.Name -> Core [TH.ClauseQ] -> DsM (Core TH.DecQ)
1146 repFun (MkC nm) (MkC b) = rep2 funDName [nm, b]
1148 repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core [TH.ConQ] -> Core [TH.Name] -> DsM (Core TH.DecQ)
1149 repData (MkC cxt) (MkC nm) (MkC tvs) (MkC cons) (MkC derivs)
1150 = rep2 dataDName [cxt, nm, tvs, cons, derivs]
1152 repNewtype :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core TH.ConQ -> Core [TH.Name] -> DsM (Core TH.DecQ)
1153 repNewtype (MkC cxt) (MkC nm) (MkC tvs) (MkC con) (MkC derivs)
1154 = rep2 newtypeDName [cxt, nm, tvs, con, derivs]
1156 repTySyn :: Core TH.Name -> Core [TH.Name] -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1157 repTySyn (MkC nm) (MkC tvs) (MkC rhs) = rep2 tySynDName [nm, tvs, rhs]
1159 repInst :: Core TH.CxtQ -> Core TH.TypeQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1160 repInst (MkC cxt) (MkC ty) (MkC ds) = rep2 instanceDName [cxt, ty, ds]
1162 repClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core [TH.FunDep] -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1163 repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds) = rep2 classDName [cxt, cls, tvs, fds, ds]
1165 repFunDep :: Core [TH.Name] -> Core [TH.Name] -> DsM (Core TH.FunDep)
1166 repFunDep (MkC xs) (MkC ys) = rep2 funDepName [xs, ys]
1168 repProto :: Core TH.Name -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1169 repProto (MkC s) (MkC ty) = rep2 sigDName [s, ty]
1171 repCtxt :: Core [TH.TypeQ] -> DsM (Core TH.CxtQ)
1172 repCtxt (MkC tys) = rep2 cxtName [tys]
1174 repConstr :: Core TH.Name -> HsConDetails Name (LBangType Name)
1175 -> DsM (Core TH.ConQ)
1176 repConstr con (PrefixCon ps)
1177 = do arg_tys <- mapM repBangTy ps
1178 arg_tys1 <- coreList strictTypeQTyConName arg_tys
1179 rep2 normalCName [unC con, unC arg_tys1]
1180 repConstr con (RecCon ips)
1181 = do arg_vs <- mapM lookupLOcc (map fst ips)
1182 arg_tys <- mapM repBangTy (map snd ips)
1183 arg_vtys <- zipWithM (\x y -> rep2 varStrictTypeName [unC x, unC y])
1185 arg_vtys' <- coreList varStrictTypeQTyConName arg_vtys
1186 rep2 recCName [unC con, unC arg_vtys']
1187 repConstr con (InfixCon st1 st2)
1188 = do arg1 <- repBangTy st1
1189 arg2 <- repBangTy st2
1190 rep2 infixCName [unC arg1, unC con, unC arg2]
1192 ------------ Types -------------------
1194 repTForall :: Core [TH.Name] -> Core TH.CxtQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)
1195 repTForall (MkC tvars) (MkC ctxt) (MkC ty)
1196 = rep2 forallTName [tvars, ctxt, ty]
1198 repTvar :: Core TH.Name -> DsM (Core TH.TypeQ)
1199 repTvar (MkC s) = rep2 varTName [s]
1201 repTapp :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)
1202 repTapp (MkC t1) (MkC t2) = rep2 appTName [t1,t2]
1204 repTapps :: Core TH.TypeQ -> [Core TH.TypeQ] -> DsM (Core TH.TypeQ)
1205 repTapps f [] = return f
1206 repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
1208 --------- Type constructors --------------
1210 repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
1211 repNamedTyCon (MkC s) = rep2 conTName [s]
1213 repTupleTyCon :: Int -> DsM (Core TH.TypeQ)
1214 -- Note: not Core Int; it's easier to be direct here
1215 repTupleTyCon i = rep2 tupleTName [mkIntExpr (fromIntegral i)]
1217 repArrowTyCon :: DsM (Core TH.TypeQ)
1218 repArrowTyCon = rep2 arrowTName []
1220 repListTyCon :: DsM (Core TH.TypeQ)
1221 repListTyCon = rep2 listTName []
1224 ----------------------------------------------------------
1227 repLiteral :: HsLit -> DsM (Core TH.Lit)
1229 = do lit' <- case lit of
1230 HsIntPrim i -> mk_integer i
1231 HsInt i -> mk_integer i
1232 HsFloatPrim r -> mk_rational r
1233 HsDoublePrim r -> mk_rational r
1235 lit_expr <- dsLit lit'
1236 rep2 lit_name [lit_expr]
1238 lit_name = case lit of
1239 HsInteger _ _ -> integerLName
1240 HsInt _ -> integerLName
1241 HsIntPrim _ -> intPrimLName
1242 HsFloatPrim _ -> floatPrimLName
1243 HsDoublePrim _ -> doublePrimLName
1244 HsChar _ -> charLName
1245 HsString _ -> stringLName
1246 HsRat _ _ -> rationalLName
1248 uh_oh = pprPanic "DsMeta.repLiteral: trying to represent exotic literal"
1251 mk_integer i = do integer_ty <- lookupType integerTyConName
1252 return $ HsInteger i integer_ty
1253 mk_rational r = do rat_ty <- lookupType rationalTyConName
1254 return $ HsRat r rat_ty
1256 repOverloadedLiteral :: HsOverLit Name -> DsM (Core TH.Lit)
1257 repOverloadedLiteral (HsIntegral i _) = do { lit <- mk_integer i; repLiteral lit }
1258 repOverloadedLiteral (HsFractional f _) = do { lit <- mk_rational f; repLiteral lit }
1259 -- The type Rational will be in the environment, becuase
1260 -- the smart constructor 'TH.Syntax.rationalL' uses it in its type,
1261 -- and rationalL is sucked in when any TH stuff is used
1263 --------------- Miscellaneous -------------------
1265 repGensym :: Core String -> DsM (Core (TH.Q TH.Name))
1266 repGensym (MkC lit_str) = rep2 newNameName [lit_str]
1268 repBindQ :: Type -> Type -- a and b
1269 -> Core (TH.Q a) -> Core (a -> TH.Q b) -> DsM (Core (TH.Q b))
1270 repBindQ ty_a ty_b (MkC x) (MkC y)
1271 = rep2 bindQName [Type ty_a, Type ty_b, x, y]
1273 repSequenceQ :: Type -> Core [TH.Q a] -> DsM (Core (TH.Q [a]))
1274 repSequenceQ ty_a (MkC list)
1275 = rep2 sequenceQName [Type ty_a, list]
1277 ------------ Lists and Tuples -------------------
1278 -- turn a list of patterns into a single pattern matching a list
1280 coreList :: Name -- Of the TyCon of the element type
1281 -> [Core a] -> DsM (Core [a])
1283 = do { elt_ty <- lookupType tc_name; return (coreList' elt_ty es) }
1285 coreList' :: Type -- The element type
1286 -> [Core a] -> Core [a]
1287 coreList' elt_ty es = MkC (mkListExpr elt_ty (map unC es ))
1289 nonEmptyCoreList :: [Core a] -> Core [a]
1290 -- The list must be non-empty so we can get the element type
1291 -- Otherwise use coreList
1292 nonEmptyCoreList [] = panic "coreList: empty argument"
1293 nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs))
1295 corePair :: (Core a, Core b) -> Core (a,b)
1296 corePair (MkC x, MkC y) = MkC (mkCoreTup [x,y])
1298 coreStringLit :: String -> DsM (Core String)
1299 coreStringLit s = do { z <- mkStringExpr s; return(MkC z) }
1301 coreIntLit :: Int -> DsM (Core Int)
1302 coreIntLit i = return (MkC (mkIntExpr (fromIntegral i)))
1304 coreVar :: Id -> Core TH.Name -- The Id has type Name
1305 coreVar id = MkC (Var id)
1309 -- %************************************************************************
1311 -- The known-key names for Template Haskell
1313 -- %************************************************************************
1315 -- To add a name, do three things
1317 -- 1) Allocate a key
1319 -- 3) Add the name to knownKeyNames
1321 templateHaskellNames :: [Name]
1322 -- The names that are implicitly mentioned by ``bracket''
1323 -- Should stay in sync with the import list of DsMeta
1325 templateHaskellNames = [
1326 returnQName, bindQName, sequenceQName, newNameName, liftName,
1327 mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
1330 charLName, stringLName, integerLName, intPrimLName,
1331 floatPrimLName, doublePrimLName, rationalLName,
1333 litPName, varPName, tupPName, conPName, tildePName, infixPName,
1334 asPName, wildPName, recPName, listPName, sigPName,
1342 varEName, conEName, litEName, appEName, infixEName,
1343 infixAppName, sectionLName, sectionRName, lamEName, tupEName,
1344 condEName, letEName, caseEName, doEName, compEName,
1345 fromEName, fromThenEName, fromToEName, fromThenToEName,
1346 listEName, sigEName, recConEName, recUpdEName,
1350 guardedBName, normalBName,
1352 normalGEName, patGEName,
1354 bindSName, letSName, noBindSName, parSName,
1356 funDName, valDName, dataDName, newtypeDName, tySynDName,
1357 classDName, instanceDName, sigDName, forImpDName,
1361 isStrictName, notStrictName,
1363 normalCName, recCName, infixCName, forallCName,
1369 forallTName, varTName, conTName, appTName,
1370 tupleTName, arrowTName, listTName,
1372 cCallName, stdCallName,
1381 qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchQTyConName,
1382 clauseQTyConName, expQTyConName, fieldExpTyConName, stmtQTyConName,
1383 decQTyConName, conQTyConName, strictTypeQTyConName,
1384 varStrictTypeQTyConName, typeQTyConName, expTyConName, decTyConName,
1385 typeTyConName, matchTyConName, clauseTyConName, patQTyConName,
1386 fieldPatQTyConName, fieldExpQTyConName, funDepTyConName]
1389 thSyn = mkModule "Language.Haskell.TH.Syntax"
1390 thLib = mkModule "Language.Haskell.TH.Lib"
1392 mk_known_key_name mod space str uniq
1393 = mkExternalName uniq mod (mkOccFS space str)
1396 libFun = mk_known_key_name thLib OccName.varName
1397 libTc = mk_known_key_name thLib OccName.tcName
1398 thFun = mk_known_key_name thSyn OccName.varName
1399 thTc = mk_known_key_name thSyn OccName.tcName
1401 -------------------- TH.Syntax -----------------------
1402 qTyConName = thTc FSLIT("Q") qTyConKey
1403 nameTyConName = thTc FSLIT("Name") nameTyConKey
1404 fieldExpTyConName = thTc FSLIT("FieldExp") fieldExpTyConKey
1405 patTyConName = thTc FSLIT("Pat") patTyConKey
1406 fieldPatTyConName = thTc FSLIT("FieldPat") fieldPatTyConKey
1407 expTyConName = thTc FSLIT("Exp") expTyConKey
1408 decTyConName = thTc FSLIT("Dec") decTyConKey
1409 typeTyConName = thTc FSLIT("Type") typeTyConKey
1410 matchTyConName = thTc FSLIT("Match") matchTyConKey
1411 clauseTyConName = thTc FSLIT("Clause") clauseTyConKey
1412 funDepTyConName = thTc FSLIT("FunDep") funDepTyConKey
1414 returnQName = thFun FSLIT("returnQ") returnQIdKey
1415 bindQName = thFun FSLIT("bindQ") bindQIdKey
1416 sequenceQName = thFun FSLIT("sequenceQ") sequenceQIdKey
1417 newNameName = thFun FSLIT("newName") newNameIdKey
1418 liftName = thFun FSLIT("lift") liftIdKey
1419 mkNameName = thFun FSLIT("mkName") mkNameIdKey
1420 mkNameG_vName = thFun FSLIT("mkNameG_v") mkNameG_vIdKey
1421 mkNameG_dName = thFun FSLIT("mkNameG_d") mkNameG_dIdKey
1422 mkNameG_tcName = thFun FSLIT("mkNameG_tc") mkNameG_tcIdKey
1423 mkNameLName = thFun FSLIT("mkNameL") mkNameLIdKey
1426 -------------------- TH.Lib -----------------------
1428 charLName = libFun FSLIT("charL") charLIdKey
1429 stringLName = libFun FSLIT("stringL") stringLIdKey
1430 integerLName = libFun FSLIT("integerL") integerLIdKey
1431 intPrimLName = libFun FSLIT("intPrimL") intPrimLIdKey
1432 floatPrimLName = libFun FSLIT("floatPrimL") floatPrimLIdKey
1433 doublePrimLName = libFun FSLIT("doublePrimL") doublePrimLIdKey
1434 rationalLName = libFun FSLIT("rationalL") rationalLIdKey
1437 litPName = libFun FSLIT("litP") litPIdKey
1438 varPName = libFun FSLIT("varP") varPIdKey
1439 tupPName = libFun FSLIT("tupP") tupPIdKey
1440 conPName = libFun FSLIT("conP") conPIdKey
1441 infixPName = libFun FSLIT("infixP") infixPIdKey
1442 tildePName = libFun FSLIT("tildeP") tildePIdKey
1443 asPName = libFun FSLIT("asP") asPIdKey
1444 wildPName = libFun FSLIT("wildP") wildPIdKey
1445 recPName = libFun FSLIT("recP") recPIdKey
1446 listPName = libFun FSLIT("listP") listPIdKey
1447 sigPName = libFun FSLIT("sigP") sigPIdKey
1449 -- type FieldPat = ...
1450 fieldPatName = libFun FSLIT("fieldPat") fieldPatIdKey
1453 matchName = libFun FSLIT("match") matchIdKey
1455 -- data Clause = ...
1456 clauseName = libFun FSLIT("clause") clauseIdKey
1459 varEName = libFun FSLIT("varE") varEIdKey
1460 conEName = libFun FSLIT("conE") conEIdKey
1461 litEName = libFun FSLIT("litE") litEIdKey
1462 appEName = libFun FSLIT("appE") appEIdKey
1463 infixEName = libFun FSLIT("infixE") infixEIdKey
1464 infixAppName = libFun FSLIT("infixApp") infixAppIdKey
1465 sectionLName = libFun FSLIT("sectionL") sectionLIdKey
1466 sectionRName = libFun FSLIT("sectionR") sectionRIdKey
1467 lamEName = libFun FSLIT("lamE") lamEIdKey
1468 tupEName = libFun FSLIT("tupE") tupEIdKey
1469 condEName = libFun FSLIT("condE") condEIdKey
1470 letEName = libFun FSLIT("letE") letEIdKey
1471 caseEName = libFun FSLIT("caseE") caseEIdKey
1472 doEName = libFun FSLIT("doE") doEIdKey
1473 compEName = libFun FSLIT("compE") compEIdKey
1474 -- ArithSeq skips a level
1475 fromEName = libFun FSLIT("fromE") fromEIdKey
1476 fromThenEName = libFun FSLIT("fromThenE") fromThenEIdKey
1477 fromToEName = libFun FSLIT("fromToE") fromToEIdKey
1478 fromThenToEName = libFun FSLIT("fromThenToE") fromThenToEIdKey
1480 listEName = libFun FSLIT("listE") listEIdKey
1481 sigEName = libFun FSLIT("sigE") sigEIdKey
1482 recConEName = libFun FSLIT("recConE") recConEIdKey
1483 recUpdEName = libFun FSLIT("recUpdE") recUpdEIdKey
1485 -- type FieldExp = ...
1486 fieldExpName = libFun FSLIT("fieldExp") fieldExpIdKey
1489 guardedBName = libFun FSLIT("guardedB") guardedBIdKey
1490 normalBName = libFun FSLIT("normalB") normalBIdKey
1493 normalGEName = libFun FSLIT("normalGE") normalGEIdKey
1494 patGEName = libFun FSLIT("patGE") patGEIdKey
1497 bindSName = libFun FSLIT("bindS") bindSIdKey
1498 letSName = libFun FSLIT("letS") letSIdKey
1499 noBindSName = libFun FSLIT("noBindS") noBindSIdKey
1500 parSName = libFun FSLIT("parS") parSIdKey
1503 funDName = libFun FSLIT("funD") funDIdKey
1504 valDName = libFun FSLIT("valD") valDIdKey
1505 dataDName = libFun FSLIT("dataD") dataDIdKey
1506 newtypeDName = libFun FSLIT("newtypeD") newtypeDIdKey
1507 tySynDName = libFun FSLIT("tySynD") tySynDIdKey
1508 classDName = libFun FSLIT("classD") classDIdKey
1509 instanceDName = libFun FSLIT("instanceD") instanceDIdKey
1510 sigDName = libFun FSLIT("sigD") sigDIdKey
1511 forImpDName = libFun FSLIT("forImpD") forImpDIdKey
1514 cxtName = libFun FSLIT("cxt") cxtIdKey
1516 -- data Strict = ...
1517 isStrictName = libFun FSLIT("isStrict") isStrictKey
1518 notStrictName = libFun FSLIT("notStrict") notStrictKey
1521 normalCName = libFun FSLIT("normalC") normalCIdKey
1522 recCName = libFun FSLIT("recC") recCIdKey
1523 infixCName = libFun FSLIT("infixC") infixCIdKey
1524 forallCName = libFun FSLIT("forallC") forallCIdKey
1526 -- type StrictType = ...
1527 strictTypeName = libFun FSLIT("strictType") strictTKey
1529 -- type VarStrictType = ...
1530 varStrictTypeName = libFun FSLIT("varStrictType") varStrictTKey
1533 forallTName = libFun FSLIT("forallT") forallTIdKey
1534 varTName = libFun FSLIT("varT") varTIdKey
1535 conTName = libFun FSLIT("conT") conTIdKey
1536 tupleTName = libFun FSLIT("tupleT") tupleTIdKey
1537 arrowTName = libFun FSLIT("arrowT") arrowTIdKey
1538 listTName = libFun FSLIT("listT") listTIdKey
1539 appTName = libFun FSLIT("appT") appTIdKey
1541 -- data Callconv = ...
1542 cCallName = libFun FSLIT("cCall") cCallIdKey
1543 stdCallName = libFun FSLIT("stdCall") stdCallIdKey
1545 -- data Safety = ...
1546 unsafeName = libFun FSLIT("unsafe") unsafeIdKey
1547 safeName = libFun FSLIT("safe") safeIdKey
1548 threadsafeName = libFun FSLIT("threadsafe") threadsafeIdKey
1550 -- data FunDep = ...
1551 funDepName = libFun FSLIT("funDep") funDepIdKey
1553 matchQTyConName = libTc FSLIT("MatchQ") matchQTyConKey
1554 clauseQTyConName = libTc FSLIT("ClauseQ") clauseQTyConKey
1555 expQTyConName = libTc FSLIT("ExpQ") expQTyConKey
1556 stmtQTyConName = libTc FSLIT("StmtQ") stmtQTyConKey
1557 decQTyConName = libTc FSLIT("DecQ") decQTyConKey
1558 conQTyConName = libTc FSLIT("ConQ") conQTyConKey
1559 strictTypeQTyConName = libTc FSLIT("StrictTypeQ") strictTypeQTyConKey
1560 varStrictTypeQTyConName = libTc FSLIT("VarStrictTypeQ") varStrictTypeQTyConKey
1561 typeQTyConName = libTc FSLIT("TypeQ") typeQTyConKey
1562 fieldExpQTyConName = libTc FSLIT("FieldExpQ") fieldExpQTyConKey
1563 patQTyConName = libTc FSLIT("PatQ") patQTyConKey
1564 fieldPatQTyConName = libTc FSLIT("FieldPatQ") fieldPatQTyConKey
1566 -- TyConUniques available: 100-129
1567 -- Check in PrelNames if you want to change this
1569 expTyConKey = mkPreludeTyConUnique 100
1570 matchTyConKey = mkPreludeTyConUnique 101
1571 clauseTyConKey = mkPreludeTyConUnique 102
1572 qTyConKey = mkPreludeTyConUnique 103
1573 expQTyConKey = mkPreludeTyConUnique 104
1574 decQTyConKey = mkPreludeTyConUnique 105
1575 patTyConKey = mkPreludeTyConUnique 106
1576 matchQTyConKey = mkPreludeTyConUnique 107
1577 clauseQTyConKey = mkPreludeTyConUnique 108
1578 stmtQTyConKey = mkPreludeTyConUnique 109
1579 conQTyConKey = mkPreludeTyConUnique 110
1580 typeQTyConKey = mkPreludeTyConUnique 111
1581 typeTyConKey = mkPreludeTyConUnique 112
1582 decTyConKey = mkPreludeTyConUnique 113
1583 varStrictTypeQTyConKey = mkPreludeTyConUnique 114
1584 strictTypeQTyConKey = mkPreludeTyConUnique 115
1585 fieldExpTyConKey = mkPreludeTyConUnique 116
1586 fieldPatTyConKey = mkPreludeTyConUnique 117
1587 nameTyConKey = mkPreludeTyConUnique 118
1588 patQTyConKey = mkPreludeTyConUnique 119
1589 fieldPatQTyConKey = mkPreludeTyConUnique 120
1590 fieldExpQTyConKey = mkPreludeTyConUnique 121
1591 funDepTyConKey = mkPreludeTyConUnique 122
1593 -- IdUniques available: 200-399
1594 -- If you want to change this, make sure you check in PrelNames
1596 returnQIdKey = mkPreludeMiscIdUnique 200
1597 bindQIdKey = mkPreludeMiscIdUnique 201
1598 sequenceQIdKey = mkPreludeMiscIdUnique 202
1599 liftIdKey = mkPreludeMiscIdUnique 203
1600 newNameIdKey = mkPreludeMiscIdUnique 204
1601 mkNameIdKey = mkPreludeMiscIdUnique 205
1602 mkNameG_vIdKey = mkPreludeMiscIdUnique 206
1603 mkNameG_dIdKey = mkPreludeMiscIdUnique 207
1604 mkNameG_tcIdKey = mkPreludeMiscIdUnique 208
1605 mkNameLIdKey = mkPreludeMiscIdUnique 209
1609 charLIdKey = mkPreludeMiscIdUnique 210
1610 stringLIdKey = mkPreludeMiscIdUnique 211
1611 integerLIdKey = mkPreludeMiscIdUnique 212
1612 intPrimLIdKey = mkPreludeMiscIdUnique 213
1613 floatPrimLIdKey = mkPreludeMiscIdUnique 214
1614 doublePrimLIdKey = mkPreludeMiscIdUnique 215
1615 rationalLIdKey = mkPreludeMiscIdUnique 216
1618 litPIdKey = mkPreludeMiscIdUnique 220
1619 varPIdKey = mkPreludeMiscIdUnique 221
1620 tupPIdKey = mkPreludeMiscIdUnique 222
1621 conPIdKey = mkPreludeMiscIdUnique 223
1622 infixPIdKey = mkPreludeMiscIdUnique 312
1623 tildePIdKey = mkPreludeMiscIdUnique 224
1624 asPIdKey = mkPreludeMiscIdUnique 225
1625 wildPIdKey = mkPreludeMiscIdUnique 226
1626 recPIdKey = mkPreludeMiscIdUnique 227
1627 listPIdKey = mkPreludeMiscIdUnique 228
1628 sigPIdKey = mkPreludeMiscIdUnique 229
1630 -- type FieldPat = ...
1631 fieldPatIdKey = mkPreludeMiscIdUnique 230
1634 matchIdKey = mkPreludeMiscIdUnique 231
1636 -- data Clause = ...
1637 clauseIdKey = mkPreludeMiscIdUnique 232
1640 varEIdKey = mkPreludeMiscIdUnique 240
1641 conEIdKey = mkPreludeMiscIdUnique 241
1642 litEIdKey = mkPreludeMiscIdUnique 242
1643 appEIdKey = mkPreludeMiscIdUnique 243
1644 infixEIdKey = mkPreludeMiscIdUnique 244
1645 infixAppIdKey = mkPreludeMiscIdUnique 245
1646 sectionLIdKey = mkPreludeMiscIdUnique 246
1647 sectionRIdKey = mkPreludeMiscIdUnique 247
1648 lamEIdKey = mkPreludeMiscIdUnique 248
1649 tupEIdKey = mkPreludeMiscIdUnique 249
1650 condEIdKey = mkPreludeMiscIdUnique 250
1651 letEIdKey = mkPreludeMiscIdUnique 251
1652 caseEIdKey = mkPreludeMiscIdUnique 252
1653 doEIdKey = mkPreludeMiscIdUnique 253
1654 compEIdKey = mkPreludeMiscIdUnique 254
1655 fromEIdKey = mkPreludeMiscIdUnique 255
1656 fromThenEIdKey = mkPreludeMiscIdUnique 256
1657 fromToEIdKey = mkPreludeMiscIdUnique 257
1658 fromThenToEIdKey = mkPreludeMiscIdUnique 258
1659 listEIdKey = mkPreludeMiscIdUnique 259
1660 sigEIdKey = mkPreludeMiscIdUnique 260
1661 recConEIdKey = mkPreludeMiscIdUnique 261
1662 recUpdEIdKey = mkPreludeMiscIdUnique 262
1664 -- type FieldExp = ...
1665 fieldExpIdKey = mkPreludeMiscIdUnique 265
1668 guardedBIdKey = mkPreludeMiscIdUnique 266
1669 normalBIdKey = mkPreludeMiscIdUnique 267
1672 normalGEIdKey = mkPreludeMiscIdUnique 310
1673 patGEIdKey = mkPreludeMiscIdUnique 311
1676 bindSIdKey = mkPreludeMiscIdUnique 268
1677 letSIdKey = mkPreludeMiscIdUnique 269
1678 noBindSIdKey = mkPreludeMiscIdUnique 270
1679 parSIdKey = mkPreludeMiscIdUnique 271
1682 funDIdKey = mkPreludeMiscIdUnique 272
1683 valDIdKey = mkPreludeMiscIdUnique 273
1684 dataDIdKey = mkPreludeMiscIdUnique 274
1685 newtypeDIdKey = mkPreludeMiscIdUnique 275
1686 tySynDIdKey = mkPreludeMiscIdUnique 276
1687 classDIdKey = mkPreludeMiscIdUnique 277
1688 instanceDIdKey = mkPreludeMiscIdUnique 278
1689 sigDIdKey = mkPreludeMiscIdUnique 279
1690 forImpDIdKey = mkPreludeMiscIdUnique 297
1693 cxtIdKey = mkPreludeMiscIdUnique 280
1695 -- data Strict = ...
1696 isStrictKey = mkPreludeMiscIdUnique 281
1697 notStrictKey = mkPreludeMiscIdUnique 282
1700 normalCIdKey = mkPreludeMiscIdUnique 283
1701 recCIdKey = mkPreludeMiscIdUnique 284
1702 infixCIdKey = mkPreludeMiscIdUnique 285
1703 forallCIdKey = mkPreludeMiscIdUnique 288
1705 -- type StrictType = ...
1706 strictTKey = mkPreludeMiscIdUnique 286
1708 -- type VarStrictType = ...
1709 varStrictTKey = mkPreludeMiscIdUnique 287
1712 forallTIdKey = mkPreludeMiscIdUnique 290
1713 varTIdKey = mkPreludeMiscIdUnique 291
1714 conTIdKey = mkPreludeMiscIdUnique 292
1715 tupleTIdKey = mkPreludeMiscIdUnique 294
1716 arrowTIdKey = mkPreludeMiscIdUnique 295
1717 listTIdKey = mkPreludeMiscIdUnique 296
1718 appTIdKey = mkPreludeMiscIdUnique 293
1720 -- data Callconv = ...
1721 cCallIdKey = mkPreludeMiscIdUnique 300
1722 stdCallIdKey = mkPreludeMiscIdUnique 301
1724 -- data Safety = ...
1725 unsafeIdKey = mkPreludeMiscIdUnique 305
1726 safeIdKey = mkPreludeMiscIdUnique 306
1727 threadsafeIdKey = mkPreludeMiscIdUnique 307
1729 -- data FunDep = ...
1730 funDepIdKey = mkPreludeMiscIdUnique 320