1 -----------------------------------------------------------------------------
3 -- (c) The University of Glasgow 2006
5 -- The purpose of this module is to transform an HsExpr into a CoreExpr which
6 -- when evaluated, returns a (Meta.Q Meta.Exp) computation analogous to the
7 -- input HsExpr. We do this in the DsM monad, which supplies access to
8 -- CoreExpr's of the "smart constructors" of the Meta.Exp datatype.
10 -- It also defines a bunch of knownKeyNames, in the same way as is done
11 -- in prelude/PrelNames. It's much more convenient to do it here, becuase
12 -- otherwise we have to recompile PrelNames whenever we add a Name, which is
13 -- a Royal Pain (triggers other recompilation).
14 -----------------------------------------------------------------------------
17 -- The above warning supression flag is a temporary kludge.
18 -- While working on this module you are encouraged to remove it and fix
19 -- any warnings in the module. See
20 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
23 module DsMeta( dsBracket,
24 templateHaskellNames, qTyConName, nameTyConName,
25 liftName, expQTyConName, decQTyConName, typeQTyConName,
26 decTyConName, typeTyConName, mkNameG_dName, mkNameG_vName, mkNameG_tcName
29 #include "HsVersions.h"
31 import {-# SOURCE #-} DsExpr ( dsExpr )
37 import qualified Language.Haskell.TH as TH
42 -- To avoid clashes with DsMeta.varName we must make a local alias for
43 -- OccName.varName we do this by removing varName from the import of
44 -- OccName above, making a qualified instance of OccName and using
45 -- OccNameAlias.varName where varName ws previously used in this file.
46 import qualified OccName
70 -----------------------------------------------------------------------------
71 dsBracket :: HsBracket Name -> [PendingSplice] -> DsM CoreExpr
72 -- Returns a CoreExpr of type TH.ExpQ
73 -- The quoted thing is parameterised over Name, even though it has
74 -- been type checked. We don't want all those type decorations!
76 dsBracket brack splices
77 = dsExtendMetaEnv new_bit (do_brack brack)
79 new_bit = mkNameEnv [(n, Splice (unLoc e)) | (n,e) <- splices]
81 do_brack (VarBr n) = do { MkC e1 <- lookupOcc n ; return e1 }
82 do_brack (ExpBr e) = do { MkC e1 <- repLE e ; return e1 }
83 do_brack (PatBr p) = do { MkC p1 <- repLP p ; return p1 }
84 do_brack (TypBr t) = do { MkC t1 <- repLTy t ; return t1 }
85 do_brack (DecBr ds) = do { MkC ds1 <- repTopDs ds ; return ds1 }
87 {- -------------- Examples --------------------
91 gensym (unpackString "x"#) `bindQ` \ x1::String ->
92 lam (pvar x1) (var x1)
95 [| \x -> $(f [| x |]) |]
97 gensym (unpackString "x"#) `bindQ` \ x1::String ->
98 lam (pvar x1) (f (var x1))
102 -------------------------------------------------------
104 -------------------------------------------------------
106 repTopDs :: HsGroup Name -> DsM (Core (TH.Q [TH.Dec]))
108 = do { let { bndrs = map unLoc (groupBinders group) } ;
109 ss <- mkGenSyms bndrs ;
111 -- Bind all the names mainly to avoid repeated use of explicit strings.
113 -- do { t :: String <- genSym "T" ;
114 -- return (Data t [] ...more t's... }
115 -- The other important reason is that the output must mention
116 -- only "T", not "Foo:T" where Foo is the current module
119 decls <- addBinds ss (do {
120 val_ds <- rep_val_binds (hs_valds group) ;
121 tycl_ds <- mapM repTyClD (hs_tyclds group) ;
122 inst_ds <- mapM repInstD' (hs_instds group) ;
123 for_ds <- mapM repForD (hs_fords group) ;
125 return (de_loc $ sort_by_loc $ val_ds ++ catMaybes tycl_ds ++ inst_ds ++ for_ds) }) ;
127 decl_ty <- lookupType decQTyConName ;
128 let { core_list = coreList' decl_ty decls } ;
130 dec_ty <- lookupType decTyConName ;
131 q_decs <- repSequenceQ dec_ty core_list ;
133 wrapNongenSyms ss q_decs
134 -- Do *not* gensym top-level binders
137 groupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
138 hs_fords = foreign_decls })
139 -- Collect the binders of a Group
140 = collectHsValBinders val_decls ++
141 [n | d <- tycl_decls, n <- tyClDeclNames (unLoc d)] ++
142 [n | L _ (ForeignImport n _ _) <- foreign_decls]
145 {- Note [Binders and occurrences]
146 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
147 When we desugar [d| data T = MkT |]
149 Data "T" [] [Con "MkT" []] []
151 Data "Foo:T" [] [Con "Foo:MkT" []] []
152 That is, the new data decl should fit into whatever new module it is
153 asked to fit in. We do *not* clone, though; no need for this:
160 then we must desugar to
161 foo = Data "Foo:T" [] [Con "Foo:MkT" []] []
163 So in repTopDs we bring the binders into scope with mkGenSyms and addBinds.
164 And we use lookupOcc, rather than lookupBinder
165 in repTyClD and repC.
169 repTyClD :: LTyClDecl Name -> DsM (Maybe (SrcSpan, Core TH.DecQ))
171 repTyClD (L loc (TyData { tcdND = DataType, tcdCtxt = cxt,
172 tcdLName = tc, tcdTyVars = tvs,
173 tcdCons = cons, tcdDerivs = mb_derivs }))
174 = do { tc1 <- lookupLOcc tc ; -- See note [Binders and occurrences]
175 dec <- addTyVarBinds tvs $ \bndrs -> do {
176 cxt1 <- repLContext cxt ;
177 cons1 <- mapM repC cons ;
178 cons2 <- coreList conQTyConName cons1 ;
179 derivs1 <- repDerivs mb_derivs ;
180 bndrs1 <- coreList nameTyConName bndrs ;
181 repData cxt1 tc1 bndrs1 cons2 derivs1 } ;
182 return $ Just (loc, dec) }
184 repTyClD (L loc (TyData { tcdND = NewType, tcdCtxt = cxt,
185 tcdLName = tc, tcdTyVars = tvs,
186 tcdCons = [con], tcdDerivs = mb_derivs }))
187 = do { tc1 <- lookupLOcc tc ; -- See note [Binders and occurrences]
188 dec <- addTyVarBinds tvs $ \bndrs -> do {
189 cxt1 <- repLContext cxt ;
191 derivs1 <- repDerivs mb_derivs ;
192 bndrs1 <- coreList nameTyConName bndrs ;
193 repNewtype cxt1 tc1 bndrs1 con1 derivs1 } ;
194 return $ Just (loc, dec) }
196 repTyClD (L loc (TySynonym { tcdLName = tc, tcdTyVars = tvs, tcdSynRhs = ty }))
197 = do { tc1 <- lookupLOcc tc ; -- See note [Binders and occurrences]
198 dec <- addTyVarBinds tvs $ \bndrs -> do {
200 bndrs1 <- coreList nameTyConName bndrs ;
201 repTySyn tc1 bndrs1 ty1 } ;
202 return (Just (loc, dec)) }
204 repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
207 tcdSigs = sigs, tcdMeths = meth_binds }))
208 = do { cls1 <- lookupLOcc cls ; -- See note [Binders and occurrences]
209 dec <- addTyVarBinds tvs $ \bndrs -> do {
210 cxt1 <- repLContext cxt ;
211 sigs1 <- rep_sigs sigs ;
212 binds1 <- rep_binds meth_binds ;
213 fds1 <- repLFunDeps fds;
214 decls1 <- coreList decQTyConName (sigs1 ++ binds1) ;
215 bndrs1 <- coreList nameTyConName bndrs ;
216 repClass cxt1 cls1 bndrs1 fds1 decls1 } ;
217 return $ Just (loc, dec) }
220 repTyClD (L loc d) = putSrcSpanDs loc $
221 do { warnDs (hang ds_msg 4 (ppr d))
226 repLFunDeps :: [Located (FunDep Name)] -> DsM (Core [TH.FunDep])
227 repLFunDeps fds = do fds' <- mapM repLFunDep fds
228 fdList <- coreList funDepTyConName fds'
231 repLFunDep :: Located (FunDep Name) -> DsM (Core TH.FunDep)
232 repLFunDep (L _ (xs, ys)) = do xs' <- mapM lookupBinder xs
233 ys' <- mapM lookupBinder ys
234 xs_list <- coreList nameTyConName xs'
235 ys_list <- coreList nameTyConName ys'
236 repFunDep xs_list ys_list
238 repInstD' (L loc (InstDecl ty binds _ _)) -- Ignore user pragmas for now
239 = do { i <- addTyVarBinds tvs $ \tv_bndrs ->
240 -- We must bring the type variables into scope, so their occurrences
241 -- don't fail, even though the binders don't appear in the resulting
243 do { cxt1 <- repContext cxt
244 ; inst_ty1 <- repPred (HsClassP cls tys)
245 ; ss <- mkGenSyms (collectHsBindBinders binds)
246 ; binds1 <- addBinds ss (rep_binds binds)
247 ; decls1 <- coreList decQTyConName binds1
248 ; decls2 <- wrapNongenSyms ss decls1
249 -- wrapNonGenSyms: do not clone the class op names!
250 -- They must be called 'op' etc, not 'op34'
251 ; repInst cxt1 inst_ty1 decls2 }
255 (tvs, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
257 repForD :: Located (ForeignDecl Name) -> DsM (SrcSpan, Core TH.DecQ)
258 repForD (L loc (ForeignImport name typ (CImport cc s ch cn cis)))
259 = do MkC name' <- lookupLOcc name
260 MkC typ' <- repLTy typ
261 MkC cc' <- repCCallConv cc
262 MkC s' <- repSafety s
263 cis' <- conv_cimportspec cis
264 MkC str <- coreStringLit $ static
265 ++ unpackFS ch ++ " "
266 ++ unpackFS cn ++ " "
268 dec <- rep2 forImpDName [cc', s', str, name', typ']
271 conv_cimportspec (CLabel cls) = notHandled "Foreign label" (doubleQuotes (ppr cls))
272 conv_cimportspec (CFunction DynamicTarget) = return "dynamic"
273 conv_cimportspec (CFunction (StaticTarget fs)) = return (unpackFS fs)
274 conv_cimportspec CWrapper = return "wrapper"
276 CFunction (StaticTarget _) -> "static "
278 repForD decl = notHandled "Foreign declaration" (ppr decl)
280 repCCallConv :: CCallConv -> DsM (Core TH.Callconv)
281 repCCallConv CCallConv = rep2 cCallName []
282 repCCallConv StdCallConv = rep2 stdCallName []
284 repSafety :: Safety -> DsM (Core TH.Safety)
285 repSafety PlayRisky = rep2 unsafeName []
286 repSafety (PlaySafe False) = rep2 safeName []
287 repSafety (PlaySafe True) = rep2 threadsafeName []
289 ds_msg = ptext SLIT("Cannot desugar this Template Haskell declaration:")
291 -------------------------------------------------------
293 -------------------------------------------------------
295 repC :: LConDecl Name -> DsM (Core TH.ConQ)
296 repC (L loc (ConDecl con expl [] (L _ []) details ResTyH98 _))
297 = do { con1 <- lookupLOcc con ; -- See note [Binders and occurrences]
298 repConstr con1 details }
299 repC (L loc (ConDecl con expl tvs (L cloc ctxt) details ResTyH98 doc))
300 = do { addTyVarBinds tvs $ \bndrs -> do {
301 c' <- repC (L loc (ConDecl con expl [] (L cloc []) details ResTyH98 doc));
302 ctxt' <- repContext ctxt;
303 bndrs' <- coreList nameTyConName bndrs;
304 rep2 forallCName [unC bndrs', unC ctxt', unC c']
307 repC (L loc con_decl) -- GADTs
309 notHandled "GADT declaration" (ppr con_decl)
311 repBangTy :: LBangType Name -> DsM (Core (TH.StrictTypeQ))
315 rep2 strictTypeName [s, t]
317 (str, ty') = case ty of
318 L _ (HsBangTy _ ty) -> (isStrictName, ty)
319 other -> (notStrictName, ty)
321 -------------------------------------------------------
323 -------------------------------------------------------
325 repDerivs :: Maybe [LHsType Name] -> DsM (Core [TH.Name])
326 repDerivs Nothing = coreList nameTyConName []
327 repDerivs (Just ctxt)
328 = do { strs <- mapM rep_deriv ctxt ;
329 coreList nameTyConName strs }
331 rep_deriv :: LHsType Name -> DsM (Core TH.Name)
332 -- Deriving clauses must have the simple H98 form
333 rep_deriv (L _ (HsPredTy (HsClassP cls []))) = lookupOcc cls
334 rep_deriv other = notHandled "Non-H98 deriving clause" (ppr other)
337 -------------------------------------------------------
338 -- Signatures in a class decl, or a group of bindings
339 -------------------------------------------------------
341 rep_sigs :: [LSig Name] -> DsM [Core TH.DecQ]
342 rep_sigs sigs = do locs_cores <- rep_sigs' sigs
343 return $ de_loc $ sort_by_loc locs_cores
345 rep_sigs' :: [LSig Name] -> DsM [(SrcSpan, Core TH.DecQ)]
346 -- We silently ignore ones we don't recognise
347 rep_sigs' sigs = do { sigs1 <- mapM rep_sig sigs ;
348 return (concat sigs1) }
350 rep_sig :: LSig Name -> DsM [(SrcSpan, Core TH.DecQ)]
352 -- Empty => Too hard, signature ignored
353 rep_sig (L loc (TypeSig nm ty)) = rep_proto nm ty loc
354 rep_sig other = return []
356 rep_proto :: Located Name -> LHsType Name -> SrcSpan -> DsM [(SrcSpan, Core TH.DecQ)]
357 rep_proto nm ty loc = do { nm1 <- lookupLOcc nm ;
359 sig <- repProto nm1 ty1 ;
360 return [(loc, sig)] }
363 -------------------------------------------------------
365 -------------------------------------------------------
367 -- gensym a list of type variables and enter them into the meta environment;
368 -- the computations passed as the second argument is executed in that extended
369 -- meta environment and gets the *new* names on Core-level as an argument
371 addTyVarBinds :: [LHsTyVarBndr Name] -- the binders to be added
372 -> ([Core TH.Name] -> DsM (Core (TH.Q a))) -- action in the ext env
373 -> DsM (Core (TH.Q a))
374 addTyVarBinds tvs m =
376 let names = map (hsTyVarName.unLoc) tvs
377 freshNames <- mkGenSyms names
378 term <- addBinds freshNames $ do
379 bndrs <- mapM lookupBinder names
381 wrapGenSyns freshNames term
383 -- represent a type context
385 repLContext :: LHsContext Name -> DsM (Core TH.CxtQ)
386 repLContext (L _ ctxt) = repContext ctxt
388 repContext :: HsContext Name -> DsM (Core TH.CxtQ)
390 preds <- mapM repLPred ctxt
391 predList <- coreList typeQTyConName preds
394 -- represent a type predicate
396 repLPred :: LHsPred Name -> DsM (Core TH.TypeQ)
397 repLPred (L _ p) = repPred p
399 repPred :: HsPred Name -> DsM (Core TH.TypeQ)
400 repPred (HsClassP cls tys) = do
401 tcon <- repTy (HsTyVar cls)
404 repPred p@(HsEqualP _ _) = notHandled "Equational constraint" (ppr p)
405 repPred p@(HsIParam _ _) = notHandled "Implicit parameter constraint" (ppr p)
407 -- yield the representation of a list of types
409 repLTys :: [LHsType Name] -> DsM [Core TH.TypeQ]
410 repLTys tys = mapM repLTy tys
414 repLTy :: LHsType Name -> DsM (Core TH.TypeQ)
415 repLTy (L _ ty) = repTy ty
417 repTy :: HsType Name -> DsM (Core TH.TypeQ)
418 repTy (HsForAllTy _ tvs ctxt ty) =
419 addTyVarBinds tvs $ \bndrs -> do
420 ctxt1 <- repLContext ctxt
422 bndrs1 <- coreList nameTyConName bndrs
423 repTForall bndrs1 ctxt1 ty1
426 | isTvOcc (nameOccName n) = do
432 repTy (HsAppTy f a) = do
436 repTy (HsFunTy f a) = do
439 tcon <- repArrowTyCon
440 repTapps tcon [f1, a1]
441 repTy (HsListTy t) = do
445 repTy (HsPArrTy t) = do
447 tcon <- repTy (HsTyVar (tyConName parrTyCon))
449 repTy (HsTupleTy tc tys) = do
451 tcon <- repTupleTyCon (length tys)
453 repTy (HsOpTy ty1 n ty2) = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1)
455 repTy (HsParTy t) = repLTy t
456 repTy (HsPredTy pred) = repPred pred
457 repTy ty@(HsNumTy _) = notHandled "Number types (for generics)" (ppr ty)
458 repTy ty = notHandled "Exotic form of type" (ppr ty)
461 -----------------------------------------------------------------------------
463 -----------------------------------------------------------------------------
465 repLEs :: [LHsExpr Name] -> DsM (Core [TH.ExpQ])
466 repLEs es = do { es' <- mapM repLE es ;
467 coreList expQTyConName es' }
469 -- FIXME: some of these panics should be converted into proper error messages
470 -- unless we can make sure that constructs, which are plainly not
471 -- supported in TH already lead to error messages at an earlier stage
472 repLE :: LHsExpr Name -> DsM (Core TH.ExpQ)
473 repLE (L loc e) = putSrcSpanDs loc (repE e)
475 repE :: HsExpr Name -> DsM (Core TH.ExpQ)
477 do { mb_val <- dsLookupMetaEnv x
479 Nothing -> do { str <- globalVar x
480 ; repVarOrCon x str }
481 Just (Bound y) -> repVarOrCon x (coreVar y)
482 Just (Splice e) -> do { e' <- dsExpr e
483 ; return (MkC e') } }
484 repE e@(HsIPVar x) = notHandled "Implicit parameters" (ppr e)
486 -- Remember, we're desugaring renamer output here, so
487 -- HsOverlit can definitely occur
488 repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
489 repE (HsLit l) = do { a <- repLiteral l; repLit a }
490 repE (HsLam (MatchGroup [m] _)) = repLambda m
491 repE (HsApp x y) = do {a <- repLE x; b <- repLE y; repApp a b}
493 repE (OpApp e1 op fix e2) =
494 do { arg1 <- repLE e1;
497 repInfixApp arg1 the_op arg2 }
498 repE (NegApp x nm) = do
500 negateVar <- lookupOcc negateName >>= repVar
502 repE (HsPar x) = repLE x
503 repE (SectionL x y) = do { a <- repLE x; b <- repLE y; repSectionL a b }
504 repE (SectionR x y) = do { a <- repLE x; b <- repLE y; repSectionR a b }
505 repE (HsCase e (MatchGroup ms _)) = do { arg <- repLE e
506 ; ms2 <- mapM repMatchTup ms
507 ; repCaseE arg (nonEmptyCoreList ms2) }
508 repE (HsIf x y z) = do
513 repE (HsLet bs e) = do { (ss,ds) <- repBinds bs
514 ; e2 <- addBinds ss (repLE e)
517 -- FIXME: I haven't got the types here right yet
518 repE (HsDo DoExpr sts body ty)
519 = do { (ss,zs) <- repLSts sts;
520 body' <- addBinds ss $ repLE body;
521 ret <- repNoBindSt body';
522 e <- repDoE (nonEmptyCoreList (zs ++ [ret]));
524 repE (HsDo ListComp sts body ty)
525 = do { (ss,zs) <- repLSts sts;
526 body' <- addBinds ss $ repLE body;
527 ret <- repNoBindSt body';
528 e <- repComp (nonEmptyCoreList (zs ++ [ret]));
530 repE e@(HsDo _ _ _ _) = notHandled "mdo and [: :]" (ppr e)
531 repE (ExplicitList ty es) = do { xs <- repLEs es; repListExp xs }
532 repE e@(ExplicitPArr ty es) = notHandled "Parallel arrays" (ppr e)
533 repE e@(ExplicitTuple es boxed)
534 | isBoxed boxed = do { xs <- repLEs es; repTup xs }
535 | otherwise = notHandled "Unboxed tuples" (ppr e)
536 repE (RecordCon c _ flds)
537 = do { x <- lookupLOcc c;
538 fs <- repFields flds;
540 repE (RecordUpd e flds _ _ _)
542 fs <- repFields flds;
545 repE (ExprWithTySig e ty) = do { e1 <- repLE e; t1 <- repLTy ty; repSigExp e1 t1 }
546 repE (ArithSeq _ aseq) =
548 From e -> do { ds1 <- repLE e; repFrom ds1 }
557 FromThenTo e1 e2 e3 -> do
561 repFromThenTo ds1 ds2 ds3
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) }
568 -- Should not happen; statically checked
570 repE e@(PArrSeq {}) = notHandled "Parallel arrays" (ppr e)
571 repE e@(HsCoreAnn {}) = notHandled "Core annotations" (ppr e)
572 repE e@(HsSCC {}) = notHandled "Cost centres" (ppr e)
573 repE e@(HsTickPragma {}) = notHandled "Tick Pragma" (ppr e)
574 repE e@(HsBracketOut {}) = notHandled "TH brackets" (ppr e)
575 repE e = notHandled "Expression form" (ppr e)
577 -----------------------------------------------------------------------------
578 -- Building representations of auxillary structures like Match, Clause, Stmt,
580 repMatchTup :: LMatch Name -> DsM (Core TH.MatchQ)
581 repMatchTup (L _ (Match [p] ty (GRHSs guards wheres))) =
582 do { ss1 <- mkGenSyms (collectPatBinders p)
583 ; addBinds ss1 $ do {
585 ; (ss2,ds) <- repBinds wheres
586 ; addBinds ss2 $ do {
587 ; gs <- repGuards guards
588 ; match <- repMatch p1 gs ds
589 ; wrapGenSyns (ss1++ss2) match }}}
590 repMatchTup other = panic "repMatchTup: case alt with more than one arg"
592 repClauseTup :: LMatch Name -> DsM (Core TH.ClauseQ)
593 repClauseTup (L _ (Match ps ty (GRHSs guards wheres))) =
594 do { ss1 <- mkGenSyms (collectPatsBinders ps)
595 ; addBinds ss1 $ do {
597 ; (ss2,ds) <- repBinds wheres
598 ; addBinds ss2 $ do {
599 gs <- repGuards guards
600 ; clause <- repClause ps1 gs ds
601 ; wrapGenSyns (ss1++ss2) clause }}}
603 repGuards :: [LGRHS Name] -> DsM (Core TH.BodyQ)
604 repGuards [L _ (GRHS [] e)]
605 = do {a <- repLE e; repNormal a }
607 = do { zs <- mapM process other;
608 let {(xs, ys) = unzip zs};
609 gd <- repGuarded (nonEmptyCoreList ys);
610 wrapGenSyns (concat xs) gd }
612 process :: LGRHS Name -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp))))
613 process (L _ (GRHS [L _ (ExprStmt e1 _ _)] e2))
614 = do { x <- repLNormalGE e1 e2;
616 process (L _ (GRHS ss rhs))
617 = do (gs, ss') <- repLSts ss
618 rhs' <- addBinds gs $ repLE rhs
619 g <- repPatGE (nonEmptyCoreList ss') rhs'
622 repFields :: HsRecordBinds Name -> DsM (Core [TH.Q TH.FieldExp])
623 repFields (HsRecFields { rec_flds = flds })
624 = do { fnames <- mapM lookupLOcc (map hsRecFieldId flds)
625 ; es <- mapM repLE (map hsRecFieldArg flds)
626 ; fs <- zipWithM repFieldExp fnames es
627 ; coreList fieldExpQTyConName fs }
630 -----------------------------------------------------------------------------
631 -- Representing Stmt's is tricky, especially if bound variables
632 -- shadow each other. Consider: [| do { x <- f 1; x <- f x; g x } |]
633 -- First gensym new names for every variable in any of the patterns.
634 -- both static (x'1 and x'2), and dynamic ((gensym "x") and (gensym "y"))
635 -- if variables didn't shaddow, the static gensym wouldn't be necessary
636 -- and we could reuse the original names (x and x).
638 -- do { x'1 <- gensym "x"
639 -- ; x'2 <- gensym "x"
640 -- ; doE [ BindSt (pvar x'1) [| f 1 |]
641 -- , BindSt (pvar x'2) [| f x |]
642 -- , NoBindSt [| g x |]
646 -- The strategy is to translate a whole list of do-bindings by building a
647 -- bigger environment, and a bigger set of meta bindings
648 -- (like: x'1 <- gensym "x" ) and then combining these with the translations
649 -- of the expressions within the Do
651 -----------------------------------------------------------------------------
652 -- The helper function repSts computes the translation of each sub expression
653 -- and a bunch of prefix bindings denoting the dynamic renaming.
655 repLSts :: [LStmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
656 repLSts stmts = repSts (map unLoc stmts)
658 repSts :: [Stmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
659 repSts (BindStmt p e _ _ : ss) =
661 ; ss1 <- mkGenSyms (collectPatBinders p)
662 ; addBinds ss1 $ do {
664 ; (ss2,zs) <- repSts ss
665 ; z <- repBindSt p1 e2
666 ; return (ss1++ss2, z : zs) }}
667 repSts (LetStmt bs : ss) =
668 do { (ss1,ds) <- repBinds bs
670 ; (ss2,zs) <- addBinds ss1 (repSts ss)
671 ; return (ss1++ss2, z : zs) }
672 repSts (ExprStmt e _ _ : ss) =
674 ; z <- repNoBindSt e2
675 ; (ss2,zs) <- repSts ss
676 ; return (ss2, z : zs) }
677 repSts [] = return ([],[])
678 repSts other = notHandled "Exotic statement" (ppr other)
681 -----------------------------------------------------------
683 -----------------------------------------------------------
685 repBinds :: HsLocalBinds Name -> DsM ([GenSymBind], Core [TH.DecQ])
686 repBinds EmptyLocalBinds
687 = do { core_list <- coreList decQTyConName []
688 ; return ([], core_list) }
690 repBinds b@(HsIPBinds _) = notHandled "Implicit parameters" (ppr b)
692 repBinds (HsValBinds decs)
693 = do { let { bndrs = map unLoc (collectHsValBinders decs) }
694 -- No need to worrry about detailed scopes within
695 -- the binding group, because we are talking Names
696 -- here, so we can safely treat it as a mutually
698 ; ss <- mkGenSyms bndrs
699 ; prs <- addBinds ss (rep_val_binds decs)
700 ; core_list <- coreList decQTyConName
701 (de_loc (sort_by_loc prs))
702 ; return (ss, core_list) }
704 rep_val_binds :: HsValBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
705 -- Assumes: all the binders of the binding are alrady in the meta-env
706 rep_val_binds (ValBindsOut binds sigs)
707 = do { core1 <- rep_binds' (unionManyBags (map snd binds))
708 ; core2 <- rep_sigs' sigs
709 ; return (core1 ++ core2) }
710 rep_val_binds (ValBindsIn binds sigs)
711 = panic "rep_val_binds: ValBindsIn"
713 rep_binds :: LHsBinds Name -> DsM [Core TH.DecQ]
714 rep_binds binds = do { binds_w_locs <- rep_binds' binds
715 ; return (de_loc (sort_by_loc binds_w_locs)) }
717 rep_binds' :: LHsBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
718 rep_binds' binds = mapM rep_bind (bagToList binds)
720 rep_bind :: LHsBind Name -> DsM (SrcSpan, Core TH.DecQ)
721 -- Assumes: all the binders of the binding are alrady in the meta-env
723 -- Note GHC treats declarations of a variable (not a pattern)
724 -- e.g. x = g 5 as a Fun MonoBinds. This is indicated by a single match
725 -- with an empty list of patterns
726 rep_bind (L loc (FunBind { fun_id = fn,
727 fun_matches = MatchGroup [L _ (Match [] ty (GRHSs guards wheres))] _ }))
728 = do { (ss,wherecore) <- repBinds wheres
729 ; guardcore <- addBinds ss (repGuards guards)
730 ; fn' <- lookupLBinder fn
732 ; ans <- repVal p guardcore wherecore
733 ; ans' <- wrapGenSyns ss ans
734 ; return (loc, ans') }
736 rep_bind (L loc (FunBind { fun_id = fn, fun_matches = MatchGroup ms _ }))
737 = do { ms1 <- mapM repClauseTup ms
738 ; fn' <- lookupLBinder fn
739 ; ans <- repFun fn' (nonEmptyCoreList ms1)
740 ; return (loc, ans) }
742 rep_bind (L loc (PatBind { pat_lhs = pat, pat_rhs = GRHSs guards wheres }))
743 = do { patcore <- repLP pat
744 ; (ss,wherecore) <- repBinds wheres
745 ; guardcore <- addBinds ss (repGuards guards)
746 ; ans <- repVal patcore guardcore wherecore
747 ; ans' <- wrapGenSyns ss ans
748 ; return (loc, ans') }
750 rep_bind (L loc (VarBind { var_id = v, var_rhs = e}))
751 = do { v' <- lookupBinder v
754 ; patcore <- repPvar v'
755 ; empty_decls <- coreList decQTyConName []
756 ; ans <- repVal patcore x empty_decls
757 ; return (srcLocSpan (getSrcLoc v), ans) }
759 rep_bind other = panic "rep_bind: AbsBinds"
761 -----------------------------------------------------------------------------
762 -- Since everything in a Bind is mutually recursive we need rename all
763 -- all the variables simultaneously. For example:
764 -- [| AndMonoBinds (f x = x + g 2) (g x = f 1 + 2) |] would translate to
765 -- do { f'1 <- gensym "f"
766 -- ; g'2 <- gensym "g"
767 -- ; [ do { x'3 <- gensym "x"; fun f'1 [pvar x'3] [| x + g2 |]},
768 -- do { x'4 <- gensym "x"; fun g'2 [pvar x'4] [| f 1 + 2 |]}
770 -- This requires collecting the bindings (f'1 <- gensym "f"), and the
771 -- environment ( f |-> f'1 ) from each binding, and then unioning them
772 -- together. As we do this we collect GenSymBinds's which represent the renamed
773 -- variables bound by the Bindings. In order not to lose track of these
774 -- representations we build a shadow datatype MB with the same structure as
775 -- MonoBinds, but which has slots for the representations
778 -----------------------------------------------------------------------------
779 -- GHC allows a more general form of lambda abstraction than specified
780 -- by Haskell 98. In particular it allows guarded lambda's like :
781 -- (\ x | even x -> 0 | odd x -> 1) at the moment we can't represent this in
782 -- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like
783 -- (\ p1 .. pn -> exp) by causing an error.
785 repLambda :: LMatch Name -> DsM (Core TH.ExpQ)
786 repLambda (L _ (Match ps _ (GRHSs [L _ (GRHS [] e)] EmptyLocalBinds)))
787 = do { let bndrs = collectPatsBinders ps ;
788 ; ss <- mkGenSyms bndrs
789 ; lam <- addBinds ss (
790 do { xs <- repLPs ps; body <- repLE e; repLam xs body })
791 ; wrapGenSyns ss lam }
793 repLambda (L _ m) = notHandled "Guarded labmdas" (pprMatch (LambdaExpr :: HsMatchContext Name) m)
796 -----------------------------------------------------------------------------
798 -- repP deals with patterns. It assumes that we have already
799 -- walked over the pattern(s) once to collect the binders, and
800 -- have extended the environment. So every pattern-bound
801 -- variable should already appear in the environment.
803 -- Process a list of patterns
804 repLPs :: [LPat Name] -> DsM (Core [TH.PatQ])
805 repLPs ps = do { ps' <- mapM repLP ps ;
806 coreList patQTyConName ps' }
808 repLP :: LPat Name -> DsM (Core TH.PatQ)
809 repLP (L _ p) = repP p
811 repP :: Pat Name -> DsM (Core TH.PatQ)
812 repP (WildPat _) = repPwild
813 repP (LitPat l) = do { l2 <- repLiteral l; repPlit l2 }
814 repP (VarPat x) = do { x' <- lookupBinder x; repPvar x' }
815 repP (LazyPat p) = do { p1 <- repLP p; repPtilde p1 }
816 repP (AsPat x p) = do { x' <- lookupLBinder x; p1 <- repLP p; repPaspat x' p1 }
817 repP (ParPat p) = repLP p
818 repP (ListPat ps _) = do { qs <- repLPs ps; repPlist qs }
819 repP (TuplePat ps _ _) = do { qs <- repLPs ps; repPtup qs }
820 repP (ConPatIn dc details)
821 = do { con_str <- lookupLOcc dc
823 PrefixCon ps -> do { qs <- repLPs ps; repPcon con_str qs }
824 RecCon rec -> do { let flds = rec_flds rec
825 ; vs <- sequence $ map lookupLOcc (map hsRecFieldId flds)
826 ; ps <- sequence $ map repLP (map hsRecFieldArg flds)
827 ; fps <- zipWithM (\x y -> rep2 fieldPatName [unC x,unC y]) vs ps
828 ; fps' <- coreList fieldPatQTyConName fps
829 ; repPrec con_str fps' }
830 InfixCon p1 p2 -> do { p1' <- repLP p1;
832 repPinfix p1' con_str p2' }
834 repP (NPat l Nothing _) = do { a <- repOverloadedLiteral l; repPlit a }
835 repP p@(NPat l (Just _) _) = notHandled "Negative overloaded patterns" (ppr p)
836 repP p@(SigPatIn {}) = notHandled "Type signatures in patterns" (ppr p)
837 -- The problem is to do with scoped type variables.
838 -- To implement them, we have to implement the scoping rules
839 -- here in DsMeta, and I don't want to do that today!
840 -- do { p' <- repLP p; t' <- repLTy t; repPsig p' t' }
841 -- repPsig :: Core TH.PatQ -> Core TH.TypeQ -> DsM (Core TH.PatQ)
842 -- repPsig (MkC p) (MkC t) = rep2 sigPName [p, t]
844 repP other = notHandled "Exotic pattern" (ppr other)
846 ----------------------------------------------------------
847 -- Declaration ordering helpers
849 sort_by_loc :: [(SrcSpan, a)] -> [(SrcSpan, a)]
850 sort_by_loc xs = sortBy comp xs
851 where comp x y = compare (fst x) (fst y)
853 de_loc :: [(a, b)] -> [b]
856 ----------------------------------------------------------
857 -- The meta-environment
859 -- A name/identifier association for fresh names of locally bound entities
860 type GenSymBind = (Name, Id) -- Gensym the string and bind it to the Id
861 -- I.e. (x, x_id) means
862 -- let x_id = gensym "x" in ...
864 -- Generate a fresh name for a locally bound entity
866 mkGenSyms :: [Name] -> DsM [GenSymBind]
867 -- We can use the existing name. For example:
868 -- [| \x_77 -> x_77 + x_77 |]
870 -- do { x_77 <- genSym "x"; .... }
871 -- We use the same x_77 in the desugared program, but with the type Bndr
874 -- We do make it an Internal name, though (hence localiseName)
876 -- Nevertheless, it's monadic because we have to generate nameTy
877 mkGenSyms ns = do { var_ty <- lookupType nameTyConName
878 ; return [(nm, mkLocalId (localiseName nm) var_ty) | nm <- ns] }
881 addBinds :: [GenSymBind] -> DsM a -> DsM a
882 -- Add a list of fresh names for locally bound entities to the
883 -- meta environment (which is part of the state carried around
884 -- by the desugarer monad)
885 addBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,Bound id) | (n,id) <- bs]) m
887 -- Look up a locally bound name
889 lookupLBinder :: Located Name -> DsM (Core TH.Name)
890 lookupLBinder (L _ n) = lookupBinder n
892 lookupBinder :: Name -> DsM (Core TH.Name)
894 = do { mb_val <- dsLookupMetaEnv n;
896 Just (Bound x) -> return (coreVar x)
897 other -> failWithDs msg }
899 msg = ptext SLIT("DsMeta: failed binder lookup when desugaring a TH bracket:") <+> ppr n
901 -- Look up a name that is either locally bound or a global name
903 -- * If it is a global name, generate the "original name" representation (ie,
904 -- the <module>:<name> form) for the associated entity
906 lookupLOcc :: Located Name -> DsM (Core TH.Name)
907 -- Lookup an occurrence; it can't be a splice.
908 -- Use the in-scope bindings if they exist
909 lookupLOcc (L _ n) = lookupOcc n
911 lookupOcc :: Name -> DsM (Core TH.Name)
913 = do { mb_val <- dsLookupMetaEnv n ;
915 Nothing -> globalVar n
916 Just (Bound x) -> return (coreVar x)
917 Just (Splice _) -> pprPanic "repE:lookupOcc" (ppr n)
920 lookupTvOcc :: Name -> DsM (Core TH.Name)
921 -- Type variables can't be staged and are not lexically scoped in TH
923 = do { mb_val <- dsLookupMetaEnv n ;
925 Just (Bound x) -> return (coreVar x)
926 other -> failWithDs msg
929 msg = vcat [ ptext SLIT("Illegal lexically-scoped type variable") <+> quotes (ppr n)
930 , ptext SLIT("Lexically scoped type variables are not supported by Template Haskell") ]
932 globalVar :: Name -> DsM (Core TH.Name)
933 -- Not bound by the meta-env
934 -- Could be top-level; or could be local
935 -- f x = $(g [| x |])
936 -- Here the x will be local
938 | isExternalName name
939 = do { MkC mod <- coreStringLit name_mod
940 ; MkC pkg <- coreStringLit name_pkg
941 ; MkC occ <- occNameLit name
942 ; rep2 mk_varg [pkg,mod,occ] }
944 = do { MkC occ <- occNameLit name
945 ; MkC uni <- coreIntLit (getKey (getUnique name))
946 ; rep2 mkNameLName [occ,uni] }
948 mod = nameModule name
949 name_mod = moduleNameString (moduleName mod)
950 name_pkg = packageIdString (modulePackageId mod)
951 name_occ = nameOccName name
952 mk_varg | OccName.isDataOcc name_occ = mkNameG_dName
953 | OccName.isVarOcc name_occ = mkNameG_vName
954 | OccName.isTcOcc name_occ = mkNameG_tcName
955 | otherwise = pprPanic "DsMeta.globalVar" (ppr name)
957 lookupType :: Name -- Name of type constructor (e.g. TH.ExpQ)
958 -> DsM Type -- The type
959 lookupType tc_name = do { tc <- dsLookupTyCon tc_name ;
960 return (mkTyConApp tc []) }
962 wrapGenSyns :: [GenSymBind]
963 -> Core (TH.Q a) -> DsM (Core (TH.Q a))
964 -- wrapGenSyns [(nm1,id1), (nm2,id2)] y
965 -- --> bindQ (gensym nm1) (\ id1 ->
966 -- bindQ (gensym nm2 (\ id2 ->
969 wrapGenSyns binds body@(MkC b)
970 = do { var_ty <- lookupType nameTyConName
973 [elt_ty] = tcTyConAppArgs (exprType b)
974 -- b :: Q a, so we can get the type 'a' by looking at the
975 -- argument type. NB: this relies on Q being a data/newtype,
976 -- not a type synonym
978 go var_ty [] = return body
979 go var_ty ((name,id) : binds)
980 = do { MkC body' <- go var_ty binds
981 ; lit_str <- occNameLit name
982 ; gensym_app <- repGensym lit_str
983 ; repBindQ var_ty elt_ty
984 gensym_app (MkC (Lam id body')) }
986 -- Just like wrapGenSym, but don't actually do the gensym
987 -- Instead use the existing name:
988 -- let x = "x" in ...
989 -- Only used for [Decl], and for the class ops in class
990 -- and instance decls
991 wrapNongenSyms :: [GenSymBind] -> Core a -> DsM (Core a)
992 wrapNongenSyms binds (MkC body)
993 = do { binds' <- mapM do_one binds ;
994 return (MkC (mkLets binds' body)) }
997 = do { MkC lit_str <- occNameLit name
998 ; MkC var <- rep2 mkNameName [lit_str]
999 ; return (NonRec id var) }
1001 occNameLit :: Name -> DsM (Core String)
1002 occNameLit n = coreStringLit (occNameString (nameOccName n))
1005 -- %*********************************************************************
1007 -- Constructing code
1009 -- %*********************************************************************
1011 -----------------------------------------------------------------------------
1012 -- PHANTOM TYPES for consistency. In order to make sure we do this correct
1013 -- we invent a new datatype which uses phantom types.
1015 newtype Core a = MkC CoreExpr
1018 rep2 :: Name -> [ CoreExpr ] -> DsM (Core a)
1019 rep2 n xs = do { id <- dsLookupGlobalId n
1020 ; return (MkC (foldl App (Var id) xs)) }
1022 -- Then we make "repConstructors" which use the phantom types for each of the
1023 -- smart constructors of the Meta.Meta datatypes.
1026 -- %*********************************************************************
1028 -- The 'smart constructors'
1030 -- %*********************************************************************
1032 --------------- Patterns -----------------
1033 repPlit :: Core TH.Lit -> DsM (Core TH.PatQ)
1034 repPlit (MkC l) = rep2 litPName [l]
1036 repPvar :: Core TH.Name -> DsM (Core TH.PatQ)
1037 repPvar (MkC s) = rep2 varPName [s]
1039 repPtup :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
1040 repPtup (MkC ps) = rep2 tupPName [ps]
1042 repPcon :: Core TH.Name -> Core [TH.PatQ] -> DsM (Core TH.PatQ)
1043 repPcon (MkC s) (MkC ps) = rep2 conPName [s, ps]
1045 repPrec :: Core TH.Name -> Core [(TH.Name,TH.PatQ)] -> DsM (Core TH.PatQ)
1046 repPrec (MkC c) (MkC rps) = rep2 recPName [c,rps]
1048 repPinfix :: Core TH.PatQ -> Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
1049 repPinfix (MkC p1) (MkC n) (MkC p2) = rep2 infixPName [p1, n, p2]
1051 repPtilde :: Core TH.PatQ -> DsM (Core TH.PatQ)
1052 repPtilde (MkC p) = rep2 tildePName [p]
1054 repPaspat :: Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
1055 repPaspat (MkC s) (MkC p) = rep2 asPName [s, p]
1057 repPwild :: DsM (Core TH.PatQ)
1058 repPwild = rep2 wildPName []
1060 repPlist :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
1061 repPlist (MkC ps) = rep2 listPName [ps]
1063 --------------- Expressions -----------------
1064 repVarOrCon :: Name -> Core TH.Name -> DsM (Core TH.ExpQ)
1065 repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
1066 | otherwise = repVar str
1068 repVar :: Core TH.Name -> DsM (Core TH.ExpQ)
1069 repVar (MkC s) = rep2 varEName [s]
1071 repCon :: Core TH.Name -> DsM (Core TH.ExpQ)
1072 repCon (MkC s) = rep2 conEName [s]
1074 repLit :: Core TH.Lit -> DsM (Core TH.ExpQ)
1075 repLit (MkC c) = rep2 litEName [c]
1077 repApp :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1078 repApp (MkC x) (MkC y) = rep2 appEName [x,y]
1080 repLam :: Core [TH.PatQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1081 repLam (MkC ps) (MkC e) = rep2 lamEName [ps, e]
1083 repTup :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
1084 repTup (MkC es) = rep2 tupEName [es]
1086 repCond :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1087 repCond (MkC x) (MkC y) (MkC z) = rep2 condEName [x,y,z]
1089 repLetE :: Core [TH.DecQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1090 repLetE (MkC ds) (MkC e) = rep2 letEName [ds, e]
1092 repCaseE :: Core TH.ExpQ -> Core [TH.MatchQ] -> DsM( Core TH.ExpQ)
1093 repCaseE (MkC e) (MkC ms) = rep2 caseEName [e, ms]
1095 repDoE :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
1096 repDoE (MkC ss) = rep2 doEName [ss]
1098 repComp :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
1099 repComp (MkC ss) = rep2 compEName [ss]
1101 repListExp :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
1102 repListExp (MkC es) = rep2 listEName [es]
1104 repSigExp :: Core TH.ExpQ -> Core TH.TypeQ -> DsM (Core TH.ExpQ)
1105 repSigExp (MkC e) (MkC t) = rep2 sigEName [e,t]
1107 repRecCon :: Core TH.Name -> Core [TH.Q TH.FieldExp]-> DsM (Core TH.ExpQ)
1108 repRecCon (MkC c) (MkC fs) = rep2 recConEName [c,fs]
1110 repRecUpd :: Core TH.ExpQ -> Core [TH.Q TH.FieldExp] -> DsM (Core TH.ExpQ)
1111 repRecUpd (MkC e) (MkC fs) = rep2 recUpdEName [e,fs]
1113 repFieldExp :: Core TH.Name -> Core TH.ExpQ -> DsM (Core (TH.Q TH.FieldExp))
1114 repFieldExp (MkC n) (MkC x) = rep2 fieldExpName [n,x]
1116 repInfixApp :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1117 repInfixApp (MkC x) (MkC y) (MkC z) = rep2 infixAppName [x,y,z]
1119 repSectionL :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1120 repSectionL (MkC x) (MkC y) = rep2 sectionLName [x,y]
1122 repSectionR :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1123 repSectionR (MkC x) (MkC y) = rep2 sectionRName [x,y]
1125 ------------ Right hand sides (guarded expressions) ----
1126 repGuarded :: Core [TH.Q (TH.Guard, TH.Exp)] -> DsM (Core TH.BodyQ)
1127 repGuarded (MkC pairs) = rep2 guardedBName [pairs]
1129 repNormal :: Core TH.ExpQ -> DsM (Core TH.BodyQ)
1130 repNormal (MkC e) = rep2 normalBName [e]
1132 ------------ Guards ----
1133 repLNormalGE :: LHsExpr Name -> LHsExpr Name -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1134 repLNormalGE g e = do g' <- repLE g
1138 repNormalGE :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1139 repNormalGE (MkC g) (MkC e) = rep2 normalGEName [g, e]
1141 repPatGE :: Core [TH.StmtQ] -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1142 repPatGE (MkC ss) (MkC e) = rep2 patGEName [ss, e]
1144 ------------- Stmts -------------------
1145 repBindSt :: Core TH.PatQ -> Core TH.ExpQ -> DsM (Core TH.StmtQ)
1146 repBindSt (MkC p) (MkC e) = rep2 bindSName [p,e]
1148 repLetSt :: Core [TH.DecQ] -> DsM (Core TH.StmtQ)
1149 repLetSt (MkC ds) = rep2 letSName [ds]
1151 repNoBindSt :: Core TH.ExpQ -> DsM (Core TH.StmtQ)
1152 repNoBindSt (MkC e) = rep2 noBindSName [e]
1154 -------------- Range (Arithmetic sequences) -----------
1155 repFrom :: Core TH.ExpQ -> DsM (Core TH.ExpQ)
1156 repFrom (MkC x) = rep2 fromEName [x]
1158 repFromThen :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1159 repFromThen (MkC x) (MkC y) = rep2 fromThenEName [x,y]
1161 repFromTo :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1162 repFromTo (MkC x) (MkC y) = rep2 fromToEName [x,y]
1164 repFromThenTo :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1165 repFromThenTo (MkC x) (MkC y) (MkC z) = rep2 fromThenToEName [x,y,z]
1167 ------------ Match and Clause Tuples -----------
1168 repMatch :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.MatchQ)
1169 repMatch (MkC p) (MkC bod) (MkC ds) = rep2 matchName [p, bod, ds]
1171 repClause :: Core [TH.PatQ] -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.ClauseQ)
1172 repClause (MkC ps) (MkC bod) (MkC ds) = rep2 clauseName [ps, bod, ds]
1174 -------------- Dec -----------------------------
1175 repVal :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1176 repVal (MkC p) (MkC b) (MkC ds) = rep2 valDName [p, b, ds]
1178 repFun :: Core TH.Name -> Core [TH.ClauseQ] -> DsM (Core TH.DecQ)
1179 repFun (MkC nm) (MkC b) = rep2 funDName [nm, b]
1181 repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core [TH.ConQ] -> Core [TH.Name] -> DsM (Core TH.DecQ)
1182 repData (MkC cxt) (MkC nm) (MkC tvs) (MkC cons) (MkC derivs)
1183 = rep2 dataDName [cxt, nm, tvs, cons, derivs]
1185 repNewtype :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core TH.ConQ -> Core [TH.Name] -> DsM (Core TH.DecQ)
1186 repNewtype (MkC cxt) (MkC nm) (MkC tvs) (MkC con) (MkC derivs)
1187 = rep2 newtypeDName [cxt, nm, tvs, con, derivs]
1189 repTySyn :: Core TH.Name -> Core [TH.Name] -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1190 repTySyn (MkC nm) (MkC tvs) (MkC rhs) = rep2 tySynDName [nm, tvs, rhs]
1192 repInst :: Core TH.CxtQ -> Core TH.TypeQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1193 repInst (MkC cxt) (MkC ty) (MkC ds) = rep2 instanceDName [cxt, ty, ds]
1195 repClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core [TH.FunDep] -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1196 repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds) = rep2 classDName [cxt, cls, tvs, fds, ds]
1198 repFunDep :: Core [TH.Name] -> Core [TH.Name] -> DsM (Core TH.FunDep)
1199 repFunDep (MkC xs) (MkC ys) = rep2 funDepName [xs, ys]
1201 repProto :: Core TH.Name -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1202 repProto (MkC s) (MkC ty) = rep2 sigDName [s, ty]
1204 repCtxt :: Core [TH.TypeQ] -> DsM (Core TH.CxtQ)
1205 repCtxt (MkC tys) = rep2 cxtName [tys]
1207 repConstr :: Core TH.Name -> HsConDeclDetails Name
1208 -> DsM (Core TH.ConQ)
1209 repConstr con (PrefixCon ps)
1210 = do arg_tys <- mapM repBangTy ps
1211 arg_tys1 <- coreList strictTypeQTyConName arg_tys
1212 rep2 normalCName [unC con, unC arg_tys1]
1213 repConstr con (RecCon ips)
1214 = do arg_vs <- mapM lookupLOcc (map cd_fld_name ips)
1215 arg_tys <- mapM repBangTy (map cd_fld_type ips)
1216 arg_vtys <- zipWithM (\x y -> rep2 varStrictTypeName [unC x, unC y])
1218 arg_vtys' <- coreList varStrictTypeQTyConName arg_vtys
1219 rep2 recCName [unC con, unC arg_vtys']
1220 repConstr con (InfixCon st1 st2)
1221 = do arg1 <- repBangTy st1
1222 arg2 <- repBangTy st2
1223 rep2 infixCName [unC arg1, unC con, unC arg2]
1225 ------------ Types -------------------
1227 repTForall :: Core [TH.Name] -> Core TH.CxtQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)
1228 repTForall (MkC tvars) (MkC ctxt) (MkC ty)
1229 = rep2 forallTName [tvars, ctxt, ty]
1231 repTvar :: Core TH.Name -> DsM (Core TH.TypeQ)
1232 repTvar (MkC s) = rep2 varTName [s]
1234 repTapp :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)
1235 repTapp (MkC t1) (MkC t2) = rep2 appTName [t1,t2]
1237 repTapps :: Core TH.TypeQ -> [Core TH.TypeQ] -> DsM (Core TH.TypeQ)
1238 repTapps f [] = return f
1239 repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
1241 --------- Type constructors --------------
1243 repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
1244 repNamedTyCon (MkC s) = rep2 conTName [s]
1246 repTupleTyCon :: Int -> DsM (Core TH.TypeQ)
1247 -- Note: not Core Int; it's easier to be direct here
1248 repTupleTyCon i = rep2 tupleTName [mkIntExpr (fromIntegral i)]
1250 repArrowTyCon :: DsM (Core TH.TypeQ)
1251 repArrowTyCon = rep2 arrowTName []
1253 repListTyCon :: DsM (Core TH.TypeQ)
1254 repListTyCon = rep2 listTName []
1257 ----------------------------------------------------------
1260 repLiteral :: HsLit -> DsM (Core TH.Lit)
1262 = do lit' <- case lit of
1263 HsIntPrim i -> mk_integer i
1264 HsInt i -> mk_integer i
1265 HsFloatPrim r -> mk_rational r
1266 HsDoublePrim r -> mk_rational r
1268 lit_expr <- dsLit lit'
1270 Just lit_name -> rep2 lit_name [lit_expr]
1271 Nothing -> notHandled "Exotic literal" (ppr lit)
1273 mb_lit_name = case lit of
1274 HsInteger _ _ -> Just integerLName
1275 HsInt _ -> Just integerLName
1276 HsIntPrim _ -> Just intPrimLName
1277 HsFloatPrim _ -> Just floatPrimLName
1278 HsDoublePrim _ -> Just doublePrimLName
1279 HsChar _ -> Just charLName
1280 HsString _ -> Just stringLName
1281 HsRat _ _ -> Just rationalLName
1284 mk_integer i = do integer_ty <- lookupType integerTyConName
1285 return $ HsInteger i integer_ty
1286 mk_rational r = do rat_ty <- lookupType rationalTyConName
1287 return $ HsRat r rat_ty
1288 mk_string s = do string_ty <- lookupType stringTyConName
1291 repOverloadedLiteral :: HsOverLit Name -> DsM (Core TH.Lit)
1292 repOverloadedLiteral (HsIntegral i _ _) = do { lit <- mk_integer i; repLiteral lit }
1293 repOverloadedLiteral (HsFractional f _ _) = do { lit <- mk_rational f; repLiteral lit }
1294 repOverloadedLiteral (HsIsString s _ _) = do { lit <- mk_string s; repLiteral lit }
1295 -- The type Rational will be in the environment, becuase
1296 -- the smart constructor 'TH.Syntax.rationalL' uses it in its type,
1297 -- and rationalL is sucked in when any TH stuff is used
1299 --------------- Miscellaneous -------------------
1301 repGensym :: Core String -> DsM (Core (TH.Q TH.Name))
1302 repGensym (MkC lit_str) = rep2 newNameName [lit_str]
1304 repBindQ :: Type -> Type -- a and b
1305 -> Core (TH.Q a) -> Core (a -> TH.Q b) -> DsM (Core (TH.Q b))
1306 repBindQ ty_a ty_b (MkC x) (MkC y)
1307 = rep2 bindQName [Type ty_a, Type ty_b, x, y]
1309 repSequenceQ :: Type -> Core [TH.Q a] -> DsM (Core (TH.Q [a]))
1310 repSequenceQ ty_a (MkC list)
1311 = rep2 sequenceQName [Type ty_a, list]
1313 ------------ Lists and Tuples -------------------
1314 -- turn a list of patterns into a single pattern matching a list
1316 coreList :: Name -- Of the TyCon of the element type
1317 -> [Core a] -> DsM (Core [a])
1319 = do { elt_ty <- lookupType tc_name; return (coreList' elt_ty es) }
1321 coreList' :: Type -- The element type
1322 -> [Core a] -> Core [a]
1323 coreList' elt_ty es = MkC (mkListExpr elt_ty (map unC es ))
1325 nonEmptyCoreList :: [Core a] -> Core [a]
1326 -- The list must be non-empty so we can get the element type
1327 -- Otherwise use coreList
1328 nonEmptyCoreList [] = panic "coreList: empty argument"
1329 nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs))
1331 corePair :: (Core a, Core b) -> Core (a,b)
1332 corePair (MkC x, MkC y) = MkC (mkCoreTup [x,y])
1334 coreStringLit :: String -> DsM (Core String)
1335 coreStringLit s = do { z <- mkStringExpr s; return(MkC z) }
1337 coreIntLit :: Int -> DsM (Core Int)
1338 coreIntLit i = return (MkC (mkIntExpr (fromIntegral i)))
1340 coreVar :: Id -> Core TH.Name -- The Id has type Name
1341 coreVar id = MkC (Var id)
1343 ----------------- Failure -----------------------
1344 notHandled :: String -> SDoc -> DsM a
1345 notHandled what doc = failWithDs msg
1347 msg = hang (text what <+> ptext SLIT("not (yet) handled by Template Haskell"))
1351 -- %************************************************************************
1353 -- The known-key names for Template Haskell
1355 -- %************************************************************************
1357 -- To add a name, do three things
1359 -- 1) Allocate a key
1361 -- 3) Add the name to knownKeyNames
1363 templateHaskellNames :: [Name]
1364 -- The names that are implicitly mentioned by ``bracket''
1365 -- Should stay in sync with the import list of DsMeta
1367 templateHaskellNames = [
1368 returnQName, bindQName, sequenceQName, newNameName, liftName,
1369 mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
1372 charLName, stringLName, integerLName, intPrimLName,
1373 floatPrimLName, doublePrimLName, rationalLName,
1375 litPName, varPName, tupPName, conPName, tildePName, infixPName,
1376 asPName, wildPName, recPName, listPName, sigPName,
1384 varEName, conEName, litEName, appEName, infixEName,
1385 infixAppName, sectionLName, sectionRName, lamEName, tupEName,
1386 condEName, letEName, caseEName, doEName, compEName,
1387 fromEName, fromThenEName, fromToEName, fromThenToEName,
1388 listEName, sigEName, recConEName, recUpdEName,
1392 guardedBName, normalBName,
1394 normalGEName, patGEName,
1396 bindSName, letSName, noBindSName, parSName,
1398 funDName, valDName, dataDName, newtypeDName, tySynDName,
1399 classDName, instanceDName, sigDName, forImpDName,
1403 isStrictName, notStrictName,
1405 normalCName, recCName, infixCName, forallCName,
1411 forallTName, varTName, conTName, appTName,
1412 tupleTName, arrowTName, listTName,
1414 cCallName, stdCallName,
1423 qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchQTyConName,
1424 clauseQTyConName, expQTyConName, fieldExpTyConName, stmtQTyConName,
1425 decQTyConName, conQTyConName, strictTypeQTyConName,
1426 varStrictTypeQTyConName, typeQTyConName, expTyConName, decTyConName,
1427 typeTyConName, matchTyConName, clauseTyConName, patQTyConName,
1428 fieldPatQTyConName, fieldExpQTyConName, funDepTyConName]
1431 thSyn = mkTHModule FSLIT("Language.Haskell.TH.Syntax")
1432 thLib = mkTHModule FSLIT("Language.Haskell.TH.Lib")
1434 mkTHModule m = mkModule thPackageId (mkModuleNameFS m)
1436 libFun = mk_known_key_name OccName.varName thLib
1437 libTc = mk_known_key_name OccName.tcName thLib
1438 thFun = mk_known_key_name OccName.varName thSyn
1439 thTc = mk_known_key_name OccName.tcName thSyn
1441 -------------------- TH.Syntax -----------------------
1442 qTyConName = thTc FSLIT("Q") qTyConKey
1443 nameTyConName = thTc FSLIT("Name") nameTyConKey
1444 fieldExpTyConName = thTc FSLIT("FieldExp") fieldExpTyConKey
1445 patTyConName = thTc FSLIT("Pat") patTyConKey
1446 fieldPatTyConName = thTc FSLIT("FieldPat") fieldPatTyConKey
1447 expTyConName = thTc FSLIT("Exp") expTyConKey
1448 decTyConName = thTc FSLIT("Dec") decTyConKey
1449 typeTyConName = thTc FSLIT("Type") typeTyConKey
1450 matchTyConName = thTc FSLIT("Match") matchTyConKey
1451 clauseTyConName = thTc FSLIT("Clause") clauseTyConKey
1452 funDepTyConName = thTc FSLIT("FunDep") funDepTyConKey
1454 returnQName = thFun FSLIT("returnQ") returnQIdKey
1455 bindQName = thFun FSLIT("bindQ") bindQIdKey
1456 sequenceQName = thFun FSLIT("sequenceQ") sequenceQIdKey
1457 newNameName = thFun FSLIT("newName") newNameIdKey
1458 liftName = thFun FSLIT("lift") liftIdKey
1459 mkNameName = thFun FSLIT("mkName") mkNameIdKey
1460 mkNameG_vName = thFun FSLIT("mkNameG_v") mkNameG_vIdKey
1461 mkNameG_dName = thFun FSLIT("mkNameG_d") mkNameG_dIdKey
1462 mkNameG_tcName = thFun FSLIT("mkNameG_tc") mkNameG_tcIdKey
1463 mkNameLName = thFun FSLIT("mkNameL") mkNameLIdKey
1466 -------------------- TH.Lib -----------------------
1468 charLName = libFun FSLIT("charL") charLIdKey
1469 stringLName = libFun FSLIT("stringL") stringLIdKey
1470 integerLName = libFun FSLIT("integerL") integerLIdKey
1471 intPrimLName = libFun FSLIT("intPrimL") intPrimLIdKey
1472 floatPrimLName = libFun FSLIT("floatPrimL") floatPrimLIdKey
1473 doublePrimLName = libFun FSLIT("doublePrimL") doublePrimLIdKey
1474 rationalLName = libFun FSLIT("rationalL") rationalLIdKey
1477 litPName = libFun FSLIT("litP") litPIdKey
1478 varPName = libFun FSLIT("varP") varPIdKey
1479 tupPName = libFun FSLIT("tupP") tupPIdKey
1480 conPName = libFun FSLIT("conP") conPIdKey
1481 infixPName = libFun FSLIT("infixP") infixPIdKey
1482 tildePName = libFun FSLIT("tildeP") tildePIdKey
1483 asPName = libFun FSLIT("asP") asPIdKey
1484 wildPName = libFun FSLIT("wildP") wildPIdKey
1485 recPName = libFun FSLIT("recP") recPIdKey
1486 listPName = libFun FSLIT("listP") listPIdKey
1487 sigPName = libFun FSLIT("sigP") sigPIdKey
1489 -- type FieldPat = ...
1490 fieldPatName = libFun FSLIT("fieldPat") fieldPatIdKey
1493 matchName = libFun FSLIT("match") matchIdKey
1495 -- data Clause = ...
1496 clauseName = libFun FSLIT("clause") clauseIdKey
1499 varEName = libFun FSLIT("varE") varEIdKey
1500 conEName = libFun FSLIT("conE") conEIdKey
1501 litEName = libFun FSLIT("litE") litEIdKey
1502 appEName = libFun FSLIT("appE") appEIdKey
1503 infixEName = libFun FSLIT("infixE") infixEIdKey
1504 infixAppName = libFun FSLIT("infixApp") infixAppIdKey
1505 sectionLName = libFun FSLIT("sectionL") sectionLIdKey
1506 sectionRName = libFun FSLIT("sectionR") sectionRIdKey
1507 lamEName = libFun FSLIT("lamE") lamEIdKey
1508 tupEName = libFun FSLIT("tupE") tupEIdKey
1509 condEName = libFun FSLIT("condE") condEIdKey
1510 letEName = libFun FSLIT("letE") letEIdKey
1511 caseEName = libFun FSLIT("caseE") caseEIdKey
1512 doEName = libFun FSLIT("doE") doEIdKey
1513 compEName = libFun FSLIT("compE") compEIdKey
1514 -- ArithSeq skips a level
1515 fromEName = libFun FSLIT("fromE") fromEIdKey
1516 fromThenEName = libFun FSLIT("fromThenE") fromThenEIdKey
1517 fromToEName = libFun FSLIT("fromToE") fromToEIdKey
1518 fromThenToEName = libFun FSLIT("fromThenToE") fromThenToEIdKey
1520 listEName = libFun FSLIT("listE") listEIdKey
1521 sigEName = libFun FSLIT("sigE") sigEIdKey
1522 recConEName = libFun FSLIT("recConE") recConEIdKey
1523 recUpdEName = libFun FSLIT("recUpdE") recUpdEIdKey
1525 -- type FieldExp = ...
1526 fieldExpName = libFun FSLIT("fieldExp") fieldExpIdKey
1529 guardedBName = libFun FSLIT("guardedB") guardedBIdKey
1530 normalBName = libFun FSLIT("normalB") normalBIdKey
1533 normalGEName = libFun FSLIT("normalGE") normalGEIdKey
1534 patGEName = libFun FSLIT("patGE") patGEIdKey
1537 bindSName = libFun FSLIT("bindS") bindSIdKey
1538 letSName = libFun FSLIT("letS") letSIdKey
1539 noBindSName = libFun FSLIT("noBindS") noBindSIdKey
1540 parSName = libFun FSLIT("parS") parSIdKey
1543 funDName = libFun FSLIT("funD") funDIdKey
1544 valDName = libFun FSLIT("valD") valDIdKey
1545 dataDName = libFun FSLIT("dataD") dataDIdKey
1546 newtypeDName = libFun FSLIT("newtypeD") newtypeDIdKey
1547 tySynDName = libFun FSLIT("tySynD") tySynDIdKey
1548 classDName = libFun FSLIT("classD") classDIdKey
1549 instanceDName = libFun FSLIT("instanceD") instanceDIdKey
1550 sigDName = libFun FSLIT("sigD") sigDIdKey
1551 forImpDName = libFun FSLIT("forImpD") forImpDIdKey
1554 cxtName = libFun FSLIT("cxt") cxtIdKey
1556 -- data Strict = ...
1557 isStrictName = libFun FSLIT("isStrict") isStrictKey
1558 notStrictName = libFun FSLIT("notStrict") notStrictKey
1561 normalCName = libFun FSLIT("normalC") normalCIdKey
1562 recCName = libFun FSLIT("recC") recCIdKey
1563 infixCName = libFun FSLIT("infixC") infixCIdKey
1564 forallCName = libFun FSLIT("forallC") forallCIdKey
1566 -- type StrictType = ...
1567 strictTypeName = libFun FSLIT("strictType") strictTKey
1569 -- type VarStrictType = ...
1570 varStrictTypeName = libFun FSLIT("varStrictType") varStrictTKey
1573 forallTName = libFun FSLIT("forallT") forallTIdKey
1574 varTName = libFun FSLIT("varT") varTIdKey
1575 conTName = libFun FSLIT("conT") conTIdKey
1576 tupleTName = libFun FSLIT("tupleT") tupleTIdKey
1577 arrowTName = libFun FSLIT("arrowT") arrowTIdKey
1578 listTName = libFun FSLIT("listT") listTIdKey
1579 appTName = libFun FSLIT("appT") appTIdKey
1581 -- data Callconv = ...
1582 cCallName = libFun FSLIT("cCall") cCallIdKey
1583 stdCallName = libFun FSLIT("stdCall") stdCallIdKey
1585 -- data Safety = ...
1586 unsafeName = libFun FSLIT("unsafe") unsafeIdKey
1587 safeName = libFun FSLIT("safe") safeIdKey
1588 threadsafeName = libFun FSLIT("threadsafe") threadsafeIdKey
1590 -- data FunDep = ...
1591 funDepName = libFun FSLIT("funDep") funDepIdKey
1593 matchQTyConName = libTc FSLIT("MatchQ") matchQTyConKey
1594 clauseQTyConName = libTc FSLIT("ClauseQ") clauseQTyConKey
1595 expQTyConName = libTc FSLIT("ExpQ") expQTyConKey
1596 stmtQTyConName = libTc FSLIT("StmtQ") stmtQTyConKey
1597 decQTyConName = libTc FSLIT("DecQ") decQTyConKey
1598 conQTyConName = libTc FSLIT("ConQ") conQTyConKey
1599 strictTypeQTyConName = libTc FSLIT("StrictTypeQ") strictTypeQTyConKey
1600 varStrictTypeQTyConName = libTc FSLIT("VarStrictTypeQ") varStrictTypeQTyConKey
1601 typeQTyConName = libTc FSLIT("TypeQ") typeQTyConKey
1602 fieldExpQTyConName = libTc FSLIT("FieldExpQ") fieldExpQTyConKey
1603 patQTyConName = libTc FSLIT("PatQ") patQTyConKey
1604 fieldPatQTyConName = libTc FSLIT("FieldPatQ") fieldPatQTyConKey
1606 -- TyConUniques available: 100-129
1607 -- Check in PrelNames if you want to change this
1609 expTyConKey = mkPreludeTyConUnique 100
1610 matchTyConKey = mkPreludeTyConUnique 101
1611 clauseTyConKey = mkPreludeTyConUnique 102
1612 qTyConKey = mkPreludeTyConUnique 103
1613 expQTyConKey = mkPreludeTyConUnique 104
1614 decQTyConKey = mkPreludeTyConUnique 105
1615 patTyConKey = mkPreludeTyConUnique 106
1616 matchQTyConKey = mkPreludeTyConUnique 107
1617 clauseQTyConKey = mkPreludeTyConUnique 108
1618 stmtQTyConKey = mkPreludeTyConUnique 109
1619 conQTyConKey = mkPreludeTyConUnique 110
1620 typeQTyConKey = mkPreludeTyConUnique 111
1621 typeTyConKey = mkPreludeTyConUnique 112
1622 decTyConKey = mkPreludeTyConUnique 113
1623 varStrictTypeQTyConKey = mkPreludeTyConUnique 114
1624 strictTypeQTyConKey = mkPreludeTyConUnique 115
1625 fieldExpTyConKey = mkPreludeTyConUnique 116
1626 fieldPatTyConKey = mkPreludeTyConUnique 117
1627 nameTyConKey = mkPreludeTyConUnique 118
1628 patQTyConKey = mkPreludeTyConUnique 119
1629 fieldPatQTyConKey = mkPreludeTyConUnique 120
1630 fieldExpQTyConKey = mkPreludeTyConUnique 121
1631 funDepTyConKey = mkPreludeTyConUnique 122
1633 -- IdUniques available: 200-399
1634 -- If you want to change this, make sure you check in PrelNames
1636 returnQIdKey = mkPreludeMiscIdUnique 200
1637 bindQIdKey = mkPreludeMiscIdUnique 201
1638 sequenceQIdKey = mkPreludeMiscIdUnique 202
1639 liftIdKey = mkPreludeMiscIdUnique 203
1640 newNameIdKey = mkPreludeMiscIdUnique 204
1641 mkNameIdKey = mkPreludeMiscIdUnique 205
1642 mkNameG_vIdKey = mkPreludeMiscIdUnique 206
1643 mkNameG_dIdKey = mkPreludeMiscIdUnique 207
1644 mkNameG_tcIdKey = mkPreludeMiscIdUnique 208
1645 mkNameLIdKey = mkPreludeMiscIdUnique 209
1649 charLIdKey = mkPreludeMiscIdUnique 210
1650 stringLIdKey = mkPreludeMiscIdUnique 211
1651 integerLIdKey = mkPreludeMiscIdUnique 212
1652 intPrimLIdKey = mkPreludeMiscIdUnique 213
1653 floatPrimLIdKey = mkPreludeMiscIdUnique 214
1654 doublePrimLIdKey = mkPreludeMiscIdUnique 215
1655 rationalLIdKey = mkPreludeMiscIdUnique 216
1658 litPIdKey = mkPreludeMiscIdUnique 220
1659 varPIdKey = mkPreludeMiscIdUnique 221
1660 tupPIdKey = mkPreludeMiscIdUnique 222
1661 conPIdKey = mkPreludeMiscIdUnique 223
1662 infixPIdKey = mkPreludeMiscIdUnique 312
1663 tildePIdKey = mkPreludeMiscIdUnique 224
1664 asPIdKey = mkPreludeMiscIdUnique 225
1665 wildPIdKey = mkPreludeMiscIdUnique 226
1666 recPIdKey = mkPreludeMiscIdUnique 227
1667 listPIdKey = mkPreludeMiscIdUnique 228
1668 sigPIdKey = mkPreludeMiscIdUnique 229
1670 -- type FieldPat = ...
1671 fieldPatIdKey = mkPreludeMiscIdUnique 230
1674 matchIdKey = mkPreludeMiscIdUnique 231
1676 -- data Clause = ...
1677 clauseIdKey = mkPreludeMiscIdUnique 232
1680 varEIdKey = mkPreludeMiscIdUnique 240
1681 conEIdKey = mkPreludeMiscIdUnique 241
1682 litEIdKey = mkPreludeMiscIdUnique 242
1683 appEIdKey = mkPreludeMiscIdUnique 243
1684 infixEIdKey = mkPreludeMiscIdUnique 244
1685 infixAppIdKey = mkPreludeMiscIdUnique 245
1686 sectionLIdKey = mkPreludeMiscIdUnique 246
1687 sectionRIdKey = mkPreludeMiscIdUnique 247
1688 lamEIdKey = mkPreludeMiscIdUnique 248
1689 tupEIdKey = mkPreludeMiscIdUnique 249
1690 condEIdKey = mkPreludeMiscIdUnique 250
1691 letEIdKey = mkPreludeMiscIdUnique 251
1692 caseEIdKey = mkPreludeMiscIdUnique 252
1693 doEIdKey = mkPreludeMiscIdUnique 253
1694 compEIdKey = mkPreludeMiscIdUnique 254
1695 fromEIdKey = mkPreludeMiscIdUnique 255
1696 fromThenEIdKey = mkPreludeMiscIdUnique 256
1697 fromToEIdKey = mkPreludeMiscIdUnique 257
1698 fromThenToEIdKey = mkPreludeMiscIdUnique 258
1699 listEIdKey = mkPreludeMiscIdUnique 259
1700 sigEIdKey = mkPreludeMiscIdUnique 260
1701 recConEIdKey = mkPreludeMiscIdUnique 261
1702 recUpdEIdKey = mkPreludeMiscIdUnique 262
1704 -- type FieldExp = ...
1705 fieldExpIdKey = mkPreludeMiscIdUnique 265
1708 guardedBIdKey = mkPreludeMiscIdUnique 266
1709 normalBIdKey = mkPreludeMiscIdUnique 267
1712 normalGEIdKey = mkPreludeMiscIdUnique 310
1713 patGEIdKey = mkPreludeMiscIdUnique 311
1716 bindSIdKey = mkPreludeMiscIdUnique 268
1717 letSIdKey = mkPreludeMiscIdUnique 269
1718 noBindSIdKey = mkPreludeMiscIdUnique 270
1719 parSIdKey = mkPreludeMiscIdUnique 271
1722 funDIdKey = mkPreludeMiscIdUnique 272
1723 valDIdKey = mkPreludeMiscIdUnique 273
1724 dataDIdKey = mkPreludeMiscIdUnique 274
1725 newtypeDIdKey = mkPreludeMiscIdUnique 275
1726 tySynDIdKey = mkPreludeMiscIdUnique 276
1727 classDIdKey = mkPreludeMiscIdUnique 277
1728 instanceDIdKey = mkPreludeMiscIdUnique 278
1729 sigDIdKey = mkPreludeMiscIdUnique 279
1730 forImpDIdKey = mkPreludeMiscIdUnique 297
1733 cxtIdKey = mkPreludeMiscIdUnique 280
1735 -- data Strict = ...
1736 isStrictKey = mkPreludeMiscIdUnique 281
1737 notStrictKey = mkPreludeMiscIdUnique 282
1740 normalCIdKey = mkPreludeMiscIdUnique 283
1741 recCIdKey = mkPreludeMiscIdUnique 284
1742 infixCIdKey = mkPreludeMiscIdUnique 285
1743 forallCIdKey = mkPreludeMiscIdUnique 288
1745 -- type StrictType = ...
1746 strictTKey = mkPreludeMiscIdUnique 286
1748 -- type VarStrictType = ...
1749 varStrictTKey = mkPreludeMiscIdUnique 287
1752 forallTIdKey = mkPreludeMiscIdUnique 290
1753 varTIdKey = mkPreludeMiscIdUnique 291
1754 conTIdKey = mkPreludeMiscIdUnique 292
1755 tupleTIdKey = mkPreludeMiscIdUnique 294
1756 arrowTIdKey = mkPreludeMiscIdUnique 295
1757 listTIdKey = mkPreludeMiscIdUnique 296
1758 appTIdKey = mkPreludeMiscIdUnique 293
1760 -- data Callconv = ...
1761 cCallIdKey = mkPreludeMiscIdUnique 300
1762 stdCallIdKey = mkPreludeMiscIdUnique 301
1764 -- data Safety = ...
1765 unsafeIdKey = mkPreludeMiscIdUnique 305
1766 safeIdKey = mkPreludeMiscIdUnique 306
1767 threadsafeIdKey = mkPreludeMiscIdUnique 307
1769 -- data FunDep = ...
1770 funDepIdKey = mkPreludeMiscIdUnique 320