2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4 %************************************************************************
6 \section[HsCore]{Core-syntax unfoldings in Haskell interface files}
8 %************************************************************************
10 We could either use this, or parameterise @GenCoreExpr@ on @Types@ and
11 @TyVars@ as well. Currently trying the former... MEGA SIGH.
15 module IfaceType, -- Re-export all this
17 IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
18 IfaceExpr(..), IfaceAlt, IfaceNote(..),
19 IfaceBinding(..), IfaceConAlt(..), IfaceIdInfo(..),
20 IfaceInfoItem(..), IfaceRule(..), IfaceInst(..),
25 -- Converting things to IfaceSyn
26 tyThingToIfaceDecl, dfunToIfaceInst, coreRuleToIfaceRule,
29 IfaceEq(..), (&&&), bool, eqListBy, eqMaybeBy,
30 eqIfDecl, eqIfInst, eqIfRule,
33 pprIfaceExpr, pprIfaceDecl, pprIfaceDeclHead
36 #include "HsVersions.h"
41 import FunDeps ( pprFundeps )
42 import NewDemand ( StrictSig, pprIfaceStrictSig )
43 import TcType ( deNoteType, tcSplitDFunTy, mkClassPred )
44 import Type ( TyThing(..), mkForAllTys, splitForAllTys, funResultTy,
45 mkPredTy, tidyTopType )
46 import InstEnv ( DFunId )
47 import Id ( Id, idName, idType, idInfo, idArity, isDataConWorkId_maybe, isFCallId_maybe )
48 import NewDemand ( isTopSig )
49 import IdInfo ( IdInfo, CafInfo(..), WorkerInfo(..),
50 arityInfo, cafInfo, newStrictnessInfo,
51 workerInfo, unfoldingInfo, inlinePragInfo )
52 import TyCon ( TyCon, ArgVrcs, AlgTyConRhs(..), isRecursiveTyCon, isForeignTyCon,
53 isSynTyCon, isAlgTyCon, isPrimTyCon, isFunTyCon,
54 isTupleTyCon, tupleTyConBoxity,
55 tyConHasGenerics, tyConArgVrcs, getSynTyConDefn,
56 tyConArity, tyConTyVars, algTyConRhs, tyConExtName )
57 import DataCon ( dataConName, dataConSig, dataConFieldLabels, dataConStrictMarks,
58 dataConTyCon, dataConIsInfix, isVanillaDataCon )
59 import Class ( FunDep, DefMeth, classExtraBigSig, classTyCon )
60 import OccName ( OccName, OccEnv, lookupOccEnv, emptyOccEnv,
61 lookupOccEnv, extendOccEnv, emptyOccEnv,
62 OccSet, unionOccSets, unitOccSet )
63 import Name ( Name, NamedThing(..), getOccName, nameOccName, nameModuleName, isExternalName )
64 import NameSet ( NameSet, elemNameSet )
65 import Module ( ModuleName )
66 import CostCentre ( CostCentre, pprCostCentreCore )
67 import Literal ( Literal )
68 import ForeignCall ( ForeignCall )
69 import TysPrim ( alphaTyVars )
70 import BasicTypes ( Arity, Activation(..), StrictnessMark,
71 RecFlag(..), boolToRecFlag, Boxity(..),
75 import Maybes ( catMaybes )
76 import Util ( lengthIs )
79 infix 4 `eqIfExt`, `eqIfIdInfo`, `eqIfType`
83 %************************************************************************
85 Data type declarations
87 %************************************************************************
91 = IfaceId { ifName :: OccName,
93 ifIdInfo :: IfaceIdInfo }
95 | IfaceData { ifName :: OccName, -- Type constructor
96 ifTyVars :: [IfaceTvBndr], -- Type variables
97 ifCons :: IfaceConDecls, -- Includes new/data info
98 ifRec :: RecFlag, -- Recursive or not?
100 ifGeneric :: Bool -- True <=> generic converter functions available
101 } -- We need this for imported data decls, since the
102 -- imported modules may have been compiled with
103 -- different flags to the current compilation unit
105 | IfaceSyn { ifName :: OccName, -- Type constructor
106 ifTyVars :: [IfaceTvBndr], -- Type variables
108 ifSynRhs :: IfaceType -- synonym expansion
111 | IfaceClass { ifCtxt :: IfaceContext, -- Context...
112 ifName :: OccName, -- Name of the class
113 ifTyVars :: [IfaceTvBndr], -- Type variables
114 ifFDs :: [FunDep OccName], -- Functional dependencies
115 ifSigs :: [IfaceClassOp], -- Method signatures
116 ifRec :: RecFlag, -- Is newtype/datatype associated with the class recursive?
117 ifVrcs :: ArgVrcs -- ... and what are its argument variances ...
120 | IfaceForeign { ifName :: OccName, -- Needs expanding when we move beyond .NET
121 ifExtName :: Maybe FastString }
123 data IfaceClassOp = IfaceClassOp OccName DefMeth IfaceType
124 -- Nothing => no default method
125 -- Just False => ordinary polymorphic default method
126 -- Just True => generic default method
129 = IfAbstractTyCon -- No info
130 | IfDataTyCon -- data type decls
131 (Maybe IfaceContext) -- See TyCon.AlgTyConRhs; H98 or GADT
133 | IfNewTyCon IfaceConDecl -- newtype decls
135 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
136 visibleIfConDecls IfAbstractTyCon = []
137 visibleIfConDecls (IfDataTyCon _ cs) = cs
138 visibleIfConDecls (IfNewTyCon c) = [c]
142 ifConOcc :: OccName, -- Constructor name
143 ifConInfix :: Bool, -- True <=> declared infix
144 ifConArgTys :: [IfaceType], -- Arg types
145 ifConStricts :: [StrictnessMark], -- Empty (meaning all lazy), or 1-1 corresp with arg types
146 ifConFields :: [OccName] } -- ...ditto... (field labels)
148 ifConOcc :: OccName, -- Constructor name
149 ifConTyVars :: [IfaceTvBndr], -- All tyvars
150 ifConCtxt :: IfaceContext, -- Non-stupid context
151 ifConArgTys :: [IfaceType], -- Arg types
152 ifConResTys :: [IfaceType], -- Result type args
153 ifConStricts :: [StrictnessMark] } -- Empty (meaning all lazy), or 1-1 corresp with arg types
155 data IfaceInst = IfaceInst { ifInstHead :: IfaceType, -- Just the instance head type, quantified
156 -- so that it'll compare alpha-wise
157 ifDFun :: OccName } -- And the dfun
158 -- There's always a separate IfaceDecl for the DFun, which gives
159 -- its IdInfo with its full type and version number.
160 -- The instance declarations taken together have a version number,
161 -- and we don't want that to wobble gratuitously
162 -- If this instance decl is *used*, we'll record a usage on the dfun;
163 -- and if the head does not change it won't be used if it wasn't before
167 ifRuleName :: RuleName,
168 ifActivation :: Activation,
169 ifRuleBndrs :: [IfaceBndr], -- Tyvars and term vars
170 ifRuleHead :: IfaceExtName, -- Head of lhs
171 ifRuleArgs :: [IfaceExpr], -- Args of LHS
172 ifRuleRhs :: IfaceExpr
174 | IfaceBuiltinRule IfaceExtName CoreRule -- So that built-in rules can
175 -- wait in the RulePol
178 = NoInfo -- When writing interface file without -O
179 | HasInfo [IfaceInfoItem] -- Has info, and here it is
181 -- Here's a tricky case:
182 -- * Compile with -O module A, and B which imports A.f
183 -- * Change function f in A, and recompile without -O
184 -- * When we read in old A.hi we read in its IdInfo (as a thunk)
185 -- (In earlier GHCs we used to drop IdInfo immediately on reading,
186 -- but we do not do that now. Instead it's discarded when the
187 -- ModIface is read into the various decl pools.)
188 -- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
189 -- and so gives a new version.
193 | HsStrictness StrictSig
194 | HsUnfold Activation IfaceExpr
196 | HsWorker IfaceExtName Arity -- Worker, if any see IdInfo.WorkerInfo
197 -- for why we want arity here.
198 -- NB: we need IfaceExtName (not just OccName) because the worker
199 -- can simplify to a function in another module.
200 -- NB: Specialisations and rules come in separately and are
201 -- only later attached to the Id. Partial reason: some are orphans.
203 --------------------------------
206 | IfaceExt IfaceExtName
207 | IfaceType IfaceType
208 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
209 | IfaceLam IfaceBndr IfaceExpr
210 | IfaceApp IfaceExpr IfaceExpr
212 | IfaceCase IfaceExpr OccName IfaceType [IfaceAlt]
213 | IfaceLet IfaceBinding IfaceExpr
214 | IfaceNote IfaceNote IfaceExpr
216 | IfaceFCall ForeignCall IfaceType
218 data IfaceNote = IfaceSCC CostCentre
219 | IfaceCoerce IfaceType
222 | IfaceCoreNote String
224 type IfaceAlt = (IfaceConAlt, [OccName], IfaceExpr)
225 -- Note: OccName, not IfaceBndr (and same with the case binder)
226 -- We reconstruct the kind/type of the thing from the context
227 -- thus saving bulk in interface files
229 data IfaceConAlt = IfaceDefault
230 | IfaceDataAlt OccName
231 | IfaceTupleAlt Boxity
232 | IfaceLitAlt Literal
235 = IfaceNonRec IfaceIdBndr IfaceExpr
236 | IfaceRec [(IfaceIdBndr, IfaceExpr)]
240 %************************************************************************
242 \subsection[HsCore-print]{Printing Core unfoldings}
244 %************************************************************************
246 ----------------------------- Printing IfaceDecl ------------------------------------
249 instance Outputable IfaceDecl where
252 pprIfaceDecl (IfaceId {ifName = var, ifType = ty, ifIdInfo = info})
253 = sep [ ppr var <+> dcolon <+> ppr ty,
256 pprIfaceDecl (IfaceForeign {ifName = tycon})
257 = hsep [ptext SLIT("foreign import type dotnet"), ppr tycon]
259 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, ifSynRhs = mono_ty, ifVrcs = vrcs})
260 = hang (ptext SLIT("type") <+> pprIfaceDeclHead [] tycon tyvars)
261 4 (vcat [equals <+> ppr mono_ty,
264 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen,
265 ifTyVars = tyvars, ifCons = condecls,
266 ifRec = isrec, ifVrcs = vrcs})
267 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
268 4 (vcat [pprVrcs vrcs, pprRec isrec, pprGen gen, pp_condecls tycon condecls])
272 IfAbstractTyCon -> ([], ptext SLIT("data"))
273 IfDataTyCon Nothing _ -> ([], ptext SLIT("data"))
274 IfDataTyCon (Just c) _ -> (c, ptext SLIT("data"))
275 IfNewTyCon _ -> ([], ptext SLIT("newtype"))
277 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
278 ifFDs = fds, ifSigs = sigs, ifVrcs = vrcs, ifRec = isrec})
279 = hang (ptext SLIT("class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
280 4 (vcat [pprVrcs vrcs,
284 pprVrcs vrcs = ptext SLIT("Variances") <+> ppr vrcs
285 pprRec isrec = ptext SLIT("RecFlag") <+> ppr isrec
286 pprGen True = ptext SLIT("Generics: yes")
287 pprGen False = ptext SLIT("Generics: no")
289 instance Outputable IfaceClassOp where
290 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
292 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
293 pprIfaceDeclHead context thing tyvars
294 = hsep [pprIfaceContext context, ppr thing, pprIfaceTvBndrs tyvars]
296 pp_condecls tc IfAbstractTyCon = ptext SLIT("{- abstract -}")
297 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
298 pp_condecls tc (IfDataTyCon _ cs) = equals <+> sep (punctuate (ptext SLIT(" |"))
299 (map (pprIfaceConDecl tc) cs))
301 pprIfaceConDecl tc (IfVanillaCon {
302 ifConOcc = name, ifConInfix = is_infix,
303 ifConArgTys = arg_tys,
304 ifConStricts = strs, ifConFields = fields })
305 = sep [ppr name <+> sep (map pprParendIfaceType arg_tys),
306 if is_infix then ptext SLIT("Infix") else empty,
307 if null strs then empty
308 else nest 4 (ptext SLIT("Stricts:") <+> hsep (map ppr strs)),
309 if null fields then empty
310 else nest 4 (ptext SLIT("Fields:") <+> hsep (map ppr fields))]
312 pprIfaceConDecl tc (IfGadtCon {
314 ifConTyVars = tvs, ifConCtxt = ctxt,
315 ifConArgTys = arg_tys, ifConResTys = res_tys,
316 ifConStricts = strs })
317 = sep [ppr name <+> dcolon <+> pprIfaceForAllPart tvs ctxt (ppr con_tau),
318 if null strs then empty
319 else nest 4 (ptext SLIT("Stricts:") <+> hsep (map ppr strs))]
321 con_tau = foldr1 IfaceFunTy (arg_tys ++ [tc_app])
322 tc_app = IfaceTyConApp (IfaceTc (LocalTop tc)) res_tys
323 -- Gruesome, but jsut for debug print
325 instance Outputable IfaceRule where
326 ppr (IfaceRule name act bndrs fn args rhs)
327 = sep [hsep [doubleQuotes (ftext name), ppr act,
328 ptext SLIT("forall") <+> pprIfaceBndrs bndrs],
329 nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
330 ptext SLIT("=") <+> ppr rhs])
332 ppr (IfaceBuiltinRule name rule)
333 = ptext SLIT("Built-in rule for") <+> ppr name
335 instance Outputable IfaceInst where
336 ppr (IfaceInst {ifDFun = dfun_id, ifInstHead = ty})
337 = hang (ptext SLIT("instance") <+> ppr ty)
338 2 (equals <+> ppr dfun_id)
342 ----------------------------- Printing IfaceExpr ------------------------------------
345 instance Outputable IfaceExpr where
346 ppr e = pprIfaceExpr noParens e
348 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
349 -- The function adds parens in context that need
350 -- an atomic value (e.g. function args)
352 pprIfaceExpr add_par (IfaceLcl v) = ppr v
353 pprIfaceExpr add_par (IfaceExt v) = ppr v
354 pprIfaceExpr add_par (IfaceLit l) = ppr l
355 pprIfaceExpr add_par (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
356 pprIfaceExpr add_par (IfaceType ty) = char '@' <+> pprParendIfaceType ty
358 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
359 pprIfaceExpr add_par (IfaceTuple c as) = tupleParens c (interpp'SP as)
361 pprIfaceExpr add_par e@(IfaceLam _ _)
362 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
363 pprIfaceExpr noParens body])
365 (bndrs,body) = collect [] e
366 collect bs (IfaceLam b e) = collect (b:bs) e
367 collect bs e = (reverse bs, e)
370 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
372 = add_par (sep [ptext SLIT("case") <+> char '@' <+> pprParendIfaceType ty <+> pprIfaceExpr noParens scrut <+> ptext SLIT("of")
373 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
374 pprIfaceExpr noParens rhs <+> char '}'])
377 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
379 = add_par (sep [ptext SLIT("case") <+> char '@' <+> pprParendIfaceType ty <+> pprIfaceExpr noParens scrut <+> ptext SLIT("of")
380 <+> ppr bndr <+> char '{',
381 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
383 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
384 = add_par (sep [ptext SLIT("let {"),
385 nest 2 (ppr_bind (b, rhs)),
387 pprIfaceExpr noParens body])
389 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
390 = add_par (sep [ptext SLIT("letrec {"),
391 nest 2 (sep (map ppr_bind pairs)),
393 pprIfaceExpr noParens body])
395 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
397 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
398 arrow <+> pprIfaceExpr noParens rhs]
400 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
401 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
403 ppr_bind ((b,ty),rhs) = sep [ppr b <+> dcolon <+> ppr ty,
404 equals <+> pprIfaceExpr noParens rhs]
407 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args)
408 pprIfaceApp fun args = sep (pprIfaceExpr parens fun : args)
411 instance Outputable IfaceNote where
412 ppr (IfaceSCC cc) = pprCostCentreCore cc
413 ppr (IfaceCoerce ty) = ptext SLIT("__coerce") <+> pprParendIfaceType ty
414 ppr IfaceInlineCall = ptext SLIT("__inline_call")
415 ppr IfaceInlineMe = ptext SLIT("__inline_me")
416 ppr (IfaceCoreNote s) = ptext SLIT("__core_note") <+> pprHsString (mkFastString s)
418 instance Outputable IfaceConAlt where
419 ppr IfaceDefault = text "DEFAULT"
420 ppr (IfaceLitAlt l) = ppr l
421 ppr (IfaceDataAlt d) = ppr d
422 -- IfaceTupleAlt is handled by the case-alternative printer
425 instance Outputable IfaceIdInfo where
427 ppr (HasInfo is) = ptext SLIT("{-") <+> fsep (map ppr_hs_info is) <+> ptext SLIT("-}")
429 ppr_hs_info (HsUnfold prag unf) = sep [ptext SLIT("Unfolding: ") <> ppr prag,
430 parens (pprIfaceExpr noParens unf)]
431 ppr_hs_info (HsArity arity) = ptext SLIT("Arity:") <+> int arity
432 ppr_hs_info (HsStrictness str) = ptext SLIT("Strictness:") <+> pprIfaceStrictSig str
433 ppr_hs_info HsNoCafRefs = ptext SLIT("HasNoCafRefs")
434 ppr_hs_info (HsWorker w a) = ptext SLIT("Worker:") <+> ppr w <+> int a
438 %************************************************************************
440 Converting things to their Iface equivalents
442 %************************************************************************
446 tyThingToIfaceDecl :: Bool
447 -> NameSet -- Tycons and classes to export abstractly
448 -> (Name -> IfaceExtName) -> TyThing -> IfaceDecl
449 tyThingToIfaceDecl discard_id_info _ ext (AnId id)
450 = IfaceId { ifName = getOccName id,
451 ifType = toIfaceType ext (idType id),
454 info | discard_id_info = NoInfo
455 | otherwise = HasInfo (toIfaceIdInfo ext (idInfo id))
457 tyThingToIfaceDecl _ _ ext (AClass clas)
458 = IfaceClass { ifCtxt = toIfaceContext ext sc_theta,
459 ifName = getOccName clas,
460 ifTyVars = toIfaceTvBndrs clas_tyvars,
461 ifFDs = map toIfaceFD clas_fds,
462 ifSigs = map toIfaceClassOp op_stuff,
463 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
464 ifVrcs = tyConArgVrcs tycon }
466 (clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
467 tycon = classTyCon clas
469 toIfaceClassOp (sel_id, def_meth)
470 = ASSERT(sel_tyvars == clas_tyvars)
471 IfaceClassOp (getOccName sel_id) def_meth (toIfaceType ext op_ty)
473 -- Be careful when splitting the type, because of things
474 -- like class Foo a where
475 -- op :: (?x :: String) => a -> a
476 -- and class Baz a where
477 -- op :: (Ord a) => a -> a
478 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
479 op_ty = funResultTy rho_ty
481 toIfaceFD (tvs1, tvs2) = (map getOccName tvs1, map getOccName tvs2)
483 tyThingToIfaceDecl _ abstract_tcs ext (ATyCon tycon)
485 = IfaceSyn { ifName = getOccName tycon,
486 ifTyVars = toIfaceTvBndrs tyvars,
487 ifVrcs = tyConArgVrcs tycon,
488 ifSynRhs = toIfaceType ext syn_ty }
491 = IfaceData { ifName = getOccName tycon,
492 ifTyVars = toIfaceTvBndrs tyvars,
493 ifCons = ifaceConDecls (algTyConRhs tycon),
494 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
495 ifVrcs = tyConArgVrcs tycon,
496 ifGeneric = tyConHasGenerics tycon }
498 | isForeignTyCon tycon
499 = IfaceForeign { ifName = getOccName tycon,
500 ifExtName = tyConExtName tycon }
502 | isPrimTyCon tycon || isFunTyCon tycon
503 -- Needed in GHCi for ':info Int#', for example
504 = IfaceData { ifName = getOccName tycon,
505 ifTyVars = toIfaceTvBndrs (take (tyConArity tycon) alphaTyVars),
506 ifCons = IfAbstractTyCon,
508 ifRec = NonRecursive,
509 ifVrcs = tyConArgVrcs tycon }
511 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
513 tyvars = tyConTyVars tycon
514 (_, syn_ty) = getSynTyConDefn tycon
515 abstract = getName tycon `elemNameSet` abstract_tcs
517 ifaceConDecls _ | abstract = IfAbstractTyCon
518 ifaceConDecls (NewTyCon con _ _) = IfNewTyCon (ifaceConDecl con)
519 ifaceConDecls (DataTyCon mb_theta cons _) = IfDataTyCon (ifaceDataCtxt mb_theta)
520 (map ifaceConDecl cons)
521 ifaceConDecls AbstractTyCon = IfAbstractTyCon
522 -- The last case should never happen when we are generating an
523 -- interface file (we're exporting this thing, so it's locally defined
524 -- and should not be abstract). But tyThingToIfaceDecl is also used
525 -- in TcRnDriver for GHCi, when browsing a module, in which case the
526 -- AbstractTyCon case is perfectly sensible.
528 ifaceDataCtxt Nothing = Nothing
529 ifaceDataCtxt (Just theta) = Just (toIfaceContext ext theta)
531 ifaceConDecl data_con
532 | isVanillaDataCon data_con
533 = IfVanillaCon {ifConOcc = getOccName (dataConName data_con),
534 ifConInfix = dataConIsInfix data_con,
535 ifConArgTys = map (toIfaceType ext) arg_tys,
536 ifConStricts = strict_marks,
537 ifConFields = map getOccName field_labels }
539 = IfGadtCon { ifConOcc = getOccName (dataConName data_con),
540 ifConTyVars = toIfaceTvBndrs tyvars,
541 ifConCtxt = toIfaceContext ext theta,
542 ifConArgTys = map (toIfaceType ext) arg_tys,
543 ifConResTys = map (toIfaceType ext) res_tys,
544 ifConStricts = strict_marks }
546 (tyvars, theta, arg_tys, _, res_tys) = dataConSig data_con
547 field_labels = dataConFieldLabels data_con
548 strict_marks = dataConStrictMarks data_con
550 tyThingToIfaceDecl dis abstr ext (ADataCon dc)
551 = pprPanic "toIfaceDecl" (ppr dc)
554 --------------------------
555 dfunToIfaceInst :: DFunId -> IfaceInst
556 dfunToIfaceInst dfun_id
557 = IfaceInst { ifDFun = nameOccName dfun_name,
558 ifInstHead = toIfaceType (mkLhsNameFn mod) tidy_ty }
560 dfun_name = idName dfun_id
561 mod = nameModuleName dfun_name
562 (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
563 head_ty = mkForAllTys tvs (mkPredTy (mkClassPred cls tys))
564 -- No need to record the instance context;
565 -- it's in the dfun anyway
567 tidy_ty = tidyTopType (deNoteType head_ty)
568 -- The deNoteType is very important. It removes all type
569 -- synonyms from the instance type in interface files.
570 -- That in turn makes sure that when reading in instance decls
571 -- from interface files that the 'gating' mechanism works properly.
572 -- Otherwise you could have
573 -- type Tibble = T Int
574 -- instance Foo Tibble where ...
575 -- and this instance decl wouldn't get imported into a module
576 -- that mentioned T but not Tibble.
579 --------------------------
580 toIfaceIdInfo :: (Name -> IfaceExtName) -> IdInfo -> [IfaceInfoItem]
581 toIfaceIdInfo ext id_info
582 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
583 wrkr_hsinfo, unfold_hsinfo]
585 ------------ Arity --------------
586 arity_info = arityInfo id_info
587 arity_hsinfo | arity_info == 0 = Nothing
588 | otherwise = Just (HsArity arity_info)
590 ------------ Caf Info --------------
591 caf_info = cafInfo id_info
592 caf_hsinfo = case caf_info of
593 NoCafRefs -> Just HsNoCafRefs
596 ------------ Strictness --------------
597 -- No point in explicitly exporting TopSig
598 strict_hsinfo = case newStrictnessInfo id_info of
599 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
602 ------------ Worker --------------
603 work_info = workerInfo id_info
604 has_worker = case work_info of { HasWorker _ _ -> True; other -> False }
605 wrkr_hsinfo = case work_info of
606 HasWorker work_id wrap_arity ->
607 Just (HsWorker (ext (idName work_id)) wrap_arity)
610 ------------ Unfolding --------------
611 -- The unfolding is redundant if there is a worker
612 unfold_info = unfoldingInfo id_info
613 inline_prag = inlinePragInfo id_info
614 rhs = unfoldingTemplate unfold_info
615 unfold_hsinfo | neverUnfold unfold_info
616 || has_worker = Nothing
617 | otherwise = Just (HsUnfold inline_prag (toIfaceExpr ext rhs))
619 --------------------------
620 coreRuleToIfaceRule :: ModuleName -> (Name -> IfaceExtName) -> IdCoreRule -> IfaceRule
621 coreRuleToIfaceRule mod ext (IdCoreRule id _ (BuiltinRule _ _))
622 = pprTrace "toHsRule: builtin" (ppr id) (bogusIfaceRule (mkIfaceExtName (getName id)))
624 coreRuleToIfaceRule mod ext (IdCoreRule id _ (Rule name act bndrs args rhs))
625 = IfaceRule { ifRuleName = name, ifActivation = act,
626 ifRuleBndrs = map (toIfaceBndr ext) bndrs,
627 ifRuleHead = ext (idName id),
628 ifRuleArgs = map (toIfaceExpr (mkLhsNameFn mod)) args,
629 -- Use LHS name-fn for the args
630 ifRuleRhs = toIfaceExpr ext rhs }
632 bogusIfaceRule :: IfaceExtName -> IfaceRule
633 bogusIfaceRule id_name
634 = IfaceRule FSLIT("bogus") NeverActive [] id_name [] (IfaceExt id_name)
636 ---------------------
637 toIfaceExpr :: (Name -> IfaceExtName) -> CoreExpr -> IfaceExpr
638 toIfaceExpr ext (Var v) = toIfaceVar ext v
639 toIfaceExpr ext (Lit l) = IfaceLit l
640 toIfaceExpr ext (Type ty) = IfaceType (toIfaceType ext ty)
641 toIfaceExpr ext (Lam x b) = IfaceLam (toIfaceBndr ext x) (toIfaceExpr ext b)
642 toIfaceExpr ext (App f a) = toIfaceApp ext f [a]
644 toIfaceExpr ext (Case s x ty as) = IfaceCase (toIfaceExpr ext s) (getOccName x) (toIfaceType ext ty) (map (toIfaceAlt ext) as)
645 toIfaceExpr ext (Let b e) = IfaceLet (toIfaceBind ext b) (toIfaceExpr ext e)
646 toIfaceExpr ext (Note n e) = IfaceNote (toIfaceNote ext n) (toIfaceExpr ext e)
648 ---------------------
649 toIfaceNote ext (SCC cc) = IfaceSCC cc
650 toIfaceNote ext (Coerce t1 _) = IfaceCoerce (toIfaceType ext t1)
651 toIfaceNote ext InlineCall = IfaceInlineCall
652 toIfaceNote ext InlineMe = IfaceInlineMe
653 toIfaceNote ext (CoreNote s) = IfaceCoreNote s
655 ---------------------
656 toIfaceBind ext (NonRec b r) = IfaceNonRec (toIfaceIdBndr ext b) (toIfaceExpr ext r)
657 toIfaceBind ext (Rec prs) = IfaceRec [(toIfaceIdBndr ext b, toIfaceExpr ext r) | (b,r) <- prs]
659 ---------------------
660 toIfaceAlt ext (c,bs,r) = (toIfaceCon c, map getOccName bs, toIfaceExpr ext r)
662 ---------------------
663 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
664 | otherwise = IfaceDataAlt (getOccName dc)
668 toIfaceCon (LitAlt l) = IfaceLitAlt l
669 toIfaceCon DEFAULT = IfaceDefault
671 ---------------------
672 toIfaceApp ext (App f a) as = toIfaceApp ext f (a:as)
673 toIfaceApp ext (Var v) as
674 = case isDataConWorkId_maybe v of
675 -- We convert the *worker* for tuples into IfaceTuples
676 Just dc | isTupleTyCon tc && saturated
677 -> IfaceTuple (tupleTyConBoxity tc) tup_args
679 val_args = dropWhile isTypeArg as
680 saturated = val_args `lengthIs` idArity v
681 tup_args = map (toIfaceExpr ext) val_args
684 other -> mkIfaceApps ext (toIfaceVar ext v) as
686 toIfaceApp ext e as = mkIfaceApps ext (toIfaceExpr ext e) as
688 mkIfaceApps ext f as = foldl (\f a -> IfaceApp f (toIfaceExpr ext a)) f as
690 ---------------------
691 toIfaceVar :: (Name -> IfaceExtName) -> Id -> IfaceExpr
693 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType ext (idType v))
694 -- Foreign calls have special syntax
695 | isExternalName name = IfaceExt (ext name)
696 | otherwise = IfaceLcl (nameOccName name)
700 ---------------------
701 -- mkLhsNameFn ignores versioning info altogether
702 -- Used for the LHS of instance decls and rules, where we
703 -- there's no point in recording version info
704 mkLhsNameFn :: ModuleName -> Name -> IfaceExtName
705 mkLhsNameFn this_mod name
706 | mod == this_mod = LocalTop occ
707 | otherwise = ExtPkg mod occ
709 mod = nameModuleName name
710 occ = nameOccName name
714 %************************************************************************
716 Equality, for interface file version generaion only
718 %************************************************************************
720 Equality over IfaceSyn returns an IfaceEq, not a Bool. The new constructor is
721 EqBut, which gives the set of *locally-defined* things whose version must be equal
722 for the whole thing to be equal. So the key function is eqIfExt, which compares
725 Of course, equality is also done modulo alpha conversion.
729 = Equal -- Definitely exactly the same
730 | NotEqual -- Definitely different
731 | EqBut OccSet -- The same provided these local things have not changed
733 bool :: Bool -> IfaceEq
735 bool False = NotEqual
737 zapEq :: IfaceEq -> IfaceEq -- Used to forget EqBut information
738 zapEq (EqBut _) = Equal
741 (&&&) :: IfaceEq -> IfaceEq -> IfaceEq
743 NotEqual &&& x = NotEqual
744 EqBut occs &&& Equal = EqBut occs
745 EqBut occs &&& NotEqual = NotEqual
746 EqBut occs1 &&& EqBut occs2 = EqBut (occs1 `unionOccSets` occs2)
748 ---------------------
749 eqIfExt :: IfaceExtName -> IfaceExtName -> IfaceEq
750 -- This function is the core of the EqBut stuff
751 eqIfExt (ExtPkg mod1 occ1) (ExtPkg mod2 occ2) = bool (mod1==mod2 && occ1==occ2)
752 eqIfExt (HomePkg mod1 occ1 v1) (HomePkg mod2 occ2 v2) = bool (mod1==mod2 && occ1==occ2 && v1==v2)
753 eqIfExt (LocalTop occ1) (LocalTop occ2) | occ1 == occ2 = EqBut (unitOccSet occ1)
754 eqIfExt (LocalTopSub occ1 p1) (LocalTop occ2) | occ1 == occ2 = EqBut (unitOccSet p1)
755 eqIfExt (LocalTopSub occ1 p1) (LocalTopSub occ2 _) | occ1 == occ2 = EqBut (unitOccSet p1)
756 eqIfExt n1 n2 = NotEqual
761 ---------------------
762 eqIfDecl :: IfaceDecl -> IfaceDecl -> IfaceEq
763 eqIfDecl (IfaceId s1 t1 i1) (IfaceId s2 t2 i2)
764 = bool (s1 == s2) &&& (t1 `eqIfType` t2) &&& (i1 `eqIfIdInfo` i2)
766 eqIfDecl d1@(IfaceForeign {}) d2@(IfaceForeign {})
767 = bool (ifName d1 == ifName d2 && ifExtName d1 == ifExtName d2)
769 eqIfDecl d1@(IfaceData {}) d2@(IfaceData {})
770 = bool (ifName d1 == ifName d2 &&
771 ifRec d1 == ifRec d2 &&
772 ifVrcs d1 == ifVrcs d2 &&
773 ifGeneric d1 == ifGeneric d2) &&&
774 eqWith (ifTyVars d1) (ifTyVars d2) (\ env ->
775 eq_hsCD env (ifCons d1) (ifCons d2)
777 -- The type variables of the data type do not scope
778 -- over the constructors (any more), but they do scope
779 -- over the stupid context in the IfaceConDecls
781 eqIfDecl d1@(IfaceSyn {}) d2@(IfaceSyn {})
782 = bool (ifName d1 == ifName d2) &&&
783 eqWith (ifTyVars d1) (ifTyVars d2) (\ env ->
784 eq_ifType env (ifSynRhs d1) (ifSynRhs d2)
787 eqIfDecl d1@(IfaceClass {}) d2@(IfaceClass {})
788 = bool (ifName d1 == ifName d2 &&
789 ifRec d1 == ifRec d2 &&
790 ifVrcs d1 == ifVrcs d2) &&&
791 eqWith (ifTyVars d1) (ifTyVars d2) (\ env ->
792 eq_ifContext env (ifCtxt d1) (ifCtxt d2) &&&
793 eqListBy (eq_hsFD env) (ifFDs d1) (ifFDs d2) &&&
794 eqListBy (eq_cls_sig env) (ifSigs d1) (ifSigs d2)
797 eqIfDecl _ _ = NotEqual -- default case
800 eqWith :: [IfaceTvBndr] -> [IfaceTvBndr] -> (EqEnv -> IfaceEq) -> IfaceEq
801 eqWith = eq_ifTvBndrs emptyEqEnv
803 -----------------------
804 eqIfInst d1 d2 = bool (ifDFun d1 == ifDFun d2) &&&
805 zapEq (ifInstHead d1 `eqIfType` ifInstHead d2)
806 -- zapEq: for instances, ignore the EqBut part
808 eqIfRule (IfaceRule n1 a1 bs1 f1 es1 rhs1)
809 (IfaceRule n2 a2 bs2 f2 es2 rhs2)
810 = bool (n1==n2 && a1==a2) &&&
812 eq_ifBndrs emptyEqEnv bs1 bs2 (\env ->
813 zapEq (eqListBy (eq_ifaceExpr env) es1 es2) &&&
814 -- zapEq: for the LHSs, ignore the EqBut part
815 eq_ifaceExpr env rhs1 rhs2)
816 eqIfRule _ _ = NotEqual
818 eq_hsCD env (IfDataTyCon st1 c1) (IfDataTyCon st2 c2)
819 = eqMaybeBy (eq_ifContext env) st1 st2 &&&
820 eqListBy (eq_ConDecl env) c1 c2
822 eq_hsCD env (IfNewTyCon c1) (IfNewTyCon c2) = eq_ConDecl env c1 c2
823 eq_hsCD env IfAbstractTyCon IfAbstractTyCon = Equal
824 eq_hsCD env d1 d2 = NotEqual
826 eq_ConDecl env c1@(IfVanillaCon {}) c2@(IfVanillaCon {})
827 = bool (ifConOcc c1 == ifConOcc c2 &&
828 ifConInfix c1 == ifConInfix c2 &&
829 ifConStricts c1 == ifConStricts c2 &&
830 ifConFields c1 == ifConFields c2) &&&
831 eq_ifTypes env (ifConArgTys c1) (ifConArgTys c2)
833 eq_ConDecl env c1@(IfGadtCon {}) c2@(IfGadtCon {})
834 = bool (ifConOcc c1 == ifConOcc c2 &&
835 ifConStricts c1 == ifConStricts c2) &&&
836 eq_ifTvBndrs env (ifConTyVars c1) (ifConTyVars c2) (\ env ->
837 eq_ifContext env (ifConCtxt c1) (ifConCtxt c2) &&&
838 eq_ifTypes env (ifConResTys c1) (ifConResTys c2) &&&
839 eq_ifTypes env (ifConArgTys c1) (ifConArgTys c2))
841 eq_ConDecl env c1 c2 = NotEqual
843 eq_hsFD env (ns1,ms1) (ns2,ms2)
844 = eqListBy (eqIfOcc env) ns1 ns2 &&& eqListBy (eqIfOcc env) ms1 ms2
846 eq_cls_sig env (IfaceClassOp n1 dm1 ty1) (IfaceClassOp n2 dm2 ty2)
847 = bool (n1==n2 && dm1 == dm2) &&& eq_ifType env ty1 ty2
853 eqIfIdInfo NoInfo NoInfo = Equal
854 eqIfIdInfo (HasInfo is1) (HasInfo is2) = eqListBy eq_item is1 is2
855 eqIfIdInfo i1 i2 = NotEqual
857 eq_item (HsArity a1) (HsArity a2) = bool (a1 == a2)
858 eq_item (HsStrictness s1) (HsStrictness s2) = bool (s1 == s2)
859 eq_item (HsUnfold a1 u1) (HsUnfold a2 u2) = bool (a1 == a2) &&& eq_ifaceExpr emptyEqEnv u1 u2
860 eq_item HsNoCafRefs HsNoCafRefs = Equal
861 eq_item (HsWorker wkr1 a1) (HsWorker wkr2 a2) = bool (a1==a2) &&& (wkr1 `eqIfExt` wkr2)
862 eq_item _ _ = NotEqual
865 eq_ifaceExpr :: EqEnv -> IfaceExpr -> IfaceExpr -> IfaceEq
866 eq_ifaceExpr env (IfaceLcl v1) (IfaceLcl v2) = eqIfOcc env v1 v2
867 eq_ifaceExpr env (IfaceExt v1) (IfaceExt v2) = eqIfExt v1 v2
868 eq_ifaceExpr env (IfaceLit l1) (IfaceLit l2) = bool (l1 == l2)
869 eq_ifaceExpr env (IfaceFCall c1 ty1) (IfaceFCall c2 ty2) = bool (c1==c2) &&& eq_ifType env ty1 ty2
870 eq_ifaceExpr env (IfaceType ty1) (IfaceType ty2) = eq_ifType env ty1 ty2
871 eq_ifaceExpr env (IfaceTuple n1 as1) (IfaceTuple n2 as2) = bool (n1==n2) &&& eqListBy (eq_ifaceExpr env) as1 as2
872 eq_ifaceExpr env (IfaceLam b1 body1) (IfaceLam b2 body2) = eq_ifBndr env b1 b2 (\env -> eq_ifaceExpr env body1 body2)
873 eq_ifaceExpr env (IfaceApp f1 a1) (IfaceApp f2 a2) = eq_ifaceExpr env f1 f2 &&& eq_ifaceExpr env a1 a2
874 eq_ifaceExpr env (IfaceNote n1 r1) (IfaceNote n2 r2) = eq_ifaceNote env n1 n2 &&& eq_ifaceExpr env r1 r2
876 eq_ifaceExpr env (IfaceCase s1 b1 ty1 as1) (IfaceCase s2 b2 ty2 as2)
877 = eq_ifaceExpr env s1 s2 &&&
878 eq_ifType env ty1 ty2 &&&
879 eq_ifNakedBndr env b1 b2 (\env -> eqListBy (eq_ifaceAlt env) as1 as2)
881 eq_ifaceAlt env (c1,bs1,r1) (c2,bs2,r2)
882 = bool (eq_ifaceConAlt c1 c2) &&&
883 eq_ifNakedBndrs env bs1 bs2 (\env -> eq_ifaceExpr env r1 r2)
885 eq_ifaceExpr env (IfaceLet (IfaceNonRec b1 r1) x1) (IfaceLet (IfaceNonRec b2 r2) x2)
886 = eq_ifaceExpr env r1 r2 &&& eq_ifIdBndr env b1 b2 (\env -> eq_ifaceExpr env x1 x2)
888 eq_ifaceExpr env (IfaceLet (IfaceRec as1) x1) (IfaceLet (IfaceRec as2) x2)
889 = eq_ifIdBndrs env bs1 bs2 (\env -> eqListBy (eq_ifaceExpr env) rs1 rs2 &&& eq_ifaceExpr env x1 x2)
891 (bs1,rs1) = unzip as1
892 (bs2,rs2) = unzip as2
895 eq_ifaceExpr env _ _ = NotEqual
898 eq_ifaceConAlt :: IfaceConAlt -> IfaceConAlt -> Bool
899 eq_ifaceConAlt IfaceDefault IfaceDefault = True
900 eq_ifaceConAlt (IfaceDataAlt n1) (IfaceDataAlt n2) = n1==n2
901 eq_ifaceConAlt (IfaceTupleAlt c1) (IfaceTupleAlt c2) = c1==c2
902 eq_ifaceConAlt (IfaceLitAlt l1) (IfaceLitAlt l2) = l1==l2
903 eq_ifaceConAlt _ _ = False
906 eq_ifaceNote :: EqEnv -> IfaceNote -> IfaceNote -> IfaceEq
907 eq_ifaceNote env (IfaceSCC c1) (IfaceSCC c2) = bool (c1==c2)
908 eq_ifaceNote env (IfaceCoerce t1) (IfaceCoerce t2) = eq_ifType env t1 t2
909 eq_ifaceNote env IfaceInlineCall IfaceInlineCall = Equal
910 eq_ifaceNote env IfaceInlineMe IfaceInlineMe = Equal
911 eq_ifaceNote env (IfaceCoreNote s1) (IfaceCoreNote s2) = bool (s1==s2)
912 eq_ifaceNote env _ _ = NotEqual
916 ---------------------
917 eqIfType t1 t2 = eq_ifType emptyEqEnv t1 t2
920 eq_ifType env (IfaceTyVar n1) (IfaceTyVar n2) = eqIfOcc env n1 n2
921 eq_ifType env (IfaceAppTy s1 t1) (IfaceAppTy s2 t2) = eq_ifType env s1 s2 &&& eq_ifType env t1 t2
922 eq_ifType env (IfacePredTy st1) (IfacePredTy st2) = eq_ifPredType env st1 st2
923 eq_ifType env (IfaceTyConApp tc1 ts1) (IfaceTyConApp tc2 ts2) = tc1 `eqIfTc` tc2 &&& eq_ifTypes env ts1 ts2
924 eq_ifType env (IfaceForAllTy tv1 t1) (IfaceForAllTy tv2 t2) = eq_ifTvBndr env tv1 tv2 (\env -> eq_ifType env t1 t2)
925 eq_ifType env (IfaceFunTy s1 t1) (IfaceFunTy s2 t2) = eq_ifType env s1 s2 &&& eq_ifType env t1 t2
926 eq_ifType env _ _ = NotEqual
929 eq_ifTypes env = eqListBy (eq_ifType env)
932 eq_ifContext env a b = eqListBy (eq_ifPredType env) a b
935 eq_ifPredType env (IfaceClassP c1 tys1) (IfaceClassP c2 tys2) = c1 `eqIfExt` c2 &&& eq_ifTypes env tys1 tys2
936 eq_ifPredType env (IfaceIParam n1 ty1) (IfaceIParam n2 ty2) = bool (n1 == n2) &&& eq_ifType env ty1 ty2
937 eq_ifPredType env _ _ = NotEqual
940 eqIfTc (IfaceTc tc1) (IfaceTc tc2) = tc1 `eqIfExt` tc2
941 eqIfTc IfaceIntTc IfaceIntTc = Equal
942 eqIfTc IfaceCharTc IfaceCharTc = Equal
943 eqIfTc IfaceBoolTc IfaceBoolTc = Equal
944 eqIfTc IfaceListTc IfaceListTc = Equal
945 eqIfTc IfacePArrTc IfacePArrTc = Equal
946 eqIfTc (IfaceTupTc bx1 ar1) (IfaceTupTc bx2 ar2) = bool (bx1==bx2 && ar1==ar2)
947 eqIfTc _ _ = NotEqual
950 -----------------------------------------------------------
951 Support code for equality checking
952 -----------------------------------------------------------
955 ------------------------------------
956 type EqEnv = OccEnv OccName -- Tracks the mapping from L-variables to R-variables
958 eqIfOcc :: EqEnv -> OccName -> OccName -> IfaceEq
959 eqIfOcc env n1 n2 = case lookupOccEnv env n1 of
960 Just n1 -> bool (n1 == n2)
961 Nothing -> bool (n1 == n2)
963 extendEqEnv :: EqEnv -> OccName -> OccName -> EqEnv
964 extendEqEnv env n1 n2 | n1 == n2 = env
965 | otherwise = extendOccEnv env n1 n2
968 emptyEqEnv = emptyOccEnv
970 ------------------------------------
971 type ExtEnv bndr = EqEnv -> bndr -> bndr -> (EqEnv -> IfaceEq) -> IfaceEq
973 eq_ifNakedBndr :: ExtEnv OccName
974 eq_ifBndr :: ExtEnv IfaceBndr
975 eq_ifTvBndr :: ExtEnv IfaceTvBndr
976 eq_ifIdBndr :: ExtEnv IfaceIdBndr
978 eq_ifNakedBndr env n1 n2 k = k (extendEqEnv env n1 n2)
980 eq_ifBndr env (IfaceIdBndr b1) (IfaceIdBndr b2) k = eq_ifIdBndr env b1 b2 k
981 eq_ifBndr env (IfaceTvBndr b1) (IfaceTvBndr b2) k = eq_ifTvBndr env b1 b2 k
982 eq_ifBndr _ _ _ _ = NotEqual
984 eq_ifTvBndr env (v1, k1) (v2, k2) k = bool (k1 == k2) &&& k (extendEqEnv env v1 v2)
985 eq_ifIdBndr env (v1, t1) (v2, t2) k = eq_ifType env t1 t2 &&& k (extendEqEnv env v1 v2)
987 eq_ifBndrs :: ExtEnv [IfaceBndr]
988 eq_ifIdBndrs :: ExtEnv [IfaceIdBndr]
989 eq_ifTvBndrs :: ExtEnv [IfaceTvBndr]
990 eq_ifNakedBndrs :: ExtEnv [OccName]
991 eq_ifBndrs = eq_bndrs_with eq_ifBndr
992 eq_ifIdBndrs = eq_bndrs_with eq_ifIdBndr
993 eq_ifTvBndrs = eq_bndrs_with eq_ifTvBndr
994 eq_ifNakedBndrs = eq_bndrs_with eq_ifNakedBndr
996 eq_bndrs_with eq env [] [] k = k env
997 eq_bndrs_with eq env (b1:bs1) (b2:bs2) k = eq env b1 b2 (\env -> eq_bndrs_with eq env bs1 bs2 k)
998 eq_bndrs_with eq env _ _ _ = NotEqual
1002 eqListBy :: (a->a->IfaceEq) -> [a] -> [a] -> IfaceEq
1003 eqListBy eq [] [] = Equal
1004 eqListBy eq (x:xs) (y:ys) = eq x y &&& eqListBy eq xs ys
1005 eqListBy eq xs ys = NotEqual
1007 eqMaybeBy :: (a->a->IfaceEq) -> Maybe a -> Maybe a -> IfaceEq
1008 eqMaybeBy eq Nothing Nothing = Equal
1009 eqMaybeBy eq (Just x) (Just y) = eq x y
1010 eqMaybeBy eq x y = NotEqual