1 -----------------------------------------------------------------------------
2 -- The purpose of this module is to transform an HsExpr into a CoreExpr which
3 -- when evaluated, returns a (Meta.Q Meta.Exp) computation analogous to the
4 -- input HsExpr. We do this in the DsM monad, which supplies access to
5 -- CoreExpr's of the "smart constructors" of the Meta.Exp datatype.
7 -- It also defines a bunch of knownKeyNames, in the same way as is done
8 -- in prelude/PrelNames. It's much more convenient to do it here, becuase
9 -- otherwise we have to recompile PrelNames whenever we add a Name, which is
10 -- a Royal Pain (triggers other recompilation).
11 -----------------------------------------------------------------------------
14 module DsMeta( dsBracket,
15 templateHaskellNames, qTyConName, nameTyConName,
16 liftName, expQTyConName, decQTyConName, typeQTyConName,
17 decTyConName, typeTyConName, mkNameG_dName, mkNameG_vName, mkNameG_tcName
20 #include "HsVersions.h"
22 import {-# SOURCE #-} DsExpr ( dsExpr )
24 import MatchLit ( dsLit )
25 import DsUtils ( mkListExpr, mkStringExpr, mkCoreTup, mkIntExpr )
28 import qualified Language.Haskell.TH as TH
32 import PrelNames ( rationalTyConName, integerTyConName, negateName )
33 import OccName ( isDataOcc, isTvOcc, occNameUserString )
34 -- To avoid clashes with DsMeta.varName we must make a local alias for OccName.varName
35 -- we do this by removing varName from the import of OccName above, making
36 -- a qualified instance of OccName and using OccNameAlias.varName where varName
37 -- ws previously used in this file.
38 import qualified OccName
40 import Module ( Module, mkModule, moduleUserString )
41 import Id ( Id, mkLocalId )
42 import OccName ( mkOccFS )
43 import Name ( Name, mkExternalName, localiseName, nameOccName, nameModule,
44 isExternalName, getSrcLoc )
46 import Type ( Type, mkGenTyConApp )
47 import TcType ( tcTyConAppArgs )
48 import TyCon ( tyConName )
49 import TysWiredIn ( parrTyCon )
51 import CoreUtils ( exprType )
52 import SrcLoc ( noSrcLoc, unLoc, Located(..), SrcSpan, srcLocSpan )
53 import Maybe ( catMaybes )
54 import Unique ( mkPreludeTyConUnique, mkPreludeMiscIdUnique, getKey, Uniquable(..) )
55 import BasicTypes ( isBoxed )
57 import Bag ( bagToList )
58 import FastString ( unpackFS )
59 import ForeignCall ( Safety(..), ForeignCall(..), CCallConv(..),
62 import Monad ( zipWithM )
63 import List ( sortBy )
65 -----------------------------------------------------------------------------
66 dsBracket :: HsBracket Name -> [PendingSplice] -> DsM CoreExpr
67 -- Returns a CoreExpr of type TH.ExpQ
68 -- The quoted thing is parameterised over Name, even though it has
69 -- been type checked. We don't want all those type decorations!
71 dsBracket brack splices
72 = dsExtendMetaEnv new_bit (do_brack brack)
74 new_bit = mkNameEnv [(n, Splice (unLoc e)) | (n,e) <- splices]
76 do_brack (VarBr n) = do { MkC e1 <- lookupOcc n ; return e1 }
77 do_brack (ExpBr e) = do { MkC e1 <- repLE e ; return e1 }
78 do_brack (PatBr p) = do { MkC p1 <- repLP p ; return p1 }
79 do_brack (TypBr t) = do { MkC t1 <- repLTy t ; return t1 }
80 do_brack (DecBr ds) = do { MkC ds1 <- repTopDs ds ; return ds1 }
82 {- -------------- Examples --------------------
86 gensym (unpackString "x"#) `bindQ` \ x1::String ->
87 lam (pvar x1) (var x1)
90 [| \x -> $(f [| x |]) |]
92 gensym (unpackString "x"#) `bindQ` \ x1::String ->
93 lam (pvar x1) (f (var x1))
97 -------------------------------------------------------
99 -------------------------------------------------------
101 repTopDs :: HsGroup Name -> DsM (Core (TH.Q [TH.Dec]))
103 = do { let { bndrs = map unLoc (groupBinders group) } ;
104 ss <- mkGenSyms bndrs ;
106 -- Bind all the names mainly to avoid repeated use of explicit strings.
108 -- do { t :: String <- genSym "T" ;
109 -- return (Data t [] ...more t's... }
110 -- The other important reason is that the output must mention
111 -- only "T", not "Foo:T" where Foo is the current module
114 decls <- addBinds ss (do {
115 val_ds <- mapM rep_bind_group (hs_valds group) ;
116 tycl_ds <- mapM repTyClD (hs_tyclds group) ;
117 inst_ds <- mapM repInstD' (hs_instds group) ;
118 for_ds <- mapM repForD (hs_fords group) ;
120 return (de_loc $ sort_by_loc $ concat val_ds ++ catMaybes tycl_ds ++ inst_ds ++ for_ds) }) ;
122 decl_ty <- lookupType decQTyConName ;
123 let { core_list = coreList' decl_ty decls } ;
125 dec_ty <- lookupType decTyConName ;
126 q_decs <- repSequenceQ dec_ty core_list ;
128 wrapNongenSyms ss q_decs
129 -- Do *not* gensym top-level binders
132 groupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
133 hs_fords = foreign_decls })
134 -- Collect the binders of a Group
135 = collectGroupBinders val_decls ++
136 [n | d <- tycl_decls, n <- tyClDeclNames (unLoc d)] ++
137 [n | L _ (ForeignImport n _ _ _) <- foreign_decls]
140 {- Note [Binders and occurrences]
141 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
142 When we desugar [d| data T = MkT |]
144 Data "T" [] [Con "MkT" []] []
146 Data "Foo:T" [] [Con "Foo:MkT" []] []
147 That is, the new data decl should fit into whatever new module it is
148 asked to fit in. We do *not* clone, though; no need for this:
155 then we must desugar to
156 foo = Data "Foo:T" [] [Con "Foo:MkT" []] []
158 So in repTopDs we bring the binders into scope with mkGenSyms and addBinds.
159 And we use lookupOcc, rather than lookupBinder
160 in repTyClD and repC.
164 repTyClD :: LTyClDecl Name -> DsM (Maybe (SrcSpan, Core TH.DecQ))
166 repTyClD (L loc (TyData { tcdND = DataType, tcdCtxt = cxt,
167 tcdLName = tc, tcdTyVars = tvs,
168 tcdCons = cons, tcdDerivs = mb_derivs }))
169 = do { tc1 <- lookupLOcc tc ; -- See note [Binders and occurrences]
170 dec <- addTyVarBinds tvs $ \bndrs -> do {
171 cxt1 <- repLContext cxt ;
172 cons1 <- mapM repC cons ;
173 cons2 <- coreList conQTyConName cons1 ;
174 derivs1 <- repDerivs mb_derivs ;
175 bndrs1 <- coreList nameTyConName bndrs ;
176 repData cxt1 tc1 bndrs1 cons2 derivs1 } ;
177 return $ Just (loc, dec) }
179 repTyClD (L loc (TyData { tcdND = NewType, tcdCtxt = cxt,
180 tcdLName = tc, tcdTyVars = tvs,
181 tcdCons = [con], tcdDerivs = mb_derivs }))
182 = do { tc1 <- lookupLOcc tc ; -- See note [Binders and occurrences]
183 dec <- addTyVarBinds tvs $ \bndrs -> do {
184 cxt1 <- repLContext cxt ;
186 derivs1 <- repDerivs mb_derivs ;
187 bndrs1 <- coreList nameTyConName bndrs ;
188 repNewtype cxt1 tc1 bndrs1 con1 derivs1 } ;
189 return $ Just (loc, dec) }
191 repTyClD (L loc (TySynonym { tcdLName = tc, tcdTyVars = tvs, tcdSynRhs = ty }))
192 = do { tc1 <- lookupLOcc tc ; -- See note [Binders and occurrences]
193 dec <- addTyVarBinds tvs $ \bndrs -> do {
195 bndrs1 <- coreList nameTyConName bndrs ;
196 repTySyn tc1 bndrs1 ty1 } ;
197 return (Just (loc, dec)) }
199 repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
202 tcdSigs = sigs, tcdMeths = meth_binds }))
203 = do { cls1 <- lookupLOcc cls ; -- See note [Binders and occurrences]
204 dec <- addTyVarBinds tvs $ \bndrs -> do {
205 cxt1 <- repLContext cxt ;
206 sigs1 <- rep_sigs sigs ;
207 binds1 <- rep_binds meth_binds ;
208 fds1 <- repLFunDeps fds;
209 decls1 <- coreList decQTyConName (sigs1 ++ binds1) ;
210 bndrs1 <- coreList nameTyConName bndrs ;
211 repClass cxt1 cls1 bndrs1 fds1 decls1 } ;
212 return $ Just (loc, dec) }
215 repTyClD (L loc d) = do { dsWarn (loc, hang ds_msg 4 (ppr d)) ;
221 repLFunDeps :: [Located (FunDep Name)] -> DsM (Core [TH.FunDep])
222 repLFunDeps fds = do fds' <- mapM repLFunDep fds
223 fdList <- coreList funDepTyConName fds'
226 repLFunDep :: Located (FunDep Name) -> DsM (Core TH.FunDep)
227 repLFunDep (L _ (xs, ys)) = do xs' <- mapM lookupBinder xs
228 ys' <- mapM lookupBinder ys
229 xs_list <- coreList nameTyConName xs'
230 ys_list <- coreList nameTyConName ys'
231 repFunDep xs_list ys_list
233 repInstD' (L loc (InstDecl ty binds _)) -- Ignore user pragmas for now
234 = do { i <- addTyVarBinds tvs $ \tv_bndrs ->
235 -- We must bring the type variables into scope, so their occurrences
236 -- don't fail, even though the binders don't appear in the resulting
238 do { cxt1 <- repContext cxt
239 ; inst_ty1 <- repPred (HsClassP cls tys)
240 ; ss <- mkGenSyms (collectHsBindBinders binds)
241 ; binds1 <- addBinds ss (rep_binds binds)
242 ; decls1 <- coreList decQTyConName binds1
243 ; decls2 <- wrapNongenSyms ss decls1
244 -- wrapNonGenSyms: do not clone the class op names!
245 -- They must be called 'op' etc, not 'op34'
246 ; repInst cxt1 inst_ty1 decls2 }
250 (tvs, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
252 repForD :: Located (ForeignDecl Name) -> DsM (SrcSpan, Core TH.DecQ)
253 repForD (L loc (ForeignImport name typ (CImport cc s ch cn cis) _))
254 = do MkC name' <- lookupLOcc name
255 MkC typ' <- repLTy typ
256 MkC cc' <- repCCallConv cc
257 MkC s' <- repSafety s
258 MkC str <- coreStringLit $ static
259 ++ unpackFS ch ++ " "
260 ++ unpackFS cn ++ " "
261 ++ conv_cimportspec cis
262 dec <- rep2 forImpDName [cc', s', str, name', typ']
265 conv_cimportspec (CLabel cls) = panic "repForD': CLabel Not handled"
266 conv_cimportspec (CFunction DynamicTarget) = "dynamic"
267 conv_cimportspec (CFunction (StaticTarget fs)) = unpackFS fs
268 conv_cimportspec CWrapper = "wrapper"
270 CFunction (StaticTarget _) -> "static "
273 repCCallConv :: CCallConv -> DsM (Core TH.Callconv)
274 repCCallConv CCallConv = rep2 cCallName []
275 repCCallConv StdCallConv = rep2 stdCallName []
277 repSafety :: Safety -> DsM (Core TH.Safety)
278 repSafety PlayRisky = rep2 unsafeName []
279 repSafety (PlaySafe False) = rep2 safeName []
280 repSafety (PlaySafe True) = rep2 threadsafeName []
282 ds_msg = ptext SLIT("Cannot desugar this Template Haskell declaration:")
284 -------------------------------------------------------
286 -------------------------------------------------------
288 repC :: LConDecl Name -> DsM (Core TH.ConQ)
289 repC (L loc (ConDecl con [] (L _ []) details))
290 = do { con1 <- lookupLOcc con ; -- See note [Binders and occurrences]
291 repConstr con1 details }
292 repC (L loc (ConDecl con tvs (L cloc ctxt) details))
293 = do { addTyVarBinds tvs $ \bndrs -> do {
294 c' <- repC (L loc (ConDecl con [] (L cloc []) details));
295 ctxt' <- repContext ctxt;
296 bndrs' <- coreList nameTyConName bndrs;
297 rep2 forallCName [unC bndrs', unC ctxt', unC c']
300 repC (L loc con_decl)
301 = do { dsWarn (loc, hang ds_msg 4 (ppr con_decl))
302 ; return (panic "DsMeta:repC") }
304 -- gaw 2004 FIX! Need a case for GadtDecl
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 (Sig 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 _ ty)
516 = do { (ss,zs) <- repLSts sts;
517 e <- repDoE (nonEmptyCoreList zs);
519 repE (HsDo ListComp sts _ ty)
520 = do { (ss,zs) <- repLSts sts;
521 e <- repComp (nonEmptyCoreList zs);
523 repE (HsDo _ _ _ _) = panic "DsMeta.repE: Can't represent mdo and [: :] yet"
524 repE (ExplicitList ty es) = do { xs <- repLEs es; repListExp xs }
525 repE (ExplicitPArr ty es) =
526 panic "DsMeta.repE: No explicit parallel arrays yet"
527 repE (ExplicitTuple es boxed)
528 | isBoxed boxed = do { xs <- repLEs es; repTup xs }
529 | otherwise = panic "DsMeta.repE: Can't represent unboxed tuples"
530 repE (RecordCon c flds)
531 = do { x <- lookupLOcc c;
532 fs <- repFields flds;
534 repE (RecordUpd e flds)
536 fs <- repFields flds;
539 repE (ExprWithTySig e ty) = do { e1 <- repLE e; t1 <- repLTy ty; repSigExp e1 t1 }
540 repE (ArithSeqIn aseq) =
542 From e -> do { ds1 <- repLE e; repFrom ds1 }
551 FromThenTo e1 e2 e3 -> do
555 repFromThenTo ds1 ds2 ds3
556 repE (PArrSeqOut _ aseq) = panic "DsMeta.repE: parallel array seq.s missing"
557 repE (HsCoreAnn _ _) = panic "DsMeta.repE: Can't represent CoreAnn" -- hdaume: core annotations
558 repE (HsSCC _ _) = panic "DsMeta.repE: Can't represent SCC"
559 repE (HsBracketOut _ _) = panic "DsMeta.repE: Can't represent Oxford brackets"
560 repE (HsSpliceE (HsSplice n _))
561 = do { mb_val <- dsLookupMetaEnv n
563 Just (Splice e) -> do { e' <- dsExpr e
565 other -> pprPanic "HsSplice" (ppr n) }
567 repE e = pprPanic "DsMeta.repE: Illegal expression form" (ppr e)
569 -----------------------------------------------------------------------------
570 -- Building representations of auxillary structures like Match, Clause, Stmt,
572 repMatchTup :: LMatch Name -> DsM (Core TH.MatchQ)
573 repMatchTup (L _ (Match [p] ty (GRHSs guards wheres))) =
574 do { ss1 <- mkGenSyms (collectPatBinders p)
575 ; addBinds ss1 $ do {
577 ; (ss2,ds) <- repBinds wheres
578 ; addBinds ss2 $ do {
579 ; gs <- repGuards guards
580 ; match <- repMatch p1 gs ds
581 ; wrapGenSyns (ss1++ss2) match }}}
583 repClauseTup :: LMatch Name -> DsM (Core TH.ClauseQ)
584 repClauseTup (L _ (Match ps ty (GRHSs guards wheres))) =
585 do { ss1 <- mkGenSyms (collectPatsBinders ps)
586 ; addBinds ss1 $ do {
588 ; (ss2,ds) <- repBinds wheres
589 ; addBinds ss2 $ do {
590 gs <- repGuards guards
591 ; clause <- repClause ps1 gs ds
592 ; wrapGenSyns (ss1++ss2) clause }}}
594 repGuards :: [LGRHS Name] -> DsM (Core TH.BodyQ)
595 repGuards [L _ (GRHS [L _ (ResultStmt e)])]
596 = do {a <- repLE e; repNormal a }
598 = do { zs <- mapM process other;
599 let {(xs, ys) = unzip zs};
600 gd <- repGuarded (nonEmptyCoreList ys);
601 wrapGenSyns (concat xs) gd }
603 process :: LGRHS Name -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp))))
604 process (L _ (GRHS [])) = panic "No guards in guarded body"
605 process (L _ (GRHS [L _ (ExprStmt e1 ty),
606 L _ (ResultStmt e2)]))
607 = do { x <- repLNormalGE e1 e2;
609 process (L _ (GRHS ss))
610 = do (gs, ss') <- repLSts ss
611 g <- repPatGE (nonEmptyCoreList ss')
614 repFields :: [(Located Name, LHsExpr Name)] -> DsM (Core [TH.Q TH.FieldExp])
616 fnames <- mapM lookupLOcc (map fst flds)
617 es <- mapM repLE (map snd flds)
618 fs <- zipWithM repFieldExp fnames es
619 coreList fieldExpQTyConName fs
622 -----------------------------------------------------------------------------
623 -- Representing Stmt's is tricky, especially if bound variables
624 -- shadow each other. Consider: [| do { x <- f 1; x <- f x; g x } |]
625 -- First gensym new names for every variable in any of the patterns.
626 -- both static (x'1 and x'2), and dynamic ((gensym "x") and (gensym "y"))
627 -- if variables didn't shaddow, the static gensym wouldn't be necessary
628 -- and we could reuse the original names (x and x).
630 -- do { x'1 <- gensym "x"
631 -- ; x'2 <- gensym "x"
632 -- ; doE [ BindSt (pvar x'1) [| f 1 |]
633 -- , BindSt (pvar x'2) [| f x |]
634 -- , NoBindSt [| g x |]
638 -- The strategy is to translate a whole list of do-bindings by building a
639 -- bigger environment, and a bigger set of meta bindings
640 -- (like: x'1 <- gensym "x" ) and then combining these with the translations
641 -- of the expressions within the Do
643 -----------------------------------------------------------------------------
644 -- The helper function repSts computes the translation of each sub expression
645 -- and a bunch of prefix bindings denoting the dynamic renaming.
647 repLSts :: [LStmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
648 repLSts stmts = repSts (map unLoc stmts)
650 repSts :: [Stmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
651 repSts [ResultStmt e] =
653 ; e1 <- repNoBindSt a
654 ; return ([], [e1]) }
655 repSts (BindStmt p e : ss) =
657 ; ss1 <- mkGenSyms (collectPatBinders p)
658 ; addBinds ss1 $ do {
660 ; (ss2,zs) <- repSts ss
661 ; z <- repBindSt p1 e2
662 ; return (ss1++ss2, z : zs) }}
663 repSts (LetStmt bs : ss) =
664 do { (ss1,ds) <- repBinds bs
666 ; (ss2,zs) <- addBinds ss1 (repSts ss)
667 ; return (ss1++ss2, z : zs) }
668 repSts (ExprStmt e ty : ss) =
670 ; z <- repNoBindSt e2
671 ; (ss2,zs) <- repSts ss
672 ; return (ss2, z : zs) }
673 repSts [] = panic "repSts ran out of statements"
674 repSts other = panic "Exotic Stmt in meta brackets"
677 -----------------------------------------------------------
679 -----------------------------------------------------------
681 repBinds :: [HsBindGroup Name] -> DsM ([GenSymBind], Core [TH.DecQ])
683 = do { let { bndrs = map unLoc (collectGroupBinders decs) }
684 -- No need to worrry about detailed scopes within
685 -- the binding group, because we are talking Names
686 -- here, so we can safely treat it as a mutually
688 ; ss <- mkGenSyms bndrs
689 ; core <- addBinds ss (rep_bind_groups decs)
690 ; core_list <- coreList decQTyConName core
691 ; return (ss, core_list) }
693 rep_bind_groups :: [HsBindGroup Name] -> DsM [Core TH.DecQ]
694 -- Assumes: all the binders of the binding are alrady in the meta-env
695 rep_bind_groups binds = do
696 locs_cores_s <- mapM rep_bind_group binds
697 return $ de_loc $ sort_by_loc (concat locs_cores_s)
699 rep_bind_group :: HsBindGroup Name -> DsM [(SrcSpan, Core TH.DecQ)]
700 -- Assumes: all the binders of the binding are alrady in the meta-env
701 rep_bind_group (HsBindGroup bs sigs _)
702 = do { core1 <- mapM rep_bind (bagToList bs)
703 ; core2 <- rep_sigs' sigs
704 ; return (core1 ++ core2) }
705 rep_bind_group (HsIPBinds _)
706 = panic "DsMeta:repBinds: can't do implicit parameters"
708 rep_binds :: LHsBinds Name -> DsM [Core TH.DecQ]
709 -- Assumes: all the binders of the binding are alrady in the meta-env
711 locs_cores <- mapM rep_bind (bagToList binds)
712 return $ de_loc $ sort_by_loc locs_cores
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 fn infx (MatchGroup [L _ (Match [] ty (GRHSs guards wheres))] _)))
721 = do { (ss,wherecore) <- repBinds wheres
722 ; guardcore <- addBinds ss (repGuards guards)
723 ; fn' <- lookupLBinder fn
725 ; ans <- repVal p guardcore wherecore
726 ; ans' <- wrapGenSyns ss ans
727 ; return (loc, ans') }
729 rep_bind (L loc (FunBind fn infx (MatchGroup ms _)))
730 = do { ms1 <- mapM repClauseTup ms
731 ; fn' <- lookupLBinder fn
732 ; ans <- repFun fn' (nonEmptyCoreList ms1)
733 ; return (loc, ans) }
735 rep_bind (L loc (PatBind pat (GRHSs guards wheres) ty2))
736 = do { patcore <- repLP pat
737 ; (ss,wherecore) <- repBinds wheres
738 ; guardcore <- addBinds ss (repGuards guards)
739 ; ans <- repVal patcore guardcore wherecore
740 ; ans' <- wrapGenSyns ss ans
741 ; return (loc, ans') }
743 rep_bind (L loc (VarBind v e))
744 = do { v' <- lookupBinder v
747 ; patcore <- repPvar v'
748 ; empty_decls <- coreList decQTyConName []
749 ; ans <- repVal patcore x empty_decls
750 ; return (srcLocSpan (getSrcLoc v), ans) }
752 -----------------------------------------------------------------------------
753 -- Since everything in a Bind is mutually recursive we need rename all
754 -- all the variables simultaneously. For example:
755 -- [| AndMonoBinds (f x = x + g 2) (g x = f 1 + 2) |] would translate to
756 -- do { f'1 <- gensym "f"
757 -- ; g'2 <- gensym "g"
758 -- ; [ do { x'3 <- gensym "x"; fun f'1 [pvar x'3] [| x + g2 |]},
759 -- do { x'4 <- gensym "x"; fun g'2 [pvar x'4] [| f 1 + 2 |]}
761 -- This requires collecting the bindings (f'1 <- gensym "f"), and the
762 -- environment ( f |-> f'1 ) from each binding, and then unioning them
763 -- together. As we do this we collect GenSymBinds's which represent the renamed
764 -- variables bound by the Bindings. In order not to lose track of these
765 -- representations we build a shadow datatype MB with the same structure as
766 -- MonoBinds, but which has slots for the representations
769 -----------------------------------------------------------------------------
770 -- GHC allows a more general form of lambda abstraction than specified
771 -- by Haskell 98. In particular it allows guarded lambda's like :
772 -- (\ x | even x -> 0 | odd x -> 1) at the moment we can't represent this in
773 -- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like
774 -- (\ p1 .. pn -> exp) by causing an error.
776 repLambda :: LMatch Name -> DsM (Core TH.ExpQ)
777 repLambda (L _ (Match ps _ (GRHSs [L _ (GRHS [L _ (ResultStmt e)])] [])))
778 = do { let bndrs = collectPatsBinders ps ;
779 ; ss <- mkGenSyms bndrs
780 ; lam <- addBinds ss (
781 do { xs <- repLPs ps; body <- repLE e; repLam xs body })
782 ; wrapGenSyns ss lam }
784 repLambda z = panic "Can't represent a guarded lambda in Template Haskell"
787 -----------------------------------------------------------------------------
789 -- repP deals with patterns. It assumes that we have already
790 -- walked over the pattern(s) once to collect the binders, and
791 -- have extended the environment. So every pattern-bound
792 -- variable should already appear in the environment.
794 -- Process a list of patterns
795 repLPs :: [LPat Name] -> DsM (Core [TH.PatQ])
796 repLPs ps = do { ps' <- mapM repLP ps ;
797 coreList patQTyConName ps' }
799 repLP :: LPat Name -> DsM (Core TH.PatQ)
800 repLP (L _ p) = repP p
802 repP :: Pat Name -> DsM (Core TH.PatQ)
803 repP (WildPat _) = repPwild
804 repP (LitPat l) = do { l2 <- repLiteral l; repPlit l2 }
805 repP (VarPat x) = do { x' <- lookupBinder x; repPvar x' }
806 repP (LazyPat p) = do { p1 <- repLP p; repPtilde p1 }
807 repP (AsPat x p) = do { x' <- lookupLBinder x; p1 <- repLP p; repPaspat x' p1 }
808 repP (ParPat p) = repLP p
809 repP (ListPat ps _) = do { qs <- repLPs ps; repPlist qs }
810 repP (TuplePat ps _) = do { qs <- repLPs ps; repPtup qs }
811 repP (ConPatIn dc details)
812 = do { con_str <- lookupLOcc dc
814 PrefixCon ps -> do { qs <- repLPs ps; repPcon con_str qs }
815 RecCon pairs -> do { vs <- sequence $ map lookupLOcc (map fst pairs)
816 ; ps <- sequence $ map repLP (map snd pairs)
817 ; fps <- zipWithM (\x y -> rep2 fieldPatName [unC x,unC y]) vs ps
818 ; fps' <- coreList fieldPatQTyConName fps
819 ; repPrec con_str fps' }
820 InfixCon p1 p2 -> do { p1' <- repLP p1;
822 repPinfix p1' con_str p2' }
824 repP (NPatIn l (Just _)) = panic "Can't cope with negative overloaded patterns yet (repP (NPatIn _ (Just _)))"
825 repP (NPatIn l Nothing) = do { a <- repOverloadedLiteral l; repPlit a }
826 repP (SigPatIn p t) = do { p' <- repLP p; t' <- repLTy t; repPsig p' t' }
827 repP other = panic "Exotic pattern inside meta brackets"
829 ----------------------------------------------------------
830 -- Declaration ordering helpers
832 sort_by_loc :: [(SrcSpan, a)] -> [(SrcSpan, a)]
833 sort_by_loc xs = sortBy comp xs
834 where comp x y = compare (fst x) (fst y)
836 de_loc :: [(a, b)] -> [b]
839 ----------------------------------------------------------
840 -- The meta-environment
842 -- A name/identifier association for fresh names of locally bound entities
843 type GenSymBind = (Name, Id) -- Gensym the string and bind it to the Id
844 -- I.e. (x, x_id) means
845 -- let x_id = gensym "x" in ...
847 -- Generate a fresh name for a locally bound entity
849 mkGenSyms :: [Name] -> DsM [GenSymBind]
850 -- We can use the existing name. For example:
851 -- [| \x_77 -> x_77 + x_77 |]
853 -- do { x_77 <- genSym "x"; .... }
854 -- We use the same x_77 in the desugared program, but with the type Bndr
857 -- We do make it an Internal name, though (hence localiseName)
859 -- Nevertheless, it's monadic because we have to generate nameTy
860 mkGenSyms ns = do { var_ty <- lookupType nameTyConName
861 ; return [(nm, mkLocalId (localiseName nm) var_ty) | nm <- ns] }
864 addBinds :: [GenSymBind] -> DsM a -> DsM a
865 -- Add a list of fresh names for locally bound entities to the
866 -- meta environment (which is part of the state carried around
867 -- by the desugarer monad)
868 addBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,Bound id) | (n,id) <- bs]) m
870 -- Look up a locally bound name
872 lookupLBinder :: Located Name -> DsM (Core TH.Name)
873 lookupLBinder (L _ n) = lookupBinder n
875 lookupBinder :: Name -> DsM (Core TH.Name)
877 = do { mb_val <- dsLookupMetaEnv n;
879 Just (Bound x) -> return (coreVar x)
880 other -> pprPanic "Failed binder lookup:" (ppr n) }
882 -- Look up a name that is either locally bound or a global name
884 -- * If it is a global name, generate the "original name" representation (ie,
885 -- the <module>:<name> form) for the associated entity
887 lookupLOcc :: Located Name -> DsM (Core TH.Name)
888 -- Lookup an occurrence; it can't be a splice.
889 -- Use the in-scope bindings if they exist
890 lookupLOcc (L _ n) = lookupOcc n
892 lookupOcc :: Name -> DsM (Core TH.Name)
894 = do { mb_val <- dsLookupMetaEnv n ;
896 Nothing -> globalVar n
897 Just (Bound x) -> return (coreVar x)
898 Just (Splice _) -> pprPanic "repE:lookupOcc" (ppr n)
901 globalVar :: Name -> DsM (Core TH.Name)
902 -- Not bound by the meta-env
903 -- Could be top-level; or could be local
904 -- f x = $(g [| x |])
905 -- Here the x will be local
907 | isExternalName name
908 = do { MkC mod <- coreStringLit name_mod
909 ; MkC occ <- occNameLit name
910 ; rep2 mk_varg [mod,occ] }
912 = do { MkC occ <- occNameLit name
913 ; MkC uni <- coreIntLit (getKey (getUnique name))
914 ; rep2 mkNameLName [occ,uni] }
916 name_mod = moduleUserString (nameModule name)
917 name_occ = nameOccName name
918 mk_varg | OccName.isDataOcc name_occ = mkNameG_dName
919 | OccName.isVarOcc name_occ = mkNameG_vName
920 | OccName.isTcOcc name_occ = mkNameG_tcName
921 | otherwise = pprPanic "DsMeta.globalVar" (ppr name)
923 lookupType :: Name -- Name of type constructor (e.g. TH.ExpQ)
924 -> DsM Type -- The type
925 lookupType tc_name = do { tc <- dsLookupTyCon tc_name ;
926 return (mkGenTyConApp tc []) }
928 wrapGenSyns :: [GenSymBind]
929 -> Core (TH.Q a) -> DsM (Core (TH.Q a))
930 -- wrapGenSyns [(nm1,id1), (nm2,id2)] y
931 -- --> bindQ (gensym nm1) (\ id1 ->
932 -- bindQ (gensym nm2 (\ id2 ->
935 wrapGenSyns binds body@(MkC b)
936 = do { var_ty <- lookupType nameTyConName
939 [elt_ty] = tcTyConAppArgs (exprType b)
940 -- b :: Q a, so we can get the type 'a' by looking at the
941 -- argument type. NB: this relies on Q being a data/newtype,
942 -- not a type synonym
944 go var_ty [] = return body
945 go var_ty ((name,id) : binds)
946 = do { MkC body' <- go var_ty binds
947 ; lit_str <- occNameLit name
948 ; gensym_app <- repGensym lit_str
949 ; repBindQ var_ty elt_ty
950 gensym_app (MkC (Lam id body')) }
952 -- Just like wrapGenSym, but don't actually do the gensym
953 -- Instead use the existing name:
954 -- let x = "x" in ...
955 -- Only used for [Decl], and for the class ops in class
956 -- and instance decls
957 wrapNongenSyms :: [GenSymBind] -> Core a -> DsM (Core a)
958 wrapNongenSyms binds (MkC body)
959 = do { binds' <- mapM do_one binds ;
960 return (MkC (mkLets binds' body)) }
963 = do { MkC lit_str <- occNameLit name
964 ; MkC var <- rep2 mkNameName [lit_str]
965 ; return (NonRec id var) }
967 occNameLit :: Name -> DsM (Core String)
968 occNameLit n = coreStringLit (occNameUserString (nameOccName n))
971 -- %*********************************************************************
975 -- %*********************************************************************
977 -----------------------------------------------------------------------------
978 -- PHANTOM TYPES for consistency. In order to make sure we do this correct
979 -- we invent a new datatype which uses phantom types.
981 newtype Core a = MkC CoreExpr
984 rep2 :: Name -> [ CoreExpr ] -> DsM (Core a)
985 rep2 n xs = do { id <- dsLookupGlobalId n
986 ; return (MkC (foldl App (Var id) xs)) }
988 -- Then we make "repConstructors" which use the phantom types for each of the
989 -- smart constructors of the Meta.Meta datatypes.
992 -- %*********************************************************************
994 -- The 'smart constructors'
996 -- %*********************************************************************
998 --------------- Patterns -----------------
999 repPlit :: Core TH.Lit -> DsM (Core TH.PatQ)
1000 repPlit (MkC l) = rep2 litPName [l]
1002 repPvar :: Core TH.Name -> DsM (Core TH.PatQ)
1003 repPvar (MkC s) = rep2 varPName [s]
1005 repPtup :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
1006 repPtup (MkC ps) = rep2 tupPName [ps]
1008 repPcon :: Core TH.Name -> Core [TH.PatQ] -> DsM (Core TH.PatQ)
1009 repPcon (MkC s) (MkC ps) = rep2 conPName [s, ps]
1011 repPrec :: Core TH.Name -> Core [(TH.Name,TH.PatQ)] -> DsM (Core TH.PatQ)
1012 repPrec (MkC c) (MkC rps) = rep2 recPName [c,rps]
1014 repPinfix :: Core TH.PatQ -> Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
1015 repPinfix (MkC p1) (MkC n) (MkC p2) = rep2 infixPName [p1, n, p2]
1017 repPtilde :: Core TH.PatQ -> DsM (Core TH.PatQ)
1018 repPtilde (MkC p) = rep2 tildePName [p]
1020 repPaspat :: Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
1021 repPaspat (MkC s) (MkC p) = rep2 asPName [s, p]
1023 repPwild :: DsM (Core TH.PatQ)
1024 repPwild = rep2 wildPName []
1026 repPlist :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
1027 repPlist (MkC ps) = rep2 listPName [ps]
1029 repPsig :: Core TH.PatQ -> Core TH.TypeQ -> DsM (Core TH.PatQ)
1030 repPsig (MkC p) (MkC t) = rep2 sigPName [p, t]
1032 --------------- Expressions -----------------
1033 repVarOrCon :: Name -> Core TH.Name -> DsM (Core TH.ExpQ)
1034 repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
1035 | otherwise = repVar str
1037 repVar :: Core TH.Name -> DsM (Core TH.ExpQ)
1038 repVar (MkC s) = rep2 varEName [s]
1040 repCon :: Core TH.Name -> DsM (Core TH.ExpQ)
1041 repCon (MkC s) = rep2 conEName [s]
1043 repLit :: Core TH.Lit -> DsM (Core TH.ExpQ)
1044 repLit (MkC c) = rep2 litEName [c]
1046 repApp :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1047 repApp (MkC x) (MkC y) = rep2 appEName [x,y]
1049 repLam :: Core [TH.PatQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1050 repLam (MkC ps) (MkC e) = rep2 lamEName [ps, e]
1052 repTup :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
1053 repTup (MkC es) = rep2 tupEName [es]
1055 repCond :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1056 repCond (MkC x) (MkC y) (MkC z) = rep2 condEName [x,y,z]
1058 repLetE :: Core [TH.DecQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1059 repLetE (MkC ds) (MkC e) = rep2 letEName [ds, e]
1061 repCaseE :: Core TH.ExpQ -> Core [TH.MatchQ] -> DsM( Core TH.ExpQ)
1062 repCaseE (MkC e) (MkC ms) = rep2 caseEName [e, ms]
1064 repDoE :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
1065 repDoE (MkC ss) = rep2 doEName [ss]
1067 repComp :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
1068 repComp (MkC ss) = rep2 compEName [ss]
1070 repListExp :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
1071 repListExp (MkC es) = rep2 listEName [es]
1073 repSigExp :: Core TH.ExpQ -> Core TH.TypeQ -> DsM (Core TH.ExpQ)
1074 repSigExp (MkC e) (MkC t) = rep2 sigEName [e,t]
1076 repRecCon :: Core TH.Name -> Core [TH.Q TH.FieldExp]-> DsM (Core TH.ExpQ)
1077 repRecCon (MkC c) (MkC fs) = rep2 recConEName [c,fs]
1079 repRecUpd :: Core TH.ExpQ -> Core [TH.Q TH.FieldExp] -> DsM (Core TH.ExpQ)
1080 repRecUpd (MkC e) (MkC fs) = rep2 recUpdEName [e,fs]
1082 repFieldExp :: Core TH.Name -> Core TH.ExpQ -> DsM (Core (TH.Q TH.FieldExp))
1083 repFieldExp (MkC n) (MkC x) = rep2 fieldExpName [n,x]
1085 repInfixApp :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1086 repInfixApp (MkC x) (MkC y) (MkC z) = rep2 infixAppName [x,y,z]
1088 repSectionL :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1089 repSectionL (MkC x) (MkC y) = rep2 sectionLName [x,y]
1091 repSectionR :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1092 repSectionR (MkC x) (MkC y) = rep2 sectionRName [x,y]
1094 ------------ Right hand sides (guarded expressions) ----
1095 repGuarded :: Core [TH.Q (TH.Guard, TH.Exp)] -> DsM (Core TH.BodyQ)
1096 repGuarded (MkC pairs) = rep2 guardedBName [pairs]
1098 repNormal :: Core TH.ExpQ -> DsM (Core TH.BodyQ)
1099 repNormal (MkC e) = rep2 normalBName [e]
1101 ------------ Guards ----
1102 repLNormalGE :: LHsExpr Name -> LHsExpr Name -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1103 repLNormalGE g e = do g' <- repLE g
1107 repNormalGE :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1108 repNormalGE (MkC g) (MkC e) = rep2 normalGEName [g, e]
1110 repPatGE :: Core [TH.StmtQ] -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
1111 repPatGE (MkC ss) = rep2 patGEName [ss]
1113 ------------- Stmts -------------------
1114 repBindSt :: Core TH.PatQ -> Core TH.ExpQ -> DsM (Core TH.StmtQ)
1115 repBindSt (MkC p) (MkC e) = rep2 bindSName [p,e]
1117 repLetSt :: Core [TH.DecQ] -> DsM (Core TH.StmtQ)
1118 repLetSt (MkC ds) = rep2 letSName [ds]
1120 repNoBindSt :: Core TH.ExpQ -> DsM (Core TH.StmtQ)
1121 repNoBindSt (MkC e) = rep2 noBindSName [e]
1123 -------------- Range (Arithmetic sequences) -----------
1124 repFrom :: Core TH.ExpQ -> DsM (Core TH.ExpQ)
1125 repFrom (MkC x) = rep2 fromEName [x]
1127 repFromThen :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1128 repFromThen (MkC x) (MkC y) = rep2 fromThenEName [x,y]
1130 repFromTo :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1131 repFromTo (MkC x) (MkC y) = rep2 fromToEName [x,y]
1133 repFromThenTo :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
1134 repFromThenTo (MkC x) (MkC y) (MkC z) = rep2 fromThenToEName [x,y,z]
1136 ------------ Match and Clause Tuples -----------
1137 repMatch :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.MatchQ)
1138 repMatch (MkC p) (MkC bod) (MkC ds) = rep2 matchName [p, bod, ds]
1140 repClause :: Core [TH.PatQ] -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.ClauseQ)
1141 repClause (MkC ps) (MkC bod) (MkC ds) = rep2 clauseName [ps, bod, ds]
1143 -------------- Dec -----------------------------
1144 repVal :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1145 repVal (MkC p) (MkC b) (MkC ds) = rep2 valDName [p, b, ds]
1147 repFun :: Core TH.Name -> Core [TH.ClauseQ] -> DsM (Core TH.DecQ)
1148 repFun (MkC nm) (MkC b) = rep2 funDName [nm, b]
1150 repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core [TH.ConQ] -> Core [TH.Name] -> DsM (Core TH.DecQ)
1151 repData (MkC cxt) (MkC nm) (MkC tvs) (MkC cons) (MkC derivs)
1152 = rep2 dataDName [cxt, nm, tvs, cons, derivs]
1154 repNewtype :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core TH.ConQ -> Core [TH.Name] -> DsM (Core TH.DecQ)
1155 repNewtype (MkC cxt) (MkC nm) (MkC tvs) (MkC con) (MkC derivs)
1156 = rep2 newtypeDName [cxt, nm, tvs, con, derivs]
1158 repTySyn :: Core TH.Name -> Core [TH.Name] -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1159 repTySyn (MkC nm) (MkC tvs) (MkC rhs) = rep2 tySynDName [nm, tvs, rhs]
1161 repInst :: Core TH.CxtQ -> Core TH.TypeQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1162 repInst (MkC cxt) (MkC ty) (MkC ds) = rep2 instanceDName [cxt, ty, ds]
1164 repClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core [TH.FunDep] -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
1165 repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds) = rep2 classDName [cxt, cls, tvs, fds, ds]
1167 repFunDep :: Core [TH.Name] -> Core [TH.Name] -> DsM (Core TH.FunDep)
1168 repFunDep (MkC xs) (MkC ys) = rep2 funDepName [xs, ys]
1170 repProto :: Core TH.Name -> Core TH.TypeQ -> DsM (Core TH.DecQ)
1171 repProto (MkC s) (MkC ty) = rep2 sigDName [s, ty]
1173 repCtxt :: Core [TH.TypeQ] -> DsM (Core TH.CxtQ)
1174 repCtxt (MkC tys) = rep2 cxtName [tys]
1176 repConstr :: Core TH.Name -> HsConDetails Name (LBangType Name)
1177 -> DsM (Core TH.ConQ)
1178 repConstr con (PrefixCon ps)
1179 = do arg_tys <- mapM repBangTy ps
1180 arg_tys1 <- coreList strictTypeQTyConName arg_tys
1181 rep2 normalCName [unC con, unC arg_tys1]
1182 repConstr con (RecCon ips)
1183 = do arg_vs <- mapM lookupLOcc (map fst ips)
1184 arg_tys <- mapM repBangTy (map snd ips)
1185 arg_vtys <- zipWithM (\x y -> rep2 varStrictTypeName [unC x, unC y])
1187 arg_vtys' <- coreList varStrictTypeQTyConName arg_vtys
1188 rep2 recCName [unC con, unC arg_vtys']
1189 repConstr con (InfixCon st1 st2)
1190 = do arg1 <- repBangTy st1
1191 arg2 <- repBangTy st2
1192 rep2 infixCName [unC arg1, unC con, unC arg2]
1194 ------------ Types -------------------
1196 repTForall :: Core [TH.Name] -> Core TH.CxtQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)
1197 repTForall (MkC tvars) (MkC ctxt) (MkC ty)
1198 = rep2 forallTName [tvars, ctxt, ty]
1200 repTvar :: Core TH.Name -> DsM (Core TH.TypeQ)
1201 repTvar (MkC s) = rep2 varTName [s]
1203 repTapp :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)
1204 repTapp (MkC t1) (MkC t2) = rep2 appTName [t1,t2]
1206 repTapps :: Core TH.TypeQ -> [Core TH.TypeQ] -> DsM (Core TH.TypeQ)
1207 repTapps f [] = return f
1208 repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
1210 --------- Type constructors --------------
1212 repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
1213 repNamedTyCon (MkC s) = rep2 conTName [s]
1215 repTupleTyCon :: Int -> DsM (Core TH.TypeQ)
1216 -- Note: not Core Int; it's easier to be direct here
1217 repTupleTyCon i = rep2 tupleTName [mkIntExpr (fromIntegral i)]
1219 repArrowTyCon :: DsM (Core TH.TypeQ)
1220 repArrowTyCon = rep2 arrowTName []
1222 repListTyCon :: DsM (Core TH.TypeQ)
1223 repListTyCon = rep2 listTName []
1226 ----------------------------------------------------------
1229 repLiteral :: HsLit -> DsM (Core TH.Lit)
1231 = do lit' <- case lit of
1232 HsIntPrim i -> mk_integer i
1233 HsInt i -> mk_integer i
1234 HsFloatPrim r -> mk_rational r
1235 HsDoublePrim r -> mk_rational r
1237 lit_expr <- dsLit lit'
1238 rep2 lit_name [lit_expr]
1240 lit_name = case lit of
1241 HsInteger _ _ -> integerLName
1242 HsInt _ -> integerLName
1243 HsIntPrim _ -> intPrimLName
1244 HsFloatPrim _ -> floatPrimLName
1245 HsDoublePrim _ -> doublePrimLName
1246 HsChar _ -> charLName
1247 HsString _ -> stringLName
1248 HsRat _ _ -> rationalLName
1250 uh_oh = pprPanic "DsMeta.repLiteral: trying to represent exotic literal"
1253 mk_integer i = do integer_ty <- lookupType integerTyConName
1254 return $ HsInteger i integer_ty
1255 mk_rational r = do rat_ty <- lookupType rationalTyConName
1256 return $ HsRat r rat_ty
1258 repOverloadedLiteral :: HsOverLit -> DsM (Core TH.Lit)
1259 repOverloadedLiteral (HsIntegral i _) = do { lit <- mk_integer i; repLiteral lit }
1260 repOverloadedLiteral (HsFractional f _) = do { lit <- mk_rational f; repLiteral lit }
1261 -- The type Rational will be in the environment, becuase
1262 -- the smart constructor 'TH.Syntax.rationalL' uses it in its type,
1263 -- and rationalL is sucked in when any TH stuff is used
1265 --------------- Miscellaneous -------------------
1267 repGensym :: Core String -> DsM (Core (TH.Q TH.Name))
1268 repGensym (MkC lit_str) = rep2 newNameName [lit_str]
1270 repBindQ :: Type -> Type -- a and b
1271 -> Core (TH.Q a) -> Core (a -> TH.Q b) -> DsM (Core (TH.Q b))
1272 repBindQ ty_a ty_b (MkC x) (MkC y)
1273 = rep2 bindQName [Type ty_a, Type ty_b, x, y]
1275 repSequenceQ :: Type -> Core [TH.Q a] -> DsM (Core (TH.Q [a]))
1276 repSequenceQ ty_a (MkC list)
1277 = rep2 sequenceQName [Type ty_a, list]
1279 ------------ Lists and Tuples -------------------
1280 -- turn a list of patterns into a single pattern matching a list
1282 coreList :: Name -- Of the TyCon of the element type
1283 -> [Core a] -> DsM (Core [a])
1285 = do { elt_ty <- lookupType tc_name; return (coreList' elt_ty es) }
1287 coreList' :: Type -- The element type
1288 -> [Core a] -> Core [a]
1289 coreList' elt_ty es = MkC (mkListExpr elt_ty (map unC es ))
1291 nonEmptyCoreList :: [Core a] -> Core [a]
1292 -- The list must be non-empty so we can get the element type
1293 -- Otherwise use coreList
1294 nonEmptyCoreList [] = panic "coreList: empty argument"
1295 nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs))
1297 corePair :: (Core a, Core b) -> Core (a,b)
1298 corePair (MkC x, MkC y) = MkC (mkCoreTup [x,y])
1300 coreStringLit :: String -> DsM (Core String)
1301 coreStringLit s = do { z <- mkStringExpr s; return(MkC z) }
1303 coreIntLit :: Int -> DsM (Core Int)
1304 coreIntLit i = return (MkC (mkIntExpr (fromIntegral i)))
1306 coreVar :: Id -> Core TH.Name -- The Id has type Name
1307 coreVar id = MkC (Var id)
1311 -- %************************************************************************
1313 -- The known-key names for Template Haskell
1315 -- %************************************************************************
1317 -- To add a name, do three things
1319 -- 1) Allocate a key
1321 -- 3) Add the name to knownKeyNames
1323 templateHaskellNames :: [Name]
1324 -- The names that are implicitly mentioned by ``bracket''
1325 -- Should stay in sync with the import list of DsMeta
1327 templateHaskellNames = [
1328 returnQName, bindQName, sequenceQName, newNameName, liftName,
1329 mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName,
1332 charLName, stringLName, integerLName, intPrimLName,
1333 floatPrimLName, doublePrimLName, rationalLName,
1335 litPName, varPName, tupPName, conPName, tildePName, infixPName,
1336 asPName, wildPName, recPName, listPName, sigPName,
1344 varEName, conEName, litEName, appEName, infixEName,
1345 infixAppName, sectionLName, sectionRName, lamEName, tupEName,
1346 condEName, letEName, caseEName, doEName, compEName,
1347 fromEName, fromThenEName, fromToEName, fromThenToEName,
1348 listEName, sigEName, recConEName, recUpdEName,
1352 guardedBName, normalBName,
1354 normalGEName, patGEName,
1356 bindSName, letSName, noBindSName, parSName,
1358 funDName, valDName, dataDName, newtypeDName, tySynDName,
1359 classDName, instanceDName, sigDName, forImpDName,
1363 isStrictName, notStrictName,
1365 normalCName, recCName, infixCName, forallCName,
1371 forallTName, varTName, conTName, appTName,
1372 tupleTName, arrowTName, listTName,
1374 cCallName, stdCallName,
1383 qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchQTyConName,
1384 clauseQTyConName, expQTyConName, fieldExpTyConName, stmtQTyConName,
1385 decQTyConName, conQTyConName, strictTypeQTyConName,
1386 varStrictTypeQTyConName, typeQTyConName, expTyConName, decTyConName,
1387 typeTyConName, matchTyConName, clauseTyConName, patQTyConName,
1388 fieldPatQTyConName, fieldExpQTyConName, funDepTyConName]
1391 thSyn = mkModule "Language.Haskell.TH.Syntax"
1392 thLib = mkModule "Language.Haskell.TH.Lib"
1394 mk_known_key_name mod space str uniq
1395 = mkExternalName uniq mod (mkOccFS space str)
1398 libFun = mk_known_key_name thLib OccName.varName
1399 libTc = mk_known_key_name thLib OccName.tcName
1400 thFun = mk_known_key_name thSyn OccName.varName
1401 thTc = mk_known_key_name thSyn OccName.tcName
1403 -------------------- TH.Syntax -----------------------
1404 qTyConName = thTc FSLIT("Q") qTyConKey
1405 nameTyConName = thTc FSLIT("Name") nameTyConKey
1406 fieldExpTyConName = thTc FSLIT("FieldExp") fieldExpTyConKey
1407 patTyConName = thTc FSLIT("Pat") patTyConKey
1408 fieldPatTyConName = thTc FSLIT("FieldPat") fieldPatTyConKey
1409 expTyConName = thTc FSLIT("Exp") expTyConKey
1410 decTyConName = thTc FSLIT("Dec") decTyConKey
1411 typeTyConName = thTc FSLIT("Type") typeTyConKey
1412 matchTyConName = thTc FSLIT("Match") matchTyConKey
1413 clauseTyConName = thTc FSLIT("Clause") clauseTyConKey
1414 funDepTyConName = thTc FSLIT("FunDep") funDepTyConKey
1416 returnQName = thFun FSLIT("returnQ") returnQIdKey
1417 bindQName = thFun FSLIT("bindQ") bindQIdKey
1418 sequenceQName = thFun FSLIT("sequenceQ") sequenceQIdKey
1419 newNameName = thFun FSLIT("newName") newNameIdKey
1420 liftName = thFun FSLIT("lift") liftIdKey
1421 mkNameName = thFun FSLIT("mkName") mkNameIdKey
1422 mkNameG_vName = thFun FSLIT("mkNameG_v") mkNameG_vIdKey
1423 mkNameG_dName = thFun FSLIT("mkNameG_d") mkNameG_dIdKey
1424 mkNameG_tcName = thFun FSLIT("mkNameG_tc") mkNameG_tcIdKey
1425 mkNameLName = thFun FSLIT("mkNameL") mkNameLIdKey
1428 -------------------- TH.Lib -----------------------
1430 charLName = libFun FSLIT("charL") charLIdKey
1431 stringLName = libFun FSLIT("stringL") stringLIdKey
1432 integerLName = libFun FSLIT("integerL") integerLIdKey
1433 intPrimLName = libFun FSLIT("intPrimL") intPrimLIdKey
1434 floatPrimLName = libFun FSLIT("floatPrimL") floatPrimLIdKey
1435 doublePrimLName = libFun FSLIT("doublePrimL") doublePrimLIdKey
1436 rationalLName = libFun FSLIT("rationalL") rationalLIdKey
1439 litPName = libFun FSLIT("litP") litPIdKey
1440 varPName = libFun FSLIT("varP") varPIdKey
1441 tupPName = libFun FSLIT("tupP") tupPIdKey
1442 conPName = libFun FSLIT("conP") conPIdKey
1443 infixPName = libFun FSLIT("infixP") infixPIdKey
1444 tildePName = libFun FSLIT("tildeP") tildePIdKey
1445 asPName = libFun FSLIT("asP") asPIdKey
1446 wildPName = libFun FSLIT("wildP") wildPIdKey
1447 recPName = libFun FSLIT("recP") recPIdKey
1448 listPName = libFun FSLIT("listP") listPIdKey
1449 sigPName = libFun FSLIT("sigP") sigPIdKey
1451 -- type FieldPat = ...
1452 fieldPatName = libFun FSLIT("fieldPat") fieldPatIdKey
1455 matchName = libFun FSLIT("match") matchIdKey
1457 -- data Clause = ...
1458 clauseName = libFun FSLIT("clause") clauseIdKey
1461 varEName = libFun FSLIT("varE") varEIdKey
1462 conEName = libFun FSLIT("conE") conEIdKey
1463 litEName = libFun FSLIT("litE") litEIdKey
1464 appEName = libFun FSLIT("appE") appEIdKey
1465 infixEName = libFun FSLIT("infixE") infixEIdKey
1466 infixAppName = libFun FSLIT("infixApp") infixAppIdKey
1467 sectionLName = libFun FSLIT("sectionL") sectionLIdKey
1468 sectionRName = libFun FSLIT("sectionR") sectionRIdKey
1469 lamEName = libFun FSLIT("lamE") lamEIdKey
1470 tupEName = libFun FSLIT("tupE") tupEIdKey
1471 condEName = libFun FSLIT("condE") condEIdKey
1472 letEName = libFun FSLIT("letE") letEIdKey
1473 caseEName = libFun FSLIT("caseE") caseEIdKey
1474 doEName = libFun FSLIT("doE") doEIdKey
1475 compEName = libFun FSLIT("compE") compEIdKey
1476 -- ArithSeq skips a level
1477 fromEName = libFun FSLIT("fromE") fromEIdKey
1478 fromThenEName = libFun FSLIT("fromThenE") fromThenEIdKey
1479 fromToEName = libFun FSLIT("fromToE") fromToEIdKey
1480 fromThenToEName = libFun FSLIT("fromThenToE") fromThenToEIdKey
1482 listEName = libFun FSLIT("listE") listEIdKey
1483 sigEName = libFun FSLIT("sigE") sigEIdKey
1484 recConEName = libFun FSLIT("recConE") recConEIdKey
1485 recUpdEName = libFun FSLIT("recUpdE") recUpdEIdKey
1487 -- type FieldExp = ...
1488 fieldExpName = libFun FSLIT("fieldExp") fieldExpIdKey
1491 guardedBName = libFun FSLIT("guardedB") guardedBIdKey
1492 normalBName = libFun FSLIT("normalB") normalBIdKey
1495 normalGEName = libFun FSLIT("normalGE") normalGEIdKey
1496 patGEName = libFun FSLIT("patGE") patGEIdKey
1499 bindSName = libFun FSLIT("bindS") bindSIdKey
1500 letSName = libFun FSLIT("letS") letSIdKey
1501 noBindSName = libFun FSLIT("noBindS") noBindSIdKey
1502 parSName = libFun FSLIT("parS") parSIdKey
1505 funDName = libFun FSLIT("funD") funDIdKey
1506 valDName = libFun FSLIT("valD") valDIdKey
1507 dataDName = libFun FSLIT("dataD") dataDIdKey
1508 newtypeDName = libFun FSLIT("newtypeD") newtypeDIdKey
1509 tySynDName = libFun FSLIT("tySynD") tySynDIdKey
1510 classDName = libFun FSLIT("classD") classDIdKey
1511 instanceDName = libFun FSLIT("instanceD") instanceDIdKey
1512 sigDName = libFun FSLIT("sigD") sigDIdKey
1513 forImpDName = libFun FSLIT("forImpD") forImpDIdKey
1516 cxtName = libFun FSLIT("cxt") cxtIdKey
1518 -- data Strict = ...
1519 isStrictName = libFun FSLIT("isStrict") isStrictKey
1520 notStrictName = libFun FSLIT("notStrict") notStrictKey
1523 normalCName = libFun FSLIT("normalC") normalCIdKey
1524 recCName = libFun FSLIT("recC") recCIdKey
1525 infixCName = libFun FSLIT("infixC") infixCIdKey
1526 forallCName = libFun FSLIT("forallC") forallCIdKey
1528 -- type StrictType = ...
1529 strictTypeName = libFun FSLIT("strictType") strictTKey
1531 -- type VarStrictType = ...
1532 varStrictTypeName = libFun FSLIT("varStrictType") varStrictTKey
1535 forallTName = libFun FSLIT("forallT") forallTIdKey
1536 varTName = libFun FSLIT("varT") varTIdKey
1537 conTName = libFun FSLIT("conT") conTIdKey
1538 tupleTName = libFun FSLIT("tupleT") tupleTIdKey
1539 arrowTName = libFun FSLIT("arrowT") arrowTIdKey
1540 listTName = libFun FSLIT("listT") listTIdKey
1541 appTName = libFun FSLIT("appT") appTIdKey
1543 -- data Callconv = ...
1544 cCallName = libFun FSLIT("cCall") cCallIdKey
1545 stdCallName = libFun FSLIT("stdCall") stdCallIdKey
1547 -- data Safety = ...
1548 unsafeName = libFun FSLIT("unsafe") unsafeIdKey
1549 safeName = libFun FSLIT("safe") safeIdKey
1550 threadsafeName = libFun FSLIT("threadsafe") threadsafeIdKey
1552 -- data FunDep = ...
1553 funDepName = libFun FSLIT("funDep") funDepIdKey
1555 matchQTyConName = libTc FSLIT("MatchQ") matchQTyConKey
1556 clauseQTyConName = libTc FSLIT("ClauseQ") clauseQTyConKey
1557 expQTyConName = libTc FSLIT("ExpQ") expQTyConKey
1558 stmtQTyConName = libTc FSLIT("StmtQ") stmtQTyConKey
1559 decQTyConName = libTc FSLIT("DecQ") decQTyConKey
1560 conQTyConName = libTc FSLIT("ConQ") conQTyConKey
1561 strictTypeQTyConName = libTc FSLIT("StrictTypeQ") strictTypeQTyConKey
1562 varStrictTypeQTyConName = libTc FSLIT("VarStrictTypeQ") varStrictTypeQTyConKey
1563 typeQTyConName = libTc FSLIT("TypeQ") typeQTyConKey
1564 fieldExpQTyConName = libTc FSLIT("FieldExpQ") fieldExpQTyConKey
1565 patQTyConName = libTc FSLIT("PatQ") patQTyConKey
1566 fieldPatQTyConName = libTc FSLIT("FieldPatQ") fieldPatQTyConKey
1568 -- TyConUniques available: 100-129
1569 -- Check in PrelNames if you want to change this
1571 expTyConKey = mkPreludeTyConUnique 100
1572 matchTyConKey = mkPreludeTyConUnique 101
1573 clauseTyConKey = mkPreludeTyConUnique 102
1574 qTyConKey = mkPreludeTyConUnique 103
1575 expQTyConKey = mkPreludeTyConUnique 104
1576 decQTyConKey = mkPreludeTyConUnique 105
1577 patTyConKey = mkPreludeTyConUnique 106
1578 matchQTyConKey = mkPreludeTyConUnique 107
1579 clauseQTyConKey = mkPreludeTyConUnique 108
1580 stmtQTyConKey = mkPreludeTyConUnique 109
1581 conQTyConKey = mkPreludeTyConUnique 110
1582 typeQTyConKey = mkPreludeTyConUnique 111
1583 typeTyConKey = mkPreludeTyConUnique 112
1584 decTyConKey = mkPreludeTyConUnique 113
1585 varStrictTypeQTyConKey = mkPreludeTyConUnique 114
1586 strictTypeQTyConKey = mkPreludeTyConUnique 115
1587 fieldExpTyConKey = mkPreludeTyConUnique 116
1588 fieldPatTyConKey = mkPreludeTyConUnique 117
1589 nameTyConKey = mkPreludeTyConUnique 118
1590 patQTyConKey = mkPreludeTyConUnique 119
1591 fieldPatQTyConKey = mkPreludeTyConUnique 120
1592 fieldExpQTyConKey = mkPreludeTyConUnique 121
1593 funDepTyConKey = mkPreludeTyConUnique 122
1595 -- IdUniques available: 200-399
1596 -- If you want to change this, make sure you check in PrelNames
1598 returnQIdKey = mkPreludeMiscIdUnique 200
1599 bindQIdKey = mkPreludeMiscIdUnique 201
1600 sequenceQIdKey = mkPreludeMiscIdUnique 202
1601 liftIdKey = mkPreludeMiscIdUnique 203
1602 newNameIdKey = mkPreludeMiscIdUnique 204
1603 mkNameIdKey = mkPreludeMiscIdUnique 205
1604 mkNameG_vIdKey = mkPreludeMiscIdUnique 206
1605 mkNameG_dIdKey = mkPreludeMiscIdUnique 207
1606 mkNameG_tcIdKey = mkPreludeMiscIdUnique 208
1607 mkNameLIdKey = mkPreludeMiscIdUnique 209
1611 charLIdKey = mkPreludeMiscIdUnique 210
1612 stringLIdKey = mkPreludeMiscIdUnique 211
1613 integerLIdKey = mkPreludeMiscIdUnique 212
1614 intPrimLIdKey = mkPreludeMiscIdUnique 213
1615 floatPrimLIdKey = mkPreludeMiscIdUnique 214
1616 doublePrimLIdKey = mkPreludeMiscIdUnique 215
1617 rationalLIdKey = mkPreludeMiscIdUnique 216
1620 litPIdKey = mkPreludeMiscIdUnique 220
1621 varPIdKey = mkPreludeMiscIdUnique 221
1622 tupPIdKey = mkPreludeMiscIdUnique 222
1623 conPIdKey = mkPreludeMiscIdUnique 223
1624 infixPIdKey = mkPreludeMiscIdUnique 312
1625 tildePIdKey = mkPreludeMiscIdUnique 224
1626 asPIdKey = mkPreludeMiscIdUnique 225
1627 wildPIdKey = mkPreludeMiscIdUnique 226
1628 recPIdKey = mkPreludeMiscIdUnique 227
1629 listPIdKey = mkPreludeMiscIdUnique 228
1630 sigPIdKey = mkPreludeMiscIdUnique 229
1632 -- type FieldPat = ...
1633 fieldPatIdKey = mkPreludeMiscIdUnique 230
1636 matchIdKey = mkPreludeMiscIdUnique 231
1638 -- data Clause = ...
1639 clauseIdKey = mkPreludeMiscIdUnique 232
1642 varEIdKey = mkPreludeMiscIdUnique 240
1643 conEIdKey = mkPreludeMiscIdUnique 241
1644 litEIdKey = mkPreludeMiscIdUnique 242
1645 appEIdKey = mkPreludeMiscIdUnique 243
1646 infixEIdKey = mkPreludeMiscIdUnique 244
1647 infixAppIdKey = mkPreludeMiscIdUnique 245
1648 sectionLIdKey = mkPreludeMiscIdUnique 246
1649 sectionRIdKey = mkPreludeMiscIdUnique 247
1650 lamEIdKey = mkPreludeMiscIdUnique 248
1651 tupEIdKey = mkPreludeMiscIdUnique 249
1652 condEIdKey = mkPreludeMiscIdUnique 250
1653 letEIdKey = mkPreludeMiscIdUnique 251
1654 caseEIdKey = mkPreludeMiscIdUnique 252
1655 doEIdKey = mkPreludeMiscIdUnique 253
1656 compEIdKey = mkPreludeMiscIdUnique 254
1657 fromEIdKey = mkPreludeMiscIdUnique 255
1658 fromThenEIdKey = mkPreludeMiscIdUnique 256
1659 fromToEIdKey = mkPreludeMiscIdUnique 257
1660 fromThenToEIdKey = mkPreludeMiscIdUnique 258
1661 listEIdKey = mkPreludeMiscIdUnique 259
1662 sigEIdKey = mkPreludeMiscIdUnique 260
1663 recConEIdKey = mkPreludeMiscIdUnique 261
1664 recUpdEIdKey = mkPreludeMiscIdUnique 262
1666 -- type FieldExp = ...
1667 fieldExpIdKey = mkPreludeMiscIdUnique 265
1670 guardedBIdKey = mkPreludeMiscIdUnique 266
1671 normalBIdKey = mkPreludeMiscIdUnique 267
1674 normalGEIdKey = mkPreludeMiscIdUnique 310
1675 patGEIdKey = mkPreludeMiscIdUnique 311
1678 bindSIdKey = mkPreludeMiscIdUnique 268
1679 letSIdKey = mkPreludeMiscIdUnique 269
1680 noBindSIdKey = mkPreludeMiscIdUnique 270
1681 parSIdKey = mkPreludeMiscIdUnique 271
1684 funDIdKey = mkPreludeMiscIdUnique 272
1685 valDIdKey = mkPreludeMiscIdUnique 273
1686 dataDIdKey = mkPreludeMiscIdUnique 274
1687 newtypeDIdKey = mkPreludeMiscIdUnique 275
1688 tySynDIdKey = mkPreludeMiscIdUnique 276
1689 classDIdKey = mkPreludeMiscIdUnique 277
1690 instanceDIdKey = mkPreludeMiscIdUnique 278
1691 sigDIdKey = mkPreludeMiscIdUnique 279
1692 forImpDIdKey = mkPreludeMiscIdUnique 297
1695 cxtIdKey = mkPreludeMiscIdUnique 280
1697 -- data Strict = ...
1698 isStrictKey = mkPreludeMiscIdUnique 281
1699 notStrictKey = mkPreludeMiscIdUnique 282
1702 normalCIdKey = mkPreludeMiscIdUnique 283
1703 recCIdKey = mkPreludeMiscIdUnique 284
1704 infixCIdKey = mkPreludeMiscIdUnique 285
1705 forallCIdKey = mkPreludeMiscIdUnique 288
1707 -- type StrictType = ...
1708 strictTKey = mkPreludeMiscIdUnique 286
1710 -- type VarStrictType = ...
1711 varStrictTKey = mkPreludeMiscIdUnique 287
1714 forallTIdKey = mkPreludeMiscIdUnique 290
1715 varTIdKey = mkPreludeMiscIdUnique 291
1716 conTIdKey = mkPreludeMiscIdUnique 292
1717 tupleTIdKey = mkPreludeMiscIdUnique 294
1718 arrowTIdKey = mkPreludeMiscIdUnique 295
1719 listTIdKey = mkPreludeMiscIdUnique 296
1720 appTIdKey = mkPreludeMiscIdUnique 293
1722 -- data Callconv = ...
1723 cCallIdKey = mkPreludeMiscIdUnique 300
1724 stdCallIdKey = mkPreludeMiscIdUnique 301
1726 -- data Safety = ...
1727 unsafeIdKey = mkPreludeMiscIdUnique 305
1728 safeIdKey = mkPreludeMiscIdUnique 306
1729 threadsafeIdKey = mkPreludeMiscIdUnique 307
1731 -- data FunDep = ...
1732 funDepIdKey = mkPreludeMiscIdUnique 320