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, mkIntExpr )
28 import qualified Language.Haskell.TH as TH
32 import PrelNames ( rationalTyConName, integerTyConName, negateName )
33 import OccName ( isDataOcc, isTvOcc, occNameString )
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, moduleNameString, moduleName,
41 modulePackageId, mkModuleNameFS )
42 import Id ( Id, mkLocalId )
43 import OccName ( mkOccNameFS )
44 import Name ( Name, mkExternalName, localiseName, nameOccName, nameModule,
45 isExternalName, getSrcLoc )
47 import Type ( Type, mkTyConApp )
48 import TcType ( tcTyConAppArgs )
49 import TyCon ( tyConName )
50 import TysWiredIn ( parrTyCon )
52 import CoreUtils ( exprType )
53 import SrcLoc ( noSrcLoc, unLoc, Located(..), SrcSpan, srcLocSpan )
54 import PackageConfig ( thPackageId, packageIdString )
55 import Unique ( mkPreludeTyConUnique, mkPreludeMiscIdUnique, getKey, Uniquable(..) )
56 import BasicTypes ( isBoxed )
58 import Bag ( bagToList, unionManyBags )
59 import FastString ( unpackFS )
60 import ForeignCall ( Safety(..), CCallConv(..), CCallTarget(..) )
62 import Maybe ( catMaybes )
63 import Monad ( zipWithM )
64 import List ( sortBy )
66 -----------------------------------------------------------------------------
67 dsBracket :: HsBracket Name -> [PendingSplice] -> DsM CoreExpr
68 -- Returns a CoreExpr of type TH.ExpQ
69 -- The quoted thing is parameterised over Name, even though it has
70 -- been type checked. We don't want all those type decorations!
72 dsBracket brack splices
73 = dsExtendMetaEnv new_bit (do_brack brack)
75 new_bit = mkNameEnv [(n, Splice (unLoc e)) | (n,e) <- splices]
77 do_brack (VarBr n) = do { MkC e1 <- lookupOcc n ; return e1 }
78 do_brack (ExpBr e) = do { MkC e1 <- repLE e ; return e1 }
79 do_brack (PatBr p) = do { MkC p1 <- repLP p ; return p1 }
80 do_brack (TypBr t) = do { MkC t1 <- repLTy t ; return t1 }
81 do_brack (DecBr ds) = do { MkC ds1 <- repTopDs ds ; return ds1 }
83 {- -------------- Examples --------------------
87 gensym (unpackString "x"#) `bindQ` \ x1::String ->
88 lam (pvar x1) (var x1)
91 [| \x -> $(f [| x |]) |]
93 gensym (unpackString "x"#) `bindQ` \ x1::String ->
94 lam (pvar x1) (f (var x1))
98 -------------------------------------------------------
100 -------------------------------------------------------
102 repTopDs :: HsGroup Name -> DsM (Core (TH.Q [TH.Dec]))
104 = do { let { bndrs = map unLoc (groupBinders group) } ;
105 ss <- mkGenSyms bndrs ;
107 -- Bind all the names mainly to avoid repeated use of explicit strings.
109 -- do { t :: String <- genSym "T" ;
110 -- return (Data t [] ...more t's... }
111 -- The other important reason is that the output must mention
112 -- only "T", not "Foo:T" where Foo is the current module
115 decls <- addBinds ss (do {
116 val_ds <- rep_val_binds (hs_valds group) ;
117 tycl_ds <- mapM repTyClD (hs_tyclds group) ;
118 inst_ds <- mapM repInstD' (hs_instds group) ;
119 for_ds <- mapM repForD (hs_fords group) ;
121 return (de_loc $ sort_by_loc $ val_ds ++ catMaybes tycl_ds ++ inst_ds ++ for_ds) }) ;
123 decl_ty <- lookupType decQTyConName ;
124 let { core_list = coreList' decl_ty decls } ;
126 dec_ty <- lookupType decTyConName ;
127 q_decs <- repSequenceQ dec_ty core_list ;
129 wrapNongenSyms ss q_decs
130 -- Do *not* gensym top-level binders
133 groupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
134 hs_fords = foreign_decls })
135 -- Collect the binders of a Group
136 = collectHsValBinders val_decls ++
137 [n | d <- tycl_decls, n <- tyClDeclNames (unLoc d)] ++
138 [n | L _ (ForeignImport n _ _) <- foreign_decls]
141 {- Note [Binders and occurrences]
142 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
143 When we desugar [d| data T = MkT |]
145 Data "T" [] [Con "MkT" []] []
147 Data "Foo:T" [] [Con "Foo:MkT" []] []
148 That is, the new data decl should fit into whatever new module it is
149 asked to fit in. We do *not* clone, though; no need for this:
156 then we must desugar to
157 foo = Data "Foo:T" [] [Con "Foo:MkT" []] []
159 So in repTopDs we bring the binders into scope with mkGenSyms and addBinds.
160 And we use lookupOcc, rather than lookupBinder
161 in repTyClD and repC.
165 repTyClD :: LTyClDecl Name -> DsM (Maybe (SrcSpan, Core TH.DecQ))
167 repTyClD (L loc (TyData { tcdND = DataType, tcdCtxt = cxt,
168 tcdLName = tc, tcdTyVars = tvs,
169 tcdCons = cons, tcdDerivs = mb_derivs }))
170 = do { tc1 <- lookupLOcc tc ; -- See note [Binders and occurrences]
171 dec <- addTyVarBinds tvs $ \bndrs -> do {
172 cxt1 <- repLContext cxt ;
173 cons1 <- mapM repC cons ;
174 cons2 <- coreList conQTyConName cons1 ;
175 derivs1 <- repDerivs mb_derivs ;
176 bndrs1 <- coreList nameTyConName bndrs ;
177 repData cxt1 tc1 bndrs1 cons2 derivs1 } ;
178 return $ Just (loc, dec) }
180 repTyClD (L loc (TyData { tcdND = NewType, tcdCtxt = cxt,
181 tcdLName = tc, tcdTyVars = tvs,
182 tcdCons = [con], tcdDerivs = mb_derivs }))
183 = do { tc1 <- lookupLOcc tc ; -- See note [Binders and occurrences]
184 dec <- addTyVarBinds tvs $ \bndrs -> do {
185 cxt1 <- repLContext cxt ;
187 derivs1 <- repDerivs mb_derivs ;
188 bndrs1 <- coreList nameTyConName bndrs ;
189 repNewtype cxt1 tc1 bndrs1 con1 derivs1 } ;
190 return $ Just (loc, dec) }
192 repTyClD (L loc (TySynonym { tcdLName = tc, tcdTyVars = tvs, tcdSynRhs = ty }))
193 = do { tc1 <- lookupLOcc tc ; -- See note [Binders and occurrences]
194 dec <- addTyVarBinds tvs $ \bndrs -> do {
196 bndrs1 <- coreList nameTyConName bndrs ;
197 repTySyn tc1 bndrs1 ty1 } ;
198 return (Just (loc, dec)) }
200 repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
203 tcdSigs = sigs, tcdMeths = meth_binds }))
204 = do { cls1 <- lookupLOcc cls ; -- See note [Binders and occurrences]
205 dec <- addTyVarBinds tvs $ \bndrs -> do {
206 cxt1 <- repLContext cxt ;
207 sigs1 <- rep_sigs sigs ;
208 binds1 <- rep_binds meth_binds ;
209 fds1 <- repLFunDeps fds;
210 decls1 <- coreList decQTyConName (sigs1 ++ binds1) ;
211 bndrs1 <- coreList nameTyConName bndrs ;
212 repClass cxt1 cls1 bndrs1 fds1 decls1 } ;
213 return $ Just (loc, dec) }
216 repTyClD (L loc d) = putSrcSpanDs loc $
217 do { dsWarn (hang ds_msg 4 (ppr d))
222 repLFunDeps :: [Located (FunDep Name)] -> DsM (Core [TH.FunDep])
223 repLFunDeps fds = do fds' <- mapM repLFunDep fds
224 fdList <- coreList funDepTyConName fds'
227 repLFunDep :: Located (FunDep Name) -> DsM (Core TH.FunDep)
228 repLFunDep (L _ (xs, ys)) = do xs' <- mapM lookupBinder xs
229 ys' <- mapM lookupBinder ys
230 xs_list <- coreList nameTyConName xs'
231 ys_list <- coreList nameTyConName ys'
232 repFunDep xs_list ys_list
234 repInstD' (L loc (InstDecl ty binds _)) -- Ignore user pragmas for now
235 = do { i <- addTyVarBinds tvs $ \tv_bndrs ->
236 -- We must bring the type variables into scope, so their occurrences
237 -- don't fail, even though the binders don't appear in the resulting
239 do { cxt1 <- repContext cxt
240 ; inst_ty1 <- repPred (HsClassP cls tys)
241 ; ss <- mkGenSyms (collectHsBindBinders binds)
242 ; binds1 <- addBinds ss (rep_binds binds)
243 ; decls1 <- coreList decQTyConName binds1
244 ; decls2 <- wrapNongenSyms ss decls1
245 -- wrapNonGenSyms: do not clone the class op names!
246 -- They must be called 'op' etc, not 'op34'
247 ; repInst cxt1 inst_ty1 decls2 }
251 (tvs, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
253 repForD :: Located (ForeignDecl Name) -> DsM (SrcSpan, Core TH.DecQ)
254 repForD (L loc (ForeignImport name typ (CImport cc s ch cn cis)))
255 = do MkC name' <- lookupLOcc name
256 MkC typ' <- repLTy typ
257 MkC cc' <- repCCallConv cc
258 MkC s' <- repSafety s
259 MkC str <- coreStringLit $ static
260 ++ unpackFS ch ++ " "
261 ++ unpackFS cn ++ " "
262 ++ conv_cimportspec cis
263 dec <- rep2 forImpDName [cc', s', str, name', typ']
266 conv_cimportspec (CLabel cls) = panic "repForD': CLabel Not handled"
267 conv_cimportspec (CFunction DynamicTarget) = "dynamic"
268 conv_cimportspec (CFunction (StaticTarget fs)) = unpackFS fs
269 conv_cimportspec CWrapper = "wrapper"
271 CFunction (StaticTarget _) -> "static "
274 repCCallConv :: CCallConv -> DsM (Core TH.Callconv)
275 repCCallConv CCallConv = rep2 cCallName []
276 repCCallConv StdCallConv = rep2 stdCallName []
278 repSafety :: Safety -> DsM (Core TH.Safety)
279 repSafety PlayRisky = rep2 unsafeName []
280 repSafety (PlaySafe False) = rep2 safeName []
281 repSafety (PlaySafe True) = rep2 threadsafeName []
283 ds_msg = ptext SLIT("Cannot desugar this Template Haskell declaration:")
285 -------------------------------------------------------
287 -------------------------------------------------------
289 repC :: LConDecl Name -> DsM (Core TH.ConQ)
290 repC (L loc (ConDecl con expl [] (L _ []) details ResTyH98))
291 = do { con1 <- lookupLOcc con ; -- See note [Binders and occurrences]
292 repConstr con1 details }
293 repC (L loc (ConDecl con expl tvs (L cloc ctxt) details ResTyH98))
294 = do { addTyVarBinds tvs $ \bndrs -> do {
295 c' <- repC (L loc (ConDecl con expl [] (L cloc []) details ResTyH98));
296 ctxt' <- repContext ctxt;
297 bndrs' <- coreList nameTyConName bndrs;
298 rep2 forallCName [unC bndrs', unC ctxt', unC c']
301 repC (L loc con_decl) -- GADTs
303 do { dsWarn (hang ds_msg 4 (ppr con_decl))
304 ; return (panic "DsMeta:repC") }
306 repBangTy :: LBangType Name -> DsM (Core (TH.StrictTypeQ))
310 rep2 strictTypeName [s, t]
312 (str, ty') = case ty of
313 L _ (HsBangTy _ ty) -> (isStrictName, ty)
314 other -> (notStrictName, ty)
316 -------------------------------------------------------
318 -------------------------------------------------------
320 repDerivs :: Maybe [LHsType Name] -> DsM (Core [TH.Name])
321 repDerivs Nothing = coreList nameTyConName []
322 repDerivs (Just ctxt)
323 = do { strs <- mapM rep_deriv ctxt ;
324 coreList nameTyConName strs }
326 rep_deriv :: LHsType Name -> DsM (Core TH.Name)
327 -- Deriving clauses must have the simple H98 form
328 rep_deriv (L _ (HsPredTy (HsClassP cls []))) = lookupOcc cls
329 rep_deriv other = panic "rep_deriv"
332 -------------------------------------------------------
333 -- Signatures in a class decl, or a group of bindings
334 -------------------------------------------------------
336 rep_sigs :: [LSig Name] -> DsM [Core TH.DecQ]
337 rep_sigs sigs = do locs_cores <- rep_sigs' sigs
338 return $ de_loc $ sort_by_loc locs_cores
340 rep_sigs' :: [LSig Name] -> DsM [(SrcSpan, Core TH.DecQ)]
341 -- We silently ignore ones we don't recognise
342 rep_sigs' sigs = do { sigs1 <- mapM rep_sig sigs ;
343 return (concat sigs1) }
345 rep_sig :: LSig Name -> DsM [(SrcSpan, Core TH.DecQ)]
347 -- Empty => Too hard, signature ignored
348 rep_sig (L loc (TypeSig nm ty)) = rep_proto nm ty loc
349 rep_sig other = return []
351 rep_proto :: Located Name -> LHsType Name -> SrcSpan -> DsM [(SrcSpan, Core TH.DecQ)]
352 rep_proto nm ty loc = do { nm1 <- lookupLOcc nm ;
354 sig <- repProto nm1 ty1 ;
355 return [(loc, sig)] }
358 -------------------------------------------------------
360 -------------------------------------------------------
362 -- gensym a list of type variables and enter them into the meta environment;
363 -- the computations passed as the second argument is executed in that extended
364 -- meta environment and gets the *new* names on Core-level as an argument
366 addTyVarBinds :: [LHsTyVarBndr Name] -- the binders to be added
367 -> ([Core TH.Name] -> DsM (Core (TH.Q a))) -- action in the ext env
368 -> DsM (Core (TH.Q a))
369 addTyVarBinds tvs m =
371 let names = map (hsTyVarName.unLoc) tvs
372 freshNames <- mkGenSyms names
373 term <- addBinds freshNames $ do
374 bndrs <- mapM lookupBinder names
376 wrapGenSyns freshNames term
378 -- represent a type context
380 repLContext :: LHsContext Name -> DsM (Core TH.CxtQ)
381 repLContext (L _ ctxt) = repContext ctxt
383 repContext :: HsContext Name -> DsM (Core TH.CxtQ)
385 preds <- mapM repLPred ctxt
386 predList <- coreList typeQTyConName preds
389 -- represent a type predicate
391 repLPred :: LHsPred Name -> DsM (Core TH.TypeQ)
392 repLPred (L _ p) = repPred p
394 repPred :: HsPred Name -> DsM (Core TH.TypeQ)
395 repPred (HsClassP cls tys) = do
396 tcon <- repTy (HsTyVar cls)
399 repPred (HsIParam _ _) =
400 panic "DsMeta.repTy: Can't represent predicates with implicit parameters"
402 -- yield the representation of a list of types
404 repLTys :: [LHsType Name] -> DsM [Core TH.TypeQ]
405 repLTys tys = mapM repLTy tys
409 repLTy :: LHsType Name -> DsM (Core TH.TypeQ)
410 repLTy (L _ ty) = repTy ty
412 repTy :: HsType Name -> DsM (Core TH.TypeQ)
413 repTy (HsForAllTy _ tvs ctxt ty) =
414 addTyVarBinds tvs $ \bndrs -> do
415 ctxt1 <- repLContext ctxt
417 bndrs1 <- coreList nameTyConName bndrs
418 repTForall bndrs1 ctxt1 ty1
421 | isTvOcc (nameOccName n) = do
422 tv1 <- lookupBinder n
427 repTy (HsAppTy f a) = do
431 repTy (HsFunTy f a) = do
434 tcon <- repArrowTyCon
435 repTapps tcon [f1, a1]
436 repTy (HsListTy t) = do
440 repTy (HsPArrTy t) = do
442 tcon <- repTy (HsTyVar (tyConName parrTyCon))
444 repTy (HsTupleTy tc tys) = do
446 tcon <- repTupleTyCon (length tys)
448 repTy (HsOpTy ty1 n ty2) = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1)
450 repTy (HsParTy t) = repLTy t
452 panic "DsMeta.repTy: Can't represent number types (for generics)"
453 repTy (HsPredTy pred) = repPred pred
454 repTy (HsKindSig ty kind) =
455 panic "DsMeta.repTy: Can't represent explicit kind signatures yet"
458 -----------------------------------------------------------------------------
460 -----------------------------------------------------------------------------
462 repLEs :: [LHsExpr Name] -> DsM (Core [TH.ExpQ])
463 repLEs es = do { es' <- mapM repLE es ;
464 coreList expQTyConName es' }
466 -- FIXME: some of these panics should be converted into proper error messages
467 -- unless we can make sure that constructs, which are plainly not
468 -- supported in TH already lead to error messages at an earlier stage
469 repLE :: LHsExpr Name -> DsM (Core TH.ExpQ)
470 repLE (L _ e) = repE e
472 repE :: HsExpr Name -> DsM (Core TH.ExpQ)
474 do { mb_val <- dsLookupMetaEnv x
476 Nothing -> do { str <- globalVar x
477 ; repVarOrCon x str }
478 Just (Bound y) -> repVarOrCon x (coreVar y)
479 Just (Splice e) -> do { e' <- dsExpr e
480 ; return (MkC e') } }
481 repE (HsIPVar x) = panic "DsMeta.repE: Can't represent implicit parameters"
483 -- Remember, we're desugaring renamer output here, so
484 -- HsOverlit can definitely occur
485 repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
486 repE (HsLit l) = do { a <- repLiteral l; repLit a }
487 repE (HsLam (MatchGroup [m] _)) = repLambda m
488 repE (HsApp x y) = do {a <- repLE x; b <- repLE y; repApp a b}
490 repE (OpApp e1 op fix e2) =
491 do { arg1 <- repLE e1;
494 repInfixApp arg1 the_op arg2 }
495 repE (NegApp x nm) = do
497 negateVar <- lookupOcc negateName >>= repVar
499 repE (HsPar x) = repLE x
500 repE (SectionL x y) = do { a <- repLE x; b <- repLE y; repSectionL a b }
501 repE (SectionR x y) = do { a <- repLE x; b <- repLE y; repSectionR a b }
502 repE (HsCase e (MatchGroup ms _)) = do { arg <- repLE e
503 ; ms2 <- mapM repMatchTup ms
504 ; repCaseE arg (nonEmptyCoreList ms2) }
505 repE (HsIf x y z) = do
510 repE (HsLet bs e) = do { (ss,ds) <- repBinds bs
511 ; e2 <- addBinds ss (repLE e)
514 -- FIXME: I haven't got the types here right yet
515 repE (HsDo DoExpr sts body ty)
516 = do { (ss,zs) <- repLSts sts;
517 body' <- addBinds ss $ repLE body;
518 ret <- repNoBindSt body';
519 e <- repDoE (nonEmptyCoreList (zs ++ [ret]));
521 repE (HsDo ListComp sts body ty)
522 = do { (ss,zs) <- repLSts sts;
523 body' <- addBinds ss $ repLE body;
524 ret <- repNoBindSt body';
525 e <- repComp (nonEmptyCoreList (zs ++ [ret]));
527 repE (HsDo _ _ _ _) = panic "DsMeta.repE: Can't represent mdo and [: :] yet"
528 repE (ExplicitList ty es) = do { xs <- repLEs es; repListExp xs }
529 repE (ExplicitPArr ty es) =
530 panic "DsMeta.repE: No explicit parallel arrays yet"
531 repE (ExplicitTuple es boxed)
532 | isBoxed boxed = do { xs <- repLEs es; repTup xs }
533 | otherwise = panic "DsMeta.repE: Can't represent unboxed tuples"
534 repE (RecordCon c _ flds)
535 = do { x <- lookupLOcc c;
536 fs <- repFields flds;
538 repE (RecordUpd e flds _ _)
540 fs <- repFields flds;
543 repE (ExprWithTySig e ty) = do { e1 <- repLE e; t1 <- repLTy ty; repSigExp e1 t1 }
544 repE (ArithSeq _ aseq) =
546 From e -> do { ds1 <- repLE e; repFrom ds1 }
555 FromThenTo e1 e2 e3 -> do
559 repFromThenTo ds1 ds2 ds3
560 repE (PArrSeq _ aseq) = panic "DsMeta.repE: parallel array seq.s missing"
561 repE (HsCoreAnn _ _) = panic "DsMeta.repE: Can't represent CoreAnn" -- hdaume: core annotations
562 repE (HsSCC _ _) = panic "DsMeta.repE: Can't represent SCC"
563 repE (HsBracketOut _ _) = panic "DsMeta.repE: Can't represent Oxford brackets"
564 repE (HsSpliceE (HsSplice n _))
565 = do { mb_val <- dsLookupMetaEnv n
567 Just (Splice e) -> do { e' <- dsExpr e
569 other -> pprPanic "HsSplice" (ppr n) }
571 repE e = pprPanic "DsMeta.repE: Illegal expression form" (ppr e)
573 -----------------------------------------------------------------------------
574 -- Building representations of auxillary structures like Match, Clause, Stmt,
576 repMatchTup :: LMatch Name -> DsM (Core TH.MatchQ)
577 repMatchTup (L _ (Match [p] ty (GRHSs guards wheres))) =
578 do { ss1 <- mkGenSyms (collectPatBinders p)
579 ; addBinds ss1 $ do {
581 ; (ss2,ds) <- repBinds wheres
582 ; addBinds ss2 $ do {
583 ; gs <- repGuards guards
584 ; match <- repMatch p1 gs ds
585 ; wrapGenSyns (ss1++ss2) match }}}
587 repClauseTup :: LMatch Name -> DsM (Core TH.ClauseQ)
588 repClauseTup (L _ (Match ps ty (GRHSs guards wheres))) =
589 do { ss1 <- mkGenSyms (collectPatsBinders ps)
590 ; addBinds ss1 $ do {
592 ; (ss2,ds) <- repBinds wheres
593 ; addBinds ss2 $ do {
594 gs <- repGuards guards
595 ; clause <- repClause ps1 gs ds
596 ; wrapGenSyns (ss1++ss2) clause }}}
598 repGuards :: [LGRHS Name] -> DsM (Core TH.BodyQ)
599 repGuards [L _ (GRHS [] e)]
600 = do {a <- repLE e; repNormal a }
602 = do { zs <- mapM process other;
603 let {(xs, ys) = unzip zs};
604 gd <- repGuarded (nonEmptyCoreList ys);
605 wrapGenSyns (concat xs) gd }
607 process :: LGRHS Name -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp))))
608 process (L _ (GRHS [L _ (ExprStmt e1 _ _)] e2))
609 = do { x <- repLNormalGE e1 e2;
611 process (L _ (GRHS ss rhs))
612 = do (gs, ss') <- repLSts ss
613 rhs' <- addBinds gs $ repLE rhs
614 g <- repPatGE (nonEmptyCoreList ss') rhs'
617 repFields :: [(Located Name, LHsExpr Name)] -> DsM (Core [TH.Q TH.FieldExp])
619 fnames <- mapM lookupLOcc (map fst flds)
620 es <- mapM repLE (map snd flds)
621 fs <- zipWithM repFieldExp fnames es
622 coreList fieldExpQTyConName fs
625 -----------------------------------------------------------------------------
626 -- Representing Stmt's is tricky, especially if bound variables
627 -- shadow each other. Consider: [| do { x <- f 1; x <- f x; g x } |]
628 -- First gensym new names for every variable in any of the patterns.
629 -- both static (x'1 and x'2), and dynamic ((gensym "x") and (gensym "y"))
630 -- if variables didn't shaddow, the static gensym wouldn't be necessary
631 -- and we could reuse the original names (x and x).
633 -- do { x'1 <- gensym "x"
634 -- ; x'2 <- gensym "x"
635 -- ; doE [ BindSt (pvar x'1) [| f 1 |]
636 -- , BindSt (pvar x'2) [| f x |]
637 -- , NoBindSt [| g x |]
641 -- The strategy is to translate a whole list of do-bindings by building a
642 -- bigger environment, and a bigger set of meta bindings
643 -- (like: x'1 <- gensym "x" ) and then combining these with the translations
644 -- of the expressions within the Do
646 -----------------------------------------------------------------------------
647 -- The helper function repSts computes the translation of each sub expression
648 -- and a bunch of prefix bindings denoting the dynamic renaming.
650 repLSts :: [LStmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
651 repLSts stmts = repSts (map unLoc stmts)
653 repSts :: [Stmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
654 repSts (BindStmt p e _ _ : ss) =
656 ; ss1 <- mkGenSyms (collectPatBinders p)
657 ; addBinds ss1 $ do {
659 ; (ss2,zs) <- repSts ss
660 ; z <- repBindSt p1 e2
661 ; return (ss1++ss2, z : zs) }}
662 repSts (LetStmt bs : ss) =
663 do { (ss1,ds) <- repBinds bs
665 ; (ss2,zs) <- addBinds ss1 (repSts ss)
666 ; return (ss1++ss2, z : zs) }
667 repSts (ExprStmt e _ _ : ss) =
669 ; z <- repNoBindSt e2
670 ; (ss2,zs) <- repSts ss
671 ; return (ss2, z : zs) }
672 repSts [] = return ([],[])
673 repSts other = panic "Exotic Stmt in meta brackets"
676 -----------------------------------------------------------
678 -----------------------------------------------------------
680 repBinds :: HsLocalBinds Name -> DsM ([GenSymBind], Core [TH.DecQ])
681 repBinds EmptyLocalBinds
682 = do { core_list <- coreList decQTyConName []
683 ; return ([], core_list) }
685 repBinds (HsIPBinds _)
686 = panic "DsMeta:repBinds: can't do implicit parameters"
688 repBinds (HsValBinds decs)
689 = do { let { bndrs = map unLoc (collectHsValBinders decs) }
690 -- No need to worrry about detailed scopes within
691 -- the binding group, because we are talking Names
692 -- here, so we can safely treat it as a mutually
694 ; ss <- mkGenSyms bndrs
695 ; prs <- addBinds ss (rep_val_binds decs)
696 ; core_list <- coreList decQTyConName
697 (de_loc (sort_by_loc prs))
698 ; return (ss, core_list) }
700 rep_val_binds :: HsValBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
701 -- Assumes: all the binders of the binding are alrady in the meta-env
702 rep_val_binds (ValBindsOut binds sigs)
703 = do { core1 <- rep_binds' (unionManyBags (map snd binds))
704 ; core2 <- rep_sigs' sigs
705 ; return (core1 ++ core2) }
707 rep_binds :: LHsBinds Name -> DsM [Core TH.DecQ]
708 rep_binds binds = do { binds_w_locs <- rep_binds' binds
709 ; return (de_loc (sort_by_loc binds_w_locs)) }
711 rep_binds' :: LHsBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
712 rep_binds' binds = mapM rep_bind (bagToList binds)
714 rep_bind :: LHsBind Name -> DsM (SrcSpan, Core TH.DecQ)
715 -- Assumes: all the binders of the binding are alrady in the meta-env
717 -- Note GHC treats declarations of a variable (not a pattern)
718 -- e.g. x = g 5 as a Fun MonoBinds. This is indicated by a single match
719 -- with an empty list of patterns
720 rep_bind (L loc (FunBind { fun_id = fn,
721 fun_matches = MatchGroup [L _ (Match [] ty (GRHSs guards wheres))] _ }))
722 = do { (ss,wherecore) <- repBinds wheres
723 ; guardcore <- addBinds ss (repGuards guards)
724 ; fn' <- lookupLBinder fn
726 ; ans <- repVal p guardcore wherecore
727 ; ans' <- wrapGenSyns ss ans
728 ; return (loc, ans') }
730 rep_bind (L loc (FunBind { fun_id = fn, fun_matches = MatchGroup ms _ }))
731 = do { ms1 <- mapM repClauseTup ms
732 ; fn' <- lookupLBinder fn
733 ; ans <- repFun fn' (nonEmptyCoreList ms1)
734 ; return (loc, ans) }
736 rep_bind (L loc (PatBind { pat_lhs = pat, pat_rhs = GRHSs guards wheres }))
737 = do { patcore <- repLP pat
738 ; (ss,wherecore) <- repBinds wheres
739 ; guardcore <- addBinds ss (repGuards guards)
740 ; ans <- repVal patcore guardcore wherecore
741 ; ans' <- wrapGenSyns ss ans
742 ; return (loc, ans') }
744 rep_bind (L loc (VarBind { var_id = v, var_rhs = e}))
745 = do { v' <- lookupBinder v
748 ; patcore <- repPvar v'
749 ; empty_decls <- coreList decQTyConName []
750 ; ans <- repVal patcore x empty_decls
751 ; return (srcLocSpan (getSrcLoc v), ans) }
753 -----------------------------------------------------------------------------
754 -- Since everything in a Bind is mutually recursive we need rename all
755 -- all the variables simultaneously. For example:
756 -- [| AndMonoBinds (f x = x + g 2) (g x = f 1 + 2) |] would translate to
757 -- do { f'1 <- gensym "f"
758 -- ; g'2 <- gensym "g"
759 -- ; [ do { x'3 <- gensym "x"; fun f'1 [pvar x'3] [| x + g2 |]},
760 -- do { x'4 <- gensym "x"; fun g'2 [pvar x'4] [| f 1 + 2 |]}
762 -- This requires collecting the bindings (f'1 <- gensym "f"), and the
763 -- environment ( f |-> f'1 ) from each binding, and then unioning them
764 -- together. As we do this we collect GenSymBinds's which represent the renamed
765 -- variables bound by the Bindings. In order not to lose track of these
766 -- representations we build a shadow datatype MB with the same structure as
767 -- MonoBinds, but which has slots for the representations
770 -----------------------------------------------------------------------------
771 -- GHC allows a more general form of lambda abstraction than specified
772 -- by Haskell 98. In particular it allows guarded lambda's like :
773 -- (\ x | even x -> 0 | odd x -> 1) at the moment we can't represent this in
774 -- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like
775 -- (\ p1 .. pn -> exp) by causing an error.
777 repLambda :: LMatch Name -> DsM (Core TH.ExpQ)
778 repLambda (L _ (Match ps _ (GRHSs [L _ (GRHS [] e)] EmptyLocalBinds)))
779 = do { let bndrs = collectPatsBinders ps ;
780 ; ss <- mkGenSyms bndrs
781 ; lam <- addBinds ss (
782 do { xs <- repLPs ps; body <- repLE e; repLam xs body })
783 ; wrapGenSyns ss lam }
785 repLambda z = panic "Can't represent a guarded lambda in Template Haskell"
788 -----------------------------------------------------------------------------
790 -- repP deals with patterns. It assumes that we have already
791 -- walked over the pattern(s) once to collect the binders, and
792 -- have extended the environment. So every pattern-bound
793 -- variable should already appear in the environment.
795 -- Process a list of patterns
796 repLPs :: [LPat Name] -> DsM (Core [TH.PatQ])
797 repLPs ps = do { ps' <- mapM repLP ps ;
798 coreList patQTyConName ps' }
800 repLP :: LPat Name -> DsM (Core TH.PatQ)
801 repLP (L _ p) = repP p
803 repP :: Pat Name -> DsM (Core TH.PatQ)
804 repP (WildPat _) = repPwild
805 repP (LitPat l) = do { l2 <- repLiteral l; repPlit l2 }
806 repP (VarPat x) = do { x' <- lookupBinder x; repPvar x' }
807 repP (LazyPat p) = do { p1 <- repLP p; repPtilde p1 }
808 repP (AsPat x p) = do { x' <- lookupLBinder x; p1 <- repLP p; repPaspat x' p1 }
809 repP (ParPat p) = repLP p
810 repP (ListPat ps _) = do { qs <- repLPs ps; repPlist qs }
811 repP (TuplePat ps _ _) = do { qs <- repLPs ps; repPtup qs }
812 repP (ConPatIn dc details)
813 = do { con_str <- lookupLOcc dc
815 PrefixCon ps -> do { qs <- repLPs ps; repPcon con_str qs }
816 RecCon pairs -> do { vs <- sequence $ map lookupLOcc (map fst pairs)
817 ; ps <- sequence $ map repLP (map snd pairs)
818 ; fps <- zipWithM (\x y -> rep2 fieldPatName [unC x,unC y]) vs ps
819 ; fps' <- coreList fieldPatQTyConName fps
820 ; repPrec con_str fps' }
821 InfixCon p1 p2 -> do { p1' <- repLP p1;
823 repPinfix p1' con_str p2' }
825 repP (NPat l (Just _) _ _) = panic "Can't cope with negative overloaded patterns yet (repP (NPat _ (Just _)))"
826 repP (NPat l Nothing _ _) = do { a <- repOverloadedLiteral l; repPlit a }
827 repP (SigPatIn p t) = do { p' <- repLP p; t' <- repLTy t; repPsig p' t' }
828 repP other = panic "Exotic pattern inside meta brackets"
830 ----------------------------------------------------------
831 -- Declaration ordering helpers
833 sort_by_loc :: [(SrcSpan, a)] -> [(SrcSpan, a)]
834 sort_by_loc xs = sortBy comp xs
835 where comp x y = compare (fst x) (fst y)
837 de_loc :: [(a, b)] -> [b]
840 ----------------------------------------------------------
841 -- The meta-environment
843 -- A name/identifier association for fresh names of locally bound entities
844 type GenSymBind = (Name, Id) -- Gensym the string and bind it to the Id
845 -- I.e. (x, x_id) means
846 -- let x_id = gensym "x" in ...
848 -- Generate a fresh name for a locally bound entity
850 mkGenSyms :: [Name] -> DsM [GenSymBind]
851 -- We can use the existing name. For example:
852 -- [| \x_77 -> x_77 + x_77 |]
854 -- do { x_77 <- genSym "x"; .... }
855 -- We use the same x_77 in the desugared program, but with the type Bndr
858 -- We do make it an Internal name, though (hence localiseName)
860 -- Nevertheless, it's monadic because we have to generate nameTy
861 mkGenSyms ns = do { var_ty <- lookupType nameTyConName
862 ; return [(nm, mkLocalId (localiseName nm) var_ty) | nm <- ns] }
865 addBinds :: [GenSymBind] -> DsM a -> DsM a
866 -- Add a list of fresh names for locally bound entities to the
867 -- meta environment (which is part of the state carried around
868 -- by the desugarer monad)
869 addBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,Bound id) | (n,id) <- bs]) m
871 -- Look up a locally bound name
873 lookupLBinder :: Located Name -> DsM (Core TH.Name)
874 lookupLBinder (L _ n) = lookupBinder n
876 lookupBinder :: Name -> DsM (Core TH.Name)
878 = do { mb_val <- dsLookupMetaEnv n;
880 Just (Bound x) -> return (coreVar x)
881 other -> pprPanic "DsMeta: failed binder lookup when desugaring a TH bracket:" (ppr n) }
883 -- Look up a name that is either locally bound or a global name
885 -- * If it is a global name, generate the "original name" representation (ie,
886 -- the <module>:<name> form) for the associated entity
888 lookupLOcc :: Located Name -> DsM (Core TH.Name)
889 -- Lookup an occurrence; it can't be a splice.
890 -- Use the in-scope bindings if they exist
891 lookupLOcc (L _ n) = lookupOcc n
893 lookupOcc :: Name -> DsM (Core TH.Name)
895 = do { mb_val <- dsLookupMetaEnv n ;
897 Nothing -> globalVar n
898 Just (Bound x) -> return (coreVar x)
899 Just (Splice _) -> pprPanic "repE:lookupOcc" (ppr n)
902 globalVar :: Name -> DsM (Core TH.Name)
903 -- Not bound by the meta-env
904 -- Could be top-level; or could be local
905 -- f x = $(g [| x |])
906 -- Here the x will be local
908 | isExternalName name
909 = do { MkC mod <- coreStringLit name_mod
910 ; MkC pkg <- coreStringLit name_pkg
911 ; MkC occ <- occNameLit name
912 ; rep2 mk_varg [pkg,mod,occ] }
914 = do { MkC occ <- occNameLit name
915 ; MkC uni <- coreIntLit (getKey (getUnique name))
916 ; rep2 mkNameLName [occ,uni] }
918 mod = nameModule name
919 name_mod = moduleNameString (moduleName mod)
920 name_pkg = packageIdString (modulePackageId mod)
921 name_occ = nameOccName name
922 mk_varg | OccName.isDataOcc name_occ = mkNameG_dName
923 | OccName.isVarOcc name_occ = mkNameG_vName
924 | OccName.isTcOcc name_occ = mkNameG_tcName
925 | otherwise = pprPanic "DsMeta.globalVar" (ppr name)
927 lookupType :: Name -- Name of type constructor (e.g. TH.ExpQ)
928 -> DsM Type -- The type
929 lookupType tc_name = do { tc <- dsLookupTyCon tc_name ;
930 return (mkTyConApp tc []) }
932 wrapGenSyns :: [GenSymBind]
933 -> Core (TH.Q a) -> DsM (Core (TH.Q a))
934 -- wrapGenSyns [(nm1,id1), (nm2,id2)] y
935 -- --> bindQ (gensym nm1) (\ id1 ->
936 -- bindQ (gensym nm2 (\ id2 ->
939 wrapGenSyns binds body@(MkC b)
940 = do { var_ty <- lookupType nameTyConName
943 [elt_ty] = tcTyConAppArgs (exprType b)
944 -- b :: Q a, so we can get the type 'a' by looking at the
945 -- argument type. NB: this relies on Q being a data/newtype,
946 -- not a type synonym
948 go var_ty [] = return body
949 go var_ty ((name,id) : binds)
950 = do { MkC body' <- go var_ty binds
951 ; lit_str <- occNameLit name
952 ; gensym_app <- repGensym lit_str
953 ; repBindQ var_ty elt_ty
954 gensym_app (MkC (Lam id body')) }
956 -- Just like wrapGenSym, but don't actually do the gensym
957 -- Instead use the existing name:
958 -- let x = "x" in ...
959 -- Only used for [Decl], and for the class ops in class
960 -- and instance decls
961 wrapNongenSyms :: [GenSymBind] -> Core a -> DsM (Core a)
962 wrapNongenSyms binds (MkC body)
963 = do { binds' <- mapM do_one binds ;
964 return (MkC (mkLets binds' body)) }
967 = do { MkC lit_str <- occNameLit name
968 ; MkC var <- rep2 mkNameName [lit_str]
969 ; return (NonRec id var) }
971 occNameLit :: Name -> DsM (Core String)
972 occNameLit n = coreStringLit (occNameString (nameOccName n))
975 -- %*********************************************************************
979 -- %*********************************************************************
981 -----------------------------------------------------------------------------
982 -- PHANTOM TYPES for consistency. In order to make sure we do this correct
983 -- we invent a new datatype which uses phantom types.
985 newtype Core a = MkC CoreExpr
988 rep2 :: Name -> [ CoreExpr ] -> DsM (Core a)
989 rep2 n xs = do { id <- dsLookupGlobalId n
990 ; return (MkC (foldl App (Var id) xs)) }
992 -- Then we make "repConstructors" which use the phantom types for each of the
993 -- smart constructors of the Meta.Meta datatypes.
996 -- %*********************************************************************
998 -- The 'smart constructors'
1000 -- %*********************************************************************
1002 --------------- Patterns -----------------
1003 repPlit :: Core TH.Lit -> DsM (Core TH.PatQ)
1004 repPlit (MkC l) = rep2 litPName [l]
1006 repPvar :: Core TH.Name -> DsM (Core TH.PatQ)
1007 repPvar (MkC s) = rep2 varPName [s]
1009 repPtup :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
1010 repPtup (MkC ps) = rep2 tupPName [ps]
1012 repPcon :: Core TH.Name -> Core [TH.PatQ] -> DsM (Core TH.PatQ)
1013 repPcon (MkC s) (MkC ps) = rep2 conPName [s, ps]
1015 repPrec :: Core TH.Name -> Core [(TH.Name,TH.PatQ)] -> DsM (Core TH.PatQ)
1016 repPrec (MkC c) (MkC rps) = rep2 recPName [c,rps]
1018 repPinfix :: Core TH.PatQ -> Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
1019 repPinfix (MkC p1) (MkC n) (MkC p2) = rep2 infixPName [p1, n, p2]
1021 repPtilde :: Core TH.PatQ -> DsM (Core TH.PatQ)
1022 repPtilde (MkC p) = rep2 tildePName [p]
1024 repPaspat :: Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
1025 repPaspat (MkC s) (MkC p) = rep2 asPName [s, p]
1027 repPwild :: DsM (Core TH.PatQ)
1028 repPwild = rep2 wildPName []
1030 repPlist :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
1031 repPlist (MkC ps) = rep2 listPName [ps]
1033 repPsig :: Core TH.PatQ -> Core TH.TypeQ -> DsM (Core TH.PatQ)
1034 repPsig (MkC p) (MkC t) = rep2 sigPName [p, t]
1036 --------------- Expressions -----------------
1037 repVarOrCon :: Name -> Core TH.Name -> DsM (Core TH.ExpQ)
1038 repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
1039 | otherwise = repVar str
1041 repVar :: Core TH.Name -> DsM (Core TH.ExpQ)
1042 repVar (MkC s) = rep2 varEName [s]
1044 repCon :: Core TH.Name -> DsM (Core TH.ExpQ)
1045 repCon (MkC s) = rep2 conEName [s]
1047 repLit :: Core TH.Lit -> DsM (Core TH.ExpQ)
1048 repLit (MkC c) = rep2 litEName [c]
1050 repApp :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1051 repApp (MkC x) (MkC y) = rep2 appEName [x,y]
1053 repLam :: Core [TH.PatQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1054 repLam (MkC ps) (MkC e) = rep2 lamEName [ps, e]
1056 repTup :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
1057 repTup (MkC es) = rep2 tupEName [es]
1059 repCond :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1060 repCond (MkC x) (MkC y) (MkC z) = rep2 condEName [x,y,z]
1062 repLetE :: Core [TH.DecQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1063 repLetE (MkC ds) (MkC e) = rep2 letEName [ds, e]
1065 repCaseE :: Core TH.ExpQ -> Core [TH.MatchQ] -> DsM( Core TH.ExpQ)
1066 repCaseE (MkC e) (MkC ms) = rep2 caseEName [e, ms]
1068 repDoE :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
1069 repDoE (MkC ss) = rep2 doEName [ss]
1071 repComp :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
1072 repComp (MkC ss) = rep2 compEName [ss]
1074 repListExp :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
1075 repListExp (MkC es) = rep2 listEName [es]
1077 repSigExp :: Core TH.ExpQ -> Core TH.TypeQ -> DsM (Core TH.ExpQ)
1078 repSigExp (MkC e) (MkC t) = rep2 sigEName [e,t]
1080 repRecCon :: Core TH.Name -> Core [TH.Q TH.FieldExp]-> DsM (Core TH.ExpQ)
1081 repRecCon (MkC c) (MkC fs) = rep2 recConEName [c,fs]
1083 repRecUpd :: Core TH.ExpQ -> Core [TH.Q TH.FieldExp] -> DsM (Core TH.ExpQ)
1084 repRecUpd (MkC e) (MkC fs) = rep2 recUpdEName [e,fs]
1086 repFieldExp :: Core TH.Name -> Core TH.ExpQ -> DsM (Core (TH.Q TH.FieldExp))
1087 repFieldExp (MkC n) (MkC x) = rep2 fieldExpName [n,x]
1089 repInfixApp :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1090 repInfixApp (MkC x) (MkC y) (MkC z) = rep2 infixAppName [x,y,z]
1092 repSectionL :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1093 repSectionL (MkC x) (MkC y) = rep2 sectionLName [x,y]
1095 repSectionR :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1096 repSectionR (MkC x) (MkC y) = rep2 sectionRName [x,y]
1098 ------------ Right hand sides (guarded expressions) ----
1099 repGuarded :: Core [TH.Q (TH.Guard, TH.Exp)] -> DsM (Core TH.BodyQ)
1100 repGuarded (MkC pairs) = rep2 guardedBName [pairs]
1102 repNormal :: Core TH.ExpQ -> DsM (Core TH.BodyQ)
1103 repNormal (MkC e) = rep2 normalBName [e]
1105 ------------ Guards ----
1106 repLNormalGE :: LHsExpr Name -> LHsExpr Name -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1107 repLNormalGE g e = do g' <- repLE g
1111 repNormalGE :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1112 repNormalGE (MkC g) (MkC e) = rep2 normalGEName [g, e]
1114 repPatGE :: Core [TH.StmtQ] -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1115 repPatGE (MkC ss) (MkC e) = rep2 patGEName [ss, e]
1117 ------------- Stmts -------------------
1118 repBindSt :: Core TH.PatQ -> Core TH.ExpQ -> DsM (Core TH.StmtQ)
1119 repBindSt (MkC p) (MkC e) = rep2 bindSName [p,e]
1121 repLetSt :: Core [TH.DecQ] -> DsM (Core TH.StmtQ)
1122 repLetSt (MkC ds) = rep2 letSName [ds]
1124 repNoBindSt :: Core TH.ExpQ -> DsM (Core TH.StmtQ)
1125 repNoBindSt (MkC e) = rep2 noBindSName [e]
1127 -------------- Range (Arithmetic sequences) -----------
1128 repFrom :: Core TH.ExpQ -> DsM (Core TH.ExpQ)
1129 repFrom (MkC x) = rep2 fromEName [x]
1131 repFromThen :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1132 repFromThen (MkC x) (MkC y) = rep2 fromThenEName [x,y]
1134 repFromTo :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1135 repFromTo (MkC x) (MkC y) = rep2 fromToEName [x,y]
1137 repFromThenTo :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1138 repFromThenTo (MkC x) (MkC y) (MkC z) = rep2 fromThenToEName [x,y,z]
1140 ------------ Match and Clause Tuples -----------
1141 repMatch :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.MatchQ)
1142 repMatch (MkC p) (MkC bod) (MkC ds) = rep2 matchName [p, bod, ds]
1144 repClause :: Core [TH.PatQ] -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.ClauseQ)
1145 repClause (MkC ps) (MkC bod) (MkC ds) = rep2 clauseName [ps, bod, ds]
1147 -------------- Dec -----------------------------
1148 repVal :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1149 repVal (MkC p) (MkC b) (MkC ds) = rep2 valDName [p, b, ds]
1151 repFun :: Core TH.Name -> Core [TH.ClauseQ] -> DsM (Core TH.DecQ)
1152 repFun (MkC nm) (MkC b) = rep2 funDName [nm, b]
1154 repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core [TH.ConQ] -> Core [TH.Name] -> DsM (Core TH.DecQ)
1155 repData (MkC cxt) (MkC nm) (MkC tvs) (MkC cons) (MkC derivs)
1156 = rep2 dataDName [cxt, nm, tvs, cons, derivs]
1158 repNewtype :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core TH.ConQ -> Core [TH.Name] -> DsM (Core TH.DecQ)
1159 repNewtype (MkC cxt) (MkC nm) (MkC tvs) (MkC con) (MkC derivs)
1160 = rep2 newtypeDName [cxt, nm, tvs, con, derivs]
1162 repTySyn :: Core TH.Name -> Core [TH.Name] -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1163 repTySyn (MkC nm) (MkC tvs) (MkC rhs) = rep2 tySynDName [nm, tvs, rhs]
1165 repInst :: Core TH.CxtQ -> Core TH.TypeQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1166 repInst (MkC cxt) (MkC ty) (MkC ds) = rep2 instanceDName [cxt, ty, ds]
1168 repClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core [TH.FunDep] -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1169 repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds) = rep2 classDName [cxt, cls, tvs, fds, ds]
1171 repFunDep :: Core [TH.Name] -> Core [TH.Name] -> DsM (Core TH.FunDep)
1172 repFunDep (MkC xs) (MkC ys) = rep2 funDepName [xs, ys]
1174 repProto :: Core TH.Name -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1175 repProto (MkC s) (MkC ty) = rep2 sigDName [s, ty]
1177 repCtxt :: Core [TH.TypeQ] -> DsM (Core TH.CxtQ)
1178 repCtxt (MkC tys) = rep2 cxtName [tys]
1180 repConstr :: Core TH.Name -> HsConDetails Name (LBangType Name)
1181 -> DsM (Core TH.ConQ)
1182 repConstr con (PrefixCon ps)
1183 = do arg_tys <- mapM repBangTy ps
1184 arg_tys1 <- coreList strictTypeQTyConName arg_tys
1185 rep2 normalCName [unC con, unC arg_tys1]
1186 repConstr con (RecCon ips)
1187 = do arg_vs <- mapM lookupLOcc (map fst ips)
1188 arg_tys <- mapM repBangTy (map snd ips)
1189 arg_vtys <- zipWithM (\x y -> rep2 varStrictTypeName [unC x, unC y])
1191 arg_vtys' <- coreList varStrictTypeQTyConName arg_vtys
1192 rep2 recCName [unC con, unC arg_vtys']
1193 repConstr con (InfixCon st1 st2)
1194 = do arg1 <- repBangTy st1
1195 arg2 <- repBangTy st2
1196 rep2 infixCName [unC arg1, unC con, unC arg2]
1198 ------------ Types -------------------
1200 repTForall :: Core [TH.Name] -> Core TH.CxtQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)
1201 repTForall (MkC tvars) (MkC ctxt) (MkC ty)
1202 = rep2 forallTName [tvars, ctxt, ty]
1204 repTvar :: Core TH.Name -> DsM (Core TH.TypeQ)
1205 repTvar (MkC s) = rep2 varTName [s]
1207 repTapp :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)
1208 repTapp (MkC t1) (MkC t2) = rep2 appTName [t1,t2]
1210 repTapps :: Core TH.TypeQ -> [Core TH.TypeQ] -> DsM (Core TH.TypeQ)
1211 repTapps f [] = return f
1212 repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
1214 --------- Type constructors --------------
1216 repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
1217 repNamedTyCon (MkC s) = rep2 conTName [s]
1219 repTupleTyCon :: Int -> DsM (Core TH.TypeQ)
1220 -- Note: not Core Int; it's easier to be direct here
1221 repTupleTyCon i = rep2 tupleTName [mkIntExpr (fromIntegral i)]
1223 repArrowTyCon :: DsM (Core TH.TypeQ)
1224 repArrowTyCon = rep2 arrowTName []
1226 repListTyCon :: DsM (Core TH.TypeQ)
1227 repListTyCon = rep2 listTName []
1230 ----------------------------------------------------------
1233 repLiteral :: HsLit -> DsM (Core TH.Lit)
1235 = do lit' <- case lit of
1236 HsIntPrim i -> mk_integer i
1237 HsInt i -> mk_integer i
1238 HsFloatPrim r -> mk_rational r
1239 HsDoublePrim r -> mk_rational r
1241 lit_expr <- dsLit lit'
1242 rep2 lit_name [lit_expr]
1244 lit_name = case lit of
1245 HsInteger _ _ -> integerLName
1246 HsInt _ -> integerLName
1247 HsIntPrim _ -> intPrimLName
1248 HsFloatPrim _ -> floatPrimLName
1249 HsDoublePrim _ -> doublePrimLName
1250 HsChar _ -> charLName
1251 HsString _ -> stringLName
1252 HsRat _ _ -> rationalLName
1254 uh_oh = pprPanic "DsMeta.repLiteral: trying to represent exotic literal"
1257 mk_integer i = do integer_ty <- lookupType integerTyConName
1258 return $ HsInteger i integer_ty
1259 mk_rational r = do rat_ty <- lookupType rationalTyConName
1260 return $ HsRat r rat_ty
1262 repOverloadedLiteral :: HsOverLit Name -> DsM (Core TH.Lit)
1263 repOverloadedLiteral (HsIntegral i _) = do { lit <- mk_integer i; repLiteral lit }
1264 repOverloadedLiteral (HsFractional f _) = do { lit <- mk_rational f; repLiteral lit }
1265 -- The type Rational will be in the environment, becuase
1266 -- the smart constructor 'TH.Syntax.rationalL' uses it in its type,
1267 -- and rationalL is sucked in when any TH stuff is used
1269 --------------- Miscellaneous -------------------
1271 repGensym :: Core String -> DsM (Core (TH.Q TH.Name))
1272 repGensym (MkC lit_str) = rep2 newNameName [lit_str]
1274 repBindQ :: Type -> Type -- a and b
1275 -> Core (TH.Q a) -> Core (a -> TH.Q b) -> DsM (Core (TH.Q b))
1276 repBindQ ty_a ty_b (MkC x) (MkC y)
1277 = rep2 bindQName [Type ty_a, Type ty_b, x, y]
1279 repSequenceQ :: Type -> Core [TH.Q a] -> DsM (Core (TH.Q [a]))
1280 repSequenceQ ty_a (MkC list)
1281 = rep2 sequenceQName [Type ty_a, list]
1283 ------------ Lists and Tuples -------------------
1284 -- turn a list of patterns into a single pattern matching a list
1286 coreList :: Name -- Of the TyCon of the element type
1287 -> [Core a] -> DsM (Core [a])
1289 = do { elt_ty <- lookupType tc_name; return (coreList' elt_ty es) }
1291 coreList' :: Type -- The element type
1292 -> [Core a] -> Core [a]
1293 coreList' elt_ty es = MkC (mkListExpr elt_ty (map unC es ))
1295 nonEmptyCoreList :: [Core a] -> Core [a]
1296 -- The list must be non-empty so we can get the element type
1297 -- Otherwise use coreList
1298 nonEmptyCoreList [] = panic "coreList: empty argument"
1299 nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs))
1301 coreStringLit :: String -> DsM (Core String)
1302 coreStringLit s = do { z <- mkStringExpr s; return(MkC z) }
1304 coreIntLit :: Int -> DsM (Core Int)
1305 coreIntLit i = return (MkC (mkIntExpr (fromIntegral i)))
1307 coreVar :: Id -> Core TH.Name -- The Id has type Name
1308 coreVar id = MkC (Var id)
1312 -- %************************************************************************
1314 -- The known-key names for Template Haskell
1316 -- %************************************************************************
1318 -- To add a name, do three things
1320 -- 1) Allocate a key
1322 -- 3) Add the name to knownKeyNames
1324 templateHaskellNames :: [Name]
1325 -- The names that are implicitly mentioned by ``bracket''
1326 -- Should stay in sync with the import list of DsMeta
1328 templateHaskellNames = [
1329 returnQName, bindQName, sequenceQName, newNameName, liftName,
1330 mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
1333 charLName, stringLName, integerLName, intPrimLName,
1334 floatPrimLName, doublePrimLName, rationalLName,
1336 litPName, varPName, tupPName, conPName, tildePName, infixPName,
1337 asPName, wildPName, recPName, listPName, sigPName,
1345 varEName, conEName, litEName, appEName, infixEName,
1346 infixAppName, sectionLName, sectionRName, lamEName, tupEName,
1347 condEName, letEName, caseEName, doEName, compEName,
1348 fromEName, fromThenEName, fromToEName, fromThenToEName,
1349 listEName, sigEName, recConEName, recUpdEName,
1353 guardedBName, normalBName,
1355 normalGEName, patGEName,
1357 bindSName, letSName, noBindSName, parSName,
1359 funDName, valDName, dataDName, newtypeDName, tySynDName,
1360 classDName, instanceDName, sigDName, forImpDName,
1364 isStrictName, notStrictName,
1366 normalCName, recCName, infixCName, forallCName,
1372 forallTName, varTName, conTName, appTName,
1373 tupleTName, arrowTName, listTName,
1375 cCallName, stdCallName,
1384 qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchQTyConName,
1385 clauseQTyConName, expQTyConName, fieldExpTyConName, stmtQTyConName,
1386 decQTyConName, conQTyConName, strictTypeQTyConName,
1387 varStrictTypeQTyConName, typeQTyConName, expTyConName, decTyConName,
1388 typeTyConName, matchTyConName, clauseTyConName, patQTyConName,
1389 fieldPatQTyConName, fieldExpQTyConName, funDepTyConName]
1392 thSyn = mkTHModule FSLIT("Language.Haskell.TH.Syntax")
1393 thLib = mkTHModule FSLIT("Language.Haskell.TH.Lib")
1395 mkTHModule m = mkModule thPackageId (mkModuleNameFS m)
1397 mk_known_key_name mod space str uniq
1398 = mkExternalName uniq mod (mkOccNameFS space str)
1401 libFun = mk_known_key_name thLib OccName.varName
1402 libTc = mk_known_key_name thLib OccName.tcName
1403 thFun = mk_known_key_name thSyn OccName.varName
1404 thTc = mk_known_key_name thSyn OccName.tcName
1406 -------------------- TH.Syntax -----------------------
1407 qTyConName = thTc FSLIT("Q") qTyConKey
1408 nameTyConName = thTc FSLIT("Name") nameTyConKey
1409 fieldExpTyConName = thTc FSLIT("FieldExp") fieldExpTyConKey
1410 patTyConName = thTc FSLIT("Pat") patTyConKey
1411 fieldPatTyConName = thTc FSLIT("FieldPat") fieldPatTyConKey
1412 expTyConName = thTc FSLIT("Exp") expTyConKey
1413 decTyConName = thTc FSLIT("Dec") decTyConKey
1414 typeTyConName = thTc FSLIT("Type") typeTyConKey
1415 matchTyConName = thTc FSLIT("Match") matchTyConKey
1416 clauseTyConName = thTc FSLIT("Clause") clauseTyConKey
1417 funDepTyConName = thTc FSLIT("FunDep") funDepTyConKey
1419 returnQName = thFun FSLIT("returnQ") returnQIdKey
1420 bindQName = thFun FSLIT("bindQ") bindQIdKey
1421 sequenceQName = thFun FSLIT("sequenceQ") sequenceQIdKey
1422 newNameName = thFun FSLIT("newName") newNameIdKey
1423 liftName = thFun FSLIT("lift") liftIdKey
1424 mkNameName = thFun FSLIT("mkName") mkNameIdKey
1425 mkNameG_vName = thFun FSLIT("mkNameG_v") mkNameG_vIdKey
1426 mkNameG_dName = thFun FSLIT("mkNameG_d") mkNameG_dIdKey
1427 mkNameG_tcName = thFun FSLIT("mkNameG_tc") mkNameG_tcIdKey
1428 mkNameLName = thFun FSLIT("mkNameL") mkNameLIdKey
1431 -------------------- TH.Lib -----------------------
1433 charLName = libFun FSLIT("charL") charLIdKey
1434 stringLName = libFun FSLIT("stringL") stringLIdKey
1435 integerLName = libFun FSLIT("integerL") integerLIdKey
1436 intPrimLName = libFun FSLIT("intPrimL") intPrimLIdKey
1437 floatPrimLName = libFun FSLIT("floatPrimL") floatPrimLIdKey
1438 doublePrimLName = libFun FSLIT("doublePrimL") doublePrimLIdKey
1439 rationalLName = libFun FSLIT("rationalL") rationalLIdKey
1442 litPName = libFun FSLIT("litP") litPIdKey
1443 varPName = libFun FSLIT("varP") varPIdKey
1444 tupPName = libFun FSLIT("tupP") tupPIdKey
1445 conPName = libFun FSLIT("conP") conPIdKey
1446 infixPName = libFun FSLIT("infixP") infixPIdKey
1447 tildePName = libFun FSLIT("tildeP") tildePIdKey
1448 asPName = libFun FSLIT("asP") asPIdKey
1449 wildPName = libFun FSLIT("wildP") wildPIdKey
1450 recPName = libFun FSLIT("recP") recPIdKey
1451 listPName = libFun FSLIT("listP") listPIdKey
1452 sigPName = libFun FSLIT("sigP") sigPIdKey
1454 -- type FieldPat = ...
1455 fieldPatName = libFun FSLIT("fieldPat") fieldPatIdKey
1458 matchName = libFun FSLIT("match") matchIdKey
1460 -- data Clause = ...
1461 clauseName = libFun FSLIT("clause") clauseIdKey
1464 varEName = libFun FSLIT("varE") varEIdKey
1465 conEName = libFun FSLIT("conE") conEIdKey
1466 litEName = libFun FSLIT("litE") litEIdKey
1467 appEName = libFun FSLIT("appE") appEIdKey
1468 infixEName = libFun FSLIT("infixE") infixEIdKey
1469 infixAppName = libFun FSLIT("infixApp") infixAppIdKey
1470 sectionLName = libFun FSLIT("sectionL") sectionLIdKey
1471 sectionRName = libFun FSLIT("sectionR") sectionRIdKey
1472 lamEName = libFun FSLIT("lamE") lamEIdKey
1473 tupEName = libFun FSLIT("tupE") tupEIdKey
1474 condEName = libFun FSLIT("condE") condEIdKey
1475 letEName = libFun FSLIT("letE") letEIdKey
1476 caseEName = libFun FSLIT("caseE") caseEIdKey
1477 doEName = libFun FSLIT("doE") doEIdKey
1478 compEName = libFun FSLIT("compE") compEIdKey
1479 -- ArithSeq skips a level
1480 fromEName = libFun FSLIT("fromE") fromEIdKey
1481 fromThenEName = libFun FSLIT("fromThenE") fromThenEIdKey
1482 fromToEName = libFun FSLIT("fromToE") fromToEIdKey
1483 fromThenToEName = libFun FSLIT("fromThenToE") fromThenToEIdKey
1485 listEName = libFun FSLIT("listE") listEIdKey
1486 sigEName = libFun FSLIT("sigE") sigEIdKey
1487 recConEName = libFun FSLIT("recConE") recConEIdKey
1488 recUpdEName = libFun FSLIT("recUpdE") recUpdEIdKey
1490 -- type FieldExp = ...
1491 fieldExpName = libFun FSLIT("fieldExp") fieldExpIdKey
1494 guardedBName = libFun FSLIT("guardedB") guardedBIdKey
1495 normalBName = libFun FSLIT("normalB") normalBIdKey
1498 normalGEName = libFun FSLIT("normalGE") normalGEIdKey
1499 patGEName = libFun FSLIT("patGE") patGEIdKey
1502 bindSName = libFun FSLIT("bindS") bindSIdKey
1503 letSName = libFun FSLIT("letS") letSIdKey
1504 noBindSName = libFun FSLIT("noBindS") noBindSIdKey
1505 parSName = libFun FSLIT("parS") parSIdKey
1508 funDName = libFun FSLIT("funD") funDIdKey
1509 valDName = libFun FSLIT("valD") valDIdKey
1510 dataDName = libFun FSLIT("dataD") dataDIdKey
1511 newtypeDName = libFun FSLIT("newtypeD") newtypeDIdKey
1512 tySynDName = libFun FSLIT("tySynD") tySynDIdKey
1513 classDName = libFun FSLIT("classD") classDIdKey
1514 instanceDName = libFun FSLIT("instanceD") instanceDIdKey
1515 sigDName = libFun FSLIT("sigD") sigDIdKey
1516 forImpDName = libFun FSLIT("forImpD") forImpDIdKey
1519 cxtName = libFun FSLIT("cxt") cxtIdKey
1521 -- data Strict = ...
1522 isStrictName = libFun FSLIT("isStrict") isStrictKey
1523 notStrictName = libFun FSLIT("notStrict") notStrictKey
1526 normalCName = libFun FSLIT("normalC") normalCIdKey
1527 recCName = libFun FSLIT("recC") recCIdKey
1528 infixCName = libFun FSLIT("infixC") infixCIdKey
1529 forallCName = libFun FSLIT("forallC") forallCIdKey
1531 -- type StrictType = ...
1532 strictTypeName = libFun FSLIT("strictType") strictTKey
1534 -- type VarStrictType = ...
1535 varStrictTypeName = libFun FSLIT("varStrictType") varStrictTKey
1538 forallTName = libFun FSLIT("forallT") forallTIdKey
1539 varTName = libFun FSLIT("varT") varTIdKey
1540 conTName = libFun FSLIT("conT") conTIdKey
1541 tupleTName = libFun FSLIT("tupleT") tupleTIdKey
1542 arrowTName = libFun FSLIT("arrowT") arrowTIdKey
1543 listTName = libFun FSLIT("listT") listTIdKey
1544 appTName = libFun FSLIT("appT") appTIdKey
1546 -- data Callconv = ...
1547 cCallName = libFun FSLIT("cCall") cCallIdKey
1548 stdCallName = libFun FSLIT("stdCall") stdCallIdKey
1550 -- data Safety = ...
1551 unsafeName = libFun FSLIT("unsafe") unsafeIdKey
1552 safeName = libFun FSLIT("safe") safeIdKey
1553 threadsafeName = libFun FSLIT("threadsafe") threadsafeIdKey
1555 -- data FunDep = ...
1556 funDepName = libFun FSLIT("funDep") funDepIdKey
1558 matchQTyConName = libTc FSLIT("MatchQ") matchQTyConKey
1559 clauseQTyConName = libTc FSLIT("ClauseQ") clauseQTyConKey
1560 expQTyConName = libTc FSLIT("ExpQ") expQTyConKey
1561 stmtQTyConName = libTc FSLIT("StmtQ") stmtQTyConKey
1562 decQTyConName = libTc FSLIT("DecQ") decQTyConKey
1563 conQTyConName = libTc FSLIT("ConQ") conQTyConKey
1564 strictTypeQTyConName = libTc FSLIT("StrictTypeQ") strictTypeQTyConKey
1565 varStrictTypeQTyConName = libTc FSLIT("VarStrictTypeQ") varStrictTypeQTyConKey
1566 typeQTyConName = libTc FSLIT("TypeQ") typeQTyConKey
1567 fieldExpQTyConName = libTc FSLIT("FieldExpQ") fieldExpQTyConKey
1568 patQTyConName = libTc FSLIT("PatQ") patQTyConKey
1569 fieldPatQTyConName = libTc FSLIT("FieldPatQ") fieldPatQTyConKey
1571 -- TyConUniques available: 100-129
1572 -- Check in PrelNames if you want to change this
1574 expTyConKey = mkPreludeTyConUnique 100
1575 matchTyConKey = mkPreludeTyConUnique 101
1576 clauseTyConKey = mkPreludeTyConUnique 102
1577 qTyConKey = mkPreludeTyConUnique 103
1578 expQTyConKey = mkPreludeTyConUnique 104
1579 decQTyConKey = mkPreludeTyConUnique 105
1580 patTyConKey = mkPreludeTyConUnique 106
1581 matchQTyConKey = mkPreludeTyConUnique 107
1582 clauseQTyConKey = mkPreludeTyConUnique 108
1583 stmtQTyConKey = mkPreludeTyConUnique 109
1584 conQTyConKey = mkPreludeTyConUnique 110
1585 typeQTyConKey = mkPreludeTyConUnique 111
1586 typeTyConKey = mkPreludeTyConUnique 112
1587 decTyConKey = mkPreludeTyConUnique 113
1588 varStrictTypeQTyConKey = mkPreludeTyConUnique 114
1589 strictTypeQTyConKey = mkPreludeTyConUnique 115
1590 fieldExpTyConKey = mkPreludeTyConUnique 116
1591 fieldPatTyConKey = mkPreludeTyConUnique 117
1592 nameTyConKey = mkPreludeTyConUnique 118
1593 patQTyConKey = mkPreludeTyConUnique 119
1594 fieldPatQTyConKey = mkPreludeTyConUnique 120
1595 fieldExpQTyConKey = mkPreludeTyConUnique 121
1596 funDepTyConKey = mkPreludeTyConUnique 122
1598 -- IdUniques available: 200-399
1599 -- If you want to change this, make sure you check in PrelNames
1601 returnQIdKey = mkPreludeMiscIdUnique 200
1602 bindQIdKey = mkPreludeMiscIdUnique 201
1603 sequenceQIdKey = mkPreludeMiscIdUnique 202
1604 liftIdKey = mkPreludeMiscIdUnique 203
1605 newNameIdKey = mkPreludeMiscIdUnique 204
1606 mkNameIdKey = mkPreludeMiscIdUnique 205
1607 mkNameG_vIdKey = mkPreludeMiscIdUnique 206
1608 mkNameG_dIdKey = mkPreludeMiscIdUnique 207
1609 mkNameG_tcIdKey = mkPreludeMiscIdUnique 208
1610 mkNameLIdKey = mkPreludeMiscIdUnique 209
1614 charLIdKey = mkPreludeMiscIdUnique 210
1615 stringLIdKey = mkPreludeMiscIdUnique 211
1616 integerLIdKey = mkPreludeMiscIdUnique 212
1617 intPrimLIdKey = mkPreludeMiscIdUnique 213
1618 floatPrimLIdKey = mkPreludeMiscIdUnique 214
1619 doublePrimLIdKey = mkPreludeMiscIdUnique 215
1620 rationalLIdKey = mkPreludeMiscIdUnique 216
1623 litPIdKey = mkPreludeMiscIdUnique 220
1624 varPIdKey = mkPreludeMiscIdUnique 221
1625 tupPIdKey = mkPreludeMiscIdUnique 222
1626 conPIdKey = mkPreludeMiscIdUnique 223
1627 infixPIdKey = mkPreludeMiscIdUnique 312
1628 tildePIdKey = mkPreludeMiscIdUnique 224
1629 asPIdKey = mkPreludeMiscIdUnique 225
1630 wildPIdKey = mkPreludeMiscIdUnique 226
1631 recPIdKey = mkPreludeMiscIdUnique 227
1632 listPIdKey = mkPreludeMiscIdUnique 228
1633 sigPIdKey = mkPreludeMiscIdUnique 229
1635 -- type FieldPat = ...
1636 fieldPatIdKey = mkPreludeMiscIdUnique 230
1639 matchIdKey = mkPreludeMiscIdUnique 231
1641 -- data Clause = ...
1642 clauseIdKey = mkPreludeMiscIdUnique 232
1645 varEIdKey = mkPreludeMiscIdUnique 240
1646 conEIdKey = mkPreludeMiscIdUnique 241
1647 litEIdKey = mkPreludeMiscIdUnique 242
1648 appEIdKey = mkPreludeMiscIdUnique 243
1649 infixEIdKey = mkPreludeMiscIdUnique 244
1650 infixAppIdKey = mkPreludeMiscIdUnique 245
1651 sectionLIdKey = mkPreludeMiscIdUnique 246
1652 sectionRIdKey = mkPreludeMiscIdUnique 247
1653 lamEIdKey = mkPreludeMiscIdUnique 248
1654 tupEIdKey = mkPreludeMiscIdUnique 249
1655 condEIdKey = mkPreludeMiscIdUnique 250
1656 letEIdKey = mkPreludeMiscIdUnique 251
1657 caseEIdKey = mkPreludeMiscIdUnique 252
1658 doEIdKey = mkPreludeMiscIdUnique 253
1659 compEIdKey = mkPreludeMiscIdUnique 254
1660 fromEIdKey = mkPreludeMiscIdUnique 255
1661 fromThenEIdKey = mkPreludeMiscIdUnique 256
1662 fromToEIdKey = mkPreludeMiscIdUnique 257
1663 fromThenToEIdKey = mkPreludeMiscIdUnique 258
1664 listEIdKey = mkPreludeMiscIdUnique 259
1665 sigEIdKey = mkPreludeMiscIdUnique 260
1666 recConEIdKey = mkPreludeMiscIdUnique 261
1667 recUpdEIdKey = mkPreludeMiscIdUnique 262
1669 -- type FieldExp = ...
1670 fieldExpIdKey = mkPreludeMiscIdUnique 265
1673 guardedBIdKey = mkPreludeMiscIdUnique 266
1674 normalBIdKey = mkPreludeMiscIdUnique 267
1677 normalGEIdKey = mkPreludeMiscIdUnique 310
1678 patGEIdKey = mkPreludeMiscIdUnique 311
1681 bindSIdKey = mkPreludeMiscIdUnique 268
1682 letSIdKey = mkPreludeMiscIdUnique 269
1683 noBindSIdKey = mkPreludeMiscIdUnique 270
1684 parSIdKey = mkPreludeMiscIdUnique 271
1687 funDIdKey = mkPreludeMiscIdUnique 272
1688 valDIdKey = mkPreludeMiscIdUnique 273
1689 dataDIdKey = mkPreludeMiscIdUnique 274
1690 newtypeDIdKey = mkPreludeMiscIdUnique 275
1691 tySynDIdKey = mkPreludeMiscIdUnique 276
1692 classDIdKey = mkPreludeMiscIdUnique 277
1693 instanceDIdKey = mkPreludeMiscIdUnique 278
1694 sigDIdKey = mkPreludeMiscIdUnique 279
1695 forImpDIdKey = mkPreludeMiscIdUnique 297
1698 cxtIdKey = mkPreludeMiscIdUnique 280
1700 -- data Strict = ...
1701 isStrictKey = mkPreludeMiscIdUnique 281
1702 notStrictKey = mkPreludeMiscIdUnique 282
1705 normalCIdKey = mkPreludeMiscIdUnique 283
1706 recCIdKey = mkPreludeMiscIdUnique 284
1707 infixCIdKey = mkPreludeMiscIdUnique 285
1708 forallCIdKey = mkPreludeMiscIdUnique 288
1710 -- type StrictType = ...
1711 strictTKey = mkPreludeMiscIdUnique 286
1713 -- type VarStrictType = ...
1714 varStrictTKey = mkPreludeMiscIdUnique 287
1717 forallTIdKey = mkPreludeMiscIdUnique 290
1718 varTIdKey = mkPreludeMiscIdUnique 291
1719 conTIdKey = mkPreludeMiscIdUnique 292
1720 tupleTIdKey = mkPreludeMiscIdUnique 294
1721 arrowTIdKey = mkPreludeMiscIdUnique 295
1722 listTIdKey = mkPreludeMiscIdUnique 296
1723 appTIdKey = mkPreludeMiscIdUnique 293
1725 -- data Callconv = ...
1726 cCallIdKey = mkPreludeMiscIdUnique 300
1727 stdCallIdKey = mkPreludeMiscIdUnique 301
1729 -- data Safety = ...
1730 unsafeIdKey = mkPreludeMiscIdUnique 305
1731 safeIdKey = mkPreludeMiscIdUnique 306
1732 threadsafeIdKey = mkPreludeMiscIdUnique 307
1734 -- data FunDep = ...
1735 funDepIdKey = mkPreludeMiscIdUnique 320