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, instanceToIfaceInst, 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 )
44 import Type ( TyThing(..), splitForAllTys, funResultTy )
45 import InstEnv ( Instance(..), OverlapFlag )
46 import Id ( Id, idName, idType, idInfo, idArity, isDataConWorkId_maybe, isFCallId_maybe )
47 import NewDemand ( isTopSig )
48 import IdInfo ( IdInfo, CafInfo(..), WorkerInfo(..),
49 arityInfo, cafInfo, newStrictnessInfo,
50 workerInfo, unfoldingInfo, inlinePragInfo )
51 import TyCon ( TyCon, ArgVrcs, AlgTyConRhs(..), isRecursiveTyCon, isForeignTyCon,
52 isSynTyCon, isAlgTyCon, isPrimTyCon, isFunTyCon,
53 isTupleTyCon, tupleTyConBoxity, tyConStupidTheta,
54 tyConHasGenerics, tyConArgVrcs, synTyConRhs,
55 tyConArity, tyConTyVars, algTyConRhs, tyConExtName )
56 import DataCon ( dataConName, dataConSig, dataConFieldLabels, dataConStrictMarks,
57 dataConTyCon, dataConIsInfix, isVanillaDataCon )
58 import Class ( FunDep, DefMeth, classExtraBigSig, classTyCon )
59 import OccName ( OccName, OccEnv, emptyOccEnv,
60 lookupOccEnv, extendOccEnv, parenSymOcc,
61 OccSet, unionOccSets, unitOccSet )
62 import Name ( Name, NamedThing(..), nameOccName, isExternalName )
63 import CostCentre ( CostCentre, pprCostCentreCore )
64 import Literal ( Literal )
65 import ForeignCall ( ForeignCall )
66 import TysPrim ( alphaTyVars )
67 import BasicTypes ( Arity, Activation(..), StrictnessMark,
68 RecFlag(..), boolToRecFlag, Boxity(..),
69 isAlwaysActive, tupleParens )
72 import Maybes ( catMaybes )
73 import Util ( lengthIs )
76 infix 4 `eqIfExt`, `eqIfIdInfo`, `eqIfType`
80 %************************************************************************
82 Data type declarations
84 %************************************************************************
88 = IfaceId { ifName :: OccName,
90 ifIdInfo :: IfaceIdInfo }
92 | IfaceData { ifName :: OccName, -- Type constructor
93 ifTyVars :: [IfaceTvBndr], -- Type variables
94 ifCtxt :: IfaceContext, -- The "stupid theta"
95 ifCons :: IfaceConDecls, -- Includes new/data info
96 ifRec :: RecFlag, -- Recursive or not?
98 ifGeneric :: Bool -- True <=> generic converter functions available
99 } -- We need this for imported data decls, since the
100 -- imported modules may have been compiled with
101 -- different flags to the current compilation unit
103 | IfaceSyn { ifName :: OccName, -- Type constructor
104 ifTyVars :: [IfaceTvBndr], -- Type variables
106 ifSynRhs :: IfaceType -- synonym expansion
109 | IfaceClass { ifCtxt :: IfaceContext, -- Context...
110 ifName :: OccName, -- Name of the class
111 ifTyVars :: [IfaceTvBndr], -- Type variables
112 ifFDs :: [FunDep OccName], -- Functional dependencies
113 ifSigs :: [IfaceClassOp], -- Method signatures
114 ifRec :: RecFlag, -- Is newtype/datatype associated with the class recursive?
115 ifVrcs :: ArgVrcs -- ... and what are its argument variances ...
118 | IfaceForeign { ifName :: OccName, -- Needs expanding when we move beyond .NET
119 ifExtName :: Maybe FastString }
121 data IfaceClassOp = IfaceClassOp OccName DefMeth IfaceType
122 -- Nothing => no default method
123 -- Just False => ordinary polymorphic default method
124 -- Just True => generic default method
127 = IfAbstractTyCon -- No info
128 | IfDataTyCon [IfaceConDecl] -- data type decls
129 | IfNewTyCon IfaceConDecl -- newtype decls
131 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
132 visibleIfConDecls IfAbstractTyCon = []
133 visibleIfConDecls (IfDataTyCon cs) = cs
134 visibleIfConDecls (IfNewTyCon c) = [c]
138 ifConOcc :: OccName, -- Constructor name
139 ifConInfix :: Bool, -- True <=> declared infix
140 ifConArgTys :: [IfaceType], -- Arg types
141 ifConStricts :: [StrictnessMark], -- Empty (meaning all lazy), or 1-1 corresp with arg types
142 ifConFields :: [OccName] } -- ...ditto... (field labels)
144 ifConOcc :: OccName, -- Constructor name
145 ifConTyVars :: [IfaceTvBndr], -- All tyvars
146 ifConCtxt :: IfaceContext, -- Non-stupid context
147 ifConArgTys :: [IfaceType], -- Arg types
148 ifConResTys :: [IfaceType], -- Result type args
149 ifConStricts :: [StrictnessMark] } -- Empty (meaning all lazy), or 1-1 corresp with arg types
152 = IfaceInst { ifInstCls :: IfaceExtName, -- See comments with
153 ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance
154 ifDFun :: OccName, -- The dfun
155 ifOFlag :: OverlapFlag, -- Overlap flag
156 ifInstOrph :: Maybe OccName } -- See is_orph in defn of Instance
157 -- There's always a separate IfaceDecl for the DFun, which gives
158 -- its IdInfo with its full type and version number.
159 -- The instance declarations taken together have a version number,
160 -- and we don't want that to wobble gratuitously
161 -- If this instance decl is *used*, we'll record a usage on the dfun;
162 -- and if the head does not change it won't be used if it wasn't before
166 ifRuleName :: RuleName,
167 ifActivation :: Activation,
168 ifRuleBndrs :: [IfaceBndr], -- Tyvars and term vars
169 ifRuleHead :: IfaceExtName, -- Head of lhs
170 ifRuleArgs :: [IfaceExpr], -- Args of LHS
171 ifRuleRhs :: IfaceExpr,
172 ifRuleOrph :: Maybe OccName -- Just like IfaceInst
176 = NoInfo -- When writing interface file without -O
177 | HasInfo [IfaceInfoItem] -- Has info, and here it is
179 -- Here's a tricky case:
180 -- * Compile with -O module A, and B which imports A.f
181 -- * Change function f in A, and recompile without -O
182 -- * When we read in old A.hi we read in its IdInfo (as a thunk)
183 -- (In earlier GHCs we used to drop IdInfo immediately on reading,
184 -- but we do not do that now. Instead it's discarded when the
185 -- ModIface is read into the various decl pools.)
186 -- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
187 -- and so gives a new version.
191 | HsStrictness StrictSig
192 | HsInline Activation
195 | HsWorker IfaceExtName Arity -- Worker, if any see IdInfo.WorkerInfo
196 -- for why we want arity here.
197 -- NB: we need IfaceExtName (not just OccName) because the worker
198 -- can simplify to a function in another module.
199 -- NB: Specialisations and rules come in separately and are
200 -- only later attached to the Id. Partial reason: some are orphans.
202 --------------------------------
205 | IfaceExt IfaceExtName
206 | IfaceType IfaceType
207 | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
208 | IfaceLam IfaceBndr IfaceExpr
209 | IfaceApp IfaceExpr IfaceExpr
210 | IfaceCase IfaceExpr OccName IfaceType [IfaceAlt]
211 | IfaceLet IfaceBinding IfaceExpr
212 | IfaceNote IfaceNote IfaceExpr
214 | IfaceFCall ForeignCall IfaceType
216 data IfaceNote = IfaceSCC CostCentre
217 | IfaceCoerce IfaceType
219 | IfaceCoreNote String
221 type IfaceAlt = (IfaceConAlt, [OccName], IfaceExpr)
222 -- Note: OccName, not IfaceBndr (and same with the case binder)
223 -- We reconstruct the kind/type of the thing from the context
224 -- thus saving bulk in interface files
226 data IfaceConAlt = IfaceDefault
227 | IfaceDataAlt OccName
228 | IfaceTupleAlt Boxity
229 | IfaceLitAlt Literal
232 = IfaceNonRec IfaceIdBndr IfaceExpr
233 | IfaceRec [(IfaceIdBndr, IfaceExpr)]
237 %************************************************************************
239 \subsection[HsCore-print]{Printing Core unfoldings}
241 %************************************************************************
243 ----------------------------- Printing IfaceDecl ------------------------------------
246 instance Outputable IfaceDecl where
249 pprIfaceDecl (IfaceId {ifName = var, ifType = ty, ifIdInfo = info})
250 = sep [ ppr var <+> dcolon <+> ppr ty,
253 pprIfaceDecl (IfaceForeign {ifName = tycon})
254 = hsep [ptext SLIT("foreign import type dotnet"), ppr tycon]
256 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, ifSynRhs = mono_ty, ifVrcs = vrcs})
257 = hang (ptext SLIT("type") <+> pprIfaceDeclHead [] tycon tyvars)
258 4 (vcat [equals <+> ppr mono_ty,
261 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
262 ifTyVars = tyvars, ifCons = condecls,
263 ifRec = isrec, ifVrcs = vrcs})
264 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
265 4 (vcat [pprVrcs vrcs, pprRec isrec, pprGen gen, pp_condecls tycon condecls])
267 pp_nd = case condecls of
268 IfAbstractTyCon -> ptext SLIT("data")
269 IfDataTyCon _ -> ptext SLIT("data")
270 IfNewTyCon _ -> ptext SLIT("newtype")
272 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
273 ifFDs = fds, ifSigs = sigs, ifVrcs = vrcs, ifRec = isrec})
274 = hang (ptext SLIT("class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
275 4 (vcat [pprVrcs vrcs,
279 pprVrcs vrcs = ptext SLIT("Variances") <+> ppr vrcs
280 pprRec isrec = ptext SLIT("RecFlag") <+> ppr isrec
281 pprGen True = ptext SLIT("Generics: yes")
282 pprGen False = ptext SLIT("Generics: no")
284 instance Outputable IfaceClassOp where
285 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
287 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
288 pprIfaceDeclHead context thing tyvars
289 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing), pprIfaceTvBndrs tyvars]
291 pp_condecls tc IfAbstractTyCon = ptext SLIT("{- abstract -}")
292 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
293 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext SLIT(" |"))
294 (map (pprIfaceConDecl tc) cs))
296 pprIfaceConDecl tc (IfVanillaCon {
297 ifConOcc = name, ifConInfix = is_infix,
298 ifConArgTys = arg_tys,
299 ifConStricts = strs, ifConFields = fields })
300 = sep [ppr name <+> sep (map pprParendIfaceType arg_tys),
301 if is_infix then ptext SLIT("Infix") else empty,
302 if null strs then empty
303 else nest 4 (ptext SLIT("Stricts:") <+> hsep (map ppr strs)),
304 if null fields then empty
305 else nest 4 (ptext SLIT("Fields:") <+> hsep (map ppr fields))]
307 pprIfaceConDecl tc (IfGadtCon {
309 ifConTyVars = tvs, ifConCtxt = ctxt,
310 ifConArgTys = arg_tys, ifConResTys = res_tys,
311 ifConStricts = strs })
312 = sep [ppr name <+> dcolon <+> pprIfaceForAllPart tvs ctxt (ppr con_tau),
313 if null strs then empty
314 else nest 4 (ptext SLIT("Stricts:") <+> hsep (map ppr strs))]
316 con_tau = foldr1 IfaceFunTy (arg_tys ++ [tc_app])
317 tc_app = IfaceTyConApp (IfaceTc (LocalTop tc)) res_tys
318 -- Gruesome, but jsut for debug print
320 instance Outputable IfaceRule where
321 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
322 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
323 = sep [hsep [doubleQuotes (ftext name), ppr act,
324 ptext SLIT("forall") <+> pprIfaceBndrs bndrs],
325 nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
326 ptext SLIT("=") <+> ppr rhs])
329 instance Outputable IfaceInst where
330 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
331 ifInstCls = cls, ifInstTys = mb_tcs})
332 = hang (ptext SLIT("instance") <+> ppr flag
333 <+> ppr cls <+> brackets (pprWithCommas ppr_mb mb_tcs))
334 2 (equals <+> ppr dfun_id)
337 ppr_mb (Just tc) = ppr tc
341 ----------------------------- Printing IfaceExpr ------------------------------------
344 instance Outputable IfaceExpr where
345 ppr e = pprIfaceExpr noParens e
347 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
348 -- The function adds parens in context that need
349 -- an atomic value (e.g. function args)
351 pprIfaceExpr add_par (IfaceLcl v) = ppr v
352 pprIfaceExpr add_par (IfaceExt v) = ppr v
353 pprIfaceExpr add_par (IfaceLit l) = ppr l
354 pprIfaceExpr add_par (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
355 pprIfaceExpr add_par (IfaceType ty) = char '@' <+> pprParendIfaceType ty
357 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
358 pprIfaceExpr add_par (IfaceTuple c as) = tupleParens c (interpp'SP as)
360 pprIfaceExpr add_par e@(IfaceLam _ _)
361 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
362 pprIfaceExpr noParens body])
364 (bndrs,body) = collect [] e
365 collect bs (IfaceLam b e) = collect (b:bs) e
366 collect bs e = (reverse bs, e)
369 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
371 = add_par (sep [ptext SLIT("case") <+> char '@' <+> pprParendIfaceType ty <+> pprIfaceExpr noParens scrut <+> ptext SLIT("of")
372 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
373 pprIfaceExpr noParens rhs <+> char '}'])
376 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
378 = add_par (sep [ptext SLIT("case") <+> char '@' <+> pprParendIfaceType ty <+> pprIfaceExpr noParens scrut <+> ptext SLIT("of")
379 <+> ppr bndr <+> char '{',
380 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
382 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
383 = add_par (sep [ptext SLIT("let {"),
384 nest 2 (ppr_bind (b, rhs)),
386 pprIfaceExpr noParens body])
388 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
389 = add_par (sep [ptext SLIT("letrec {"),
390 nest 2 (sep (map ppr_bind pairs)),
392 pprIfaceExpr noParens body])
394 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
396 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
397 arrow <+> pprIfaceExpr noParens rhs]
399 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
400 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
402 ppr_bind ((b,ty),rhs) = sep [ppr b <+> dcolon <+> ppr ty,
403 equals <+> pprIfaceExpr noParens rhs]
406 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args)
407 pprIfaceApp fun args = sep (pprIfaceExpr parens fun : args)
410 instance Outputable IfaceNote where
411 ppr (IfaceSCC cc) = pprCostCentreCore cc
412 ppr (IfaceCoerce ty) = ptext SLIT("__coerce") <+> pprParendIfaceType ty
413 ppr IfaceInlineMe = ptext SLIT("__inline_me")
414 ppr (IfaceCoreNote s) = ptext SLIT("__core_note") <+> pprHsString (mkFastString s)
416 instance Outputable IfaceConAlt where
417 ppr IfaceDefault = text "DEFAULT"
418 ppr (IfaceLitAlt l) = ppr l
419 ppr (IfaceDataAlt d) = ppr d
420 ppr (IfaceTupleAlt b) = panic "ppr IfaceConAlt"
421 -- IfaceTupleAlt is handled by the case-alternative printer
424 instance Outputable IfaceIdInfo where
426 ppr (HasInfo is) = ptext SLIT("{-") <+> fsep (map ppr_hs_info is) <+> ptext SLIT("-}")
428 ppr_hs_info (HsUnfold unf) = ptext SLIT("Unfolding:") <+>
429 parens (pprIfaceExpr noParens unf)
430 ppr_hs_info (HsInline act) = ptext SLIT("Inline:") <+> ppr act
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 :: (Name -> IfaceExtName) -> TyThing -> IfaceDecl
447 -- Assumption: the thing is already tidied, so that locally-bound names
448 -- (lambdas, for-alls) already have non-clashing OccNames
449 -- Reason: Iface stuff uses OccNames, and the conversion here does
450 -- not do tidying on the way
451 tyThingToIfaceDecl ext (AnId id)
452 = IfaceId { ifName = getOccName id,
453 ifType = toIfaceType ext (idType id),
456 info = case toIfaceIdInfo ext (idInfo id) of
458 items -> HasInfo items
460 tyThingToIfaceDecl ext (AClass clas)
461 = IfaceClass { ifCtxt = toIfaceContext ext sc_theta,
462 ifName = getOccName clas,
463 ifTyVars = toIfaceTvBndrs clas_tyvars,
464 ifFDs = map toIfaceFD clas_fds,
465 ifSigs = map toIfaceClassOp op_stuff,
466 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
467 ifVrcs = tyConArgVrcs tycon }
469 (clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
470 tycon = classTyCon clas
472 toIfaceClassOp (sel_id, def_meth)
473 = ASSERT(sel_tyvars == clas_tyvars)
474 IfaceClassOp (getOccName sel_id) def_meth (toIfaceType ext op_ty)
476 -- Be careful when splitting the type, because of things
477 -- like class Foo a where
478 -- op :: (?x :: String) => a -> a
479 -- and class Baz a where
480 -- op :: (Ord a) => a -> a
481 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
482 op_ty = funResultTy rho_ty
484 toIfaceFD (tvs1, tvs2) = (map getOccName tvs1, map getOccName tvs2)
486 tyThingToIfaceDecl ext (ATyCon tycon)
488 = IfaceSyn { ifName = getOccName tycon,
489 ifTyVars = toIfaceTvBndrs tyvars,
490 ifVrcs = tyConArgVrcs tycon,
491 ifSynRhs = toIfaceType ext syn_ty }
494 = IfaceData { ifName = getOccName tycon,
495 ifTyVars = toIfaceTvBndrs tyvars,
496 ifCtxt = toIfaceContext ext (tyConStupidTheta tycon),
497 ifCons = ifaceConDecls (algTyConRhs tycon),
498 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
499 ifVrcs = tyConArgVrcs tycon,
500 ifGeneric = tyConHasGenerics tycon }
502 | isForeignTyCon tycon
503 = IfaceForeign { ifName = getOccName tycon,
504 ifExtName = tyConExtName tycon }
506 | isPrimTyCon tycon || isFunTyCon tycon
507 -- Needed in GHCi for ':info Int#', for example
508 = IfaceData { ifName = getOccName tycon,
509 ifTyVars = toIfaceTvBndrs (take (tyConArity tycon) alphaTyVars),
511 ifCons = IfAbstractTyCon,
513 ifRec = NonRecursive,
514 ifVrcs = tyConArgVrcs tycon }
516 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
518 tyvars = tyConTyVars tycon
519 syn_ty = synTyConRhs tycon
521 ifaceConDecls (NewTyCon { data_con = con }) = IfNewTyCon (ifaceConDecl con)
522 ifaceConDecls (DataTyCon { data_cons = cons }) = IfDataTyCon (map ifaceConDecl cons)
523 ifaceConDecls AbstractTyCon = IfAbstractTyCon
524 -- The last case happens when a TyCon has been trimmed during tidying
525 -- Furthermore, tyThingToIfaceDecl is also used
526 -- in TcRnDriver for GHCi, when browsing a module, in which case the
527 -- AbstractTyCon case is perfectly sensible.
529 ifaceConDecl data_con
530 | isVanillaDataCon data_con
531 = IfVanillaCon {ifConOcc = getOccName (dataConName data_con),
532 ifConInfix = dataConIsInfix data_con,
533 ifConArgTys = map (toIfaceType ext) arg_tys,
534 ifConStricts = strict_marks,
535 ifConFields = map getOccName field_labels }
537 = IfGadtCon { ifConOcc = getOccName (dataConName data_con),
538 ifConTyVars = toIfaceTvBndrs tyvars,
539 ifConCtxt = toIfaceContext ext theta,
540 ifConArgTys = map (toIfaceType ext) arg_tys,
541 ifConResTys = map (toIfaceType ext) res_tys,
542 ifConStricts = strict_marks }
544 (tyvars, theta, arg_tys, _, res_tys) = dataConSig data_con
545 field_labels = dataConFieldLabels data_con
546 strict_marks = dataConStrictMarks data_con
548 tyThingToIfaceDecl ext (ADataCon dc)
549 = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
552 --------------------------
553 instanceToIfaceInst :: (Name -> IfaceExtName) -> Instance -> IfaceInst
554 instanceToIfaceInst ext_lhs ispec@(Instance { is_dfun = dfun_id, is_flag = oflag,
555 is_cls = cls, is_tcs = mb_tcs,
557 = IfaceInst { ifDFun = getOccName dfun_id,
559 ifInstCls = ext_lhs cls,
560 ifInstTys = map do_rough mb_tcs,
563 do_rough Nothing = Nothing
564 do_rough (Just n) = Just (toIfaceTyCon_name ext_lhs n)
566 --------------------------
567 toIfaceIdInfo :: (Name -> IfaceExtName) -> IdInfo -> [IfaceInfoItem]
568 toIfaceIdInfo ext id_info
569 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
570 inline_hsinfo, wrkr_hsinfo, unfold_hsinfo]
572 ------------ Arity --------------
573 arity_info = arityInfo id_info
574 arity_hsinfo | arity_info == 0 = Nothing
575 | otherwise = Just (HsArity arity_info)
577 ------------ Caf Info --------------
578 caf_info = cafInfo id_info
579 caf_hsinfo = case caf_info of
580 NoCafRefs -> Just HsNoCafRefs
583 ------------ Strictness --------------
584 -- No point in explicitly exporting TopSig
585 strict_hsinfo = case newStrictnessInfo id_info of
586 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
589 ------------ Worker --------------
590 work_info = workerInfo id_info
591 has_worker = case work_info of { HasWorker _ _ -> True; other -> False }
592 wrkr_hsinfo = case work_info of
593 HasWorker work_id wrap_arity ->
594 Just (HsWorker (ext (idName work_id)) wrap_arity)
597 ------------ Unfolding --------------
598 -- The unfolding is redundant if there is a worker
599 unfold_info = unfoldingInfo id_info
600 rhs = unfoldingTemplate unfold_info
601 no_unfolding = neverUnfold unfold_info
602 -- The CoreTidy phase retains unfolding info iff
603 -- we want to expose the unfolding, taking into account
604 -- unconditional NOINLINE, etc. See TidyPgm.addExternal
605 unfold_hsinfo | no_unfolding = Nothing
606 | has_worker = Nothing -- Unfolding is implicit
607 | otherwise = Just (HsUnfold (toIfaceExpr ext rhs))
609 ------------ Inline prag --------------
610 inline_prag = inlinePragInfo id_info
611 inline_hsinfo | isAlwaysActive inline_prag = Nothing
612 | no_unfolding && not has_worker = Nothing
613 -- If the iface file give no unfolding info, we
614 -- don't need to say when inlining is OK!
615 | otherwise = Just (HsInline inline_prag)
617 --------------------------
618 coreRuleToIfaceRule :: (Name -> IfaceExtName) -- For the LHS names
619 -> (Name -> IfaceExtName) -- For the RHS names
620 -> CoreRule -> IfaceRule
621 coreRuleToIfaceRule ext_lhs ext_rhs (BuiltinRule { ru_fn = fn})
622 = pprTrace "toHsRule: builtin" (ppr fn) $
623 bogusIfaceRule (mkIfaceExtName fn)
625 coreRuleToIfaceRule ext_lhs ext_rhs
626 (Rule { ru_name = name, ru_fn = fn, ru_act = act, ru_bndrs = bndrs,
627 ru_args = args, ru_rhs = rhs, ru_orph = orph })
628 = IfaceRule { ifRuleName = name, ifActivation = act,
629 ifRuleBndrs = map (toIfaceBndr ext_lhs) bndrs,
630 ifRuleHead = ext_lhs fn,
631 ifRuleArgs = map do_arg args,
632 ifRuleRhs = toIfaceExpr ext_rhs rhs,
635 -- For type args we must remove synonyms from the outermost
636 -- level. Reason: so that when we read it back in we'll
637 -- construct the same ru_rough field as we have right now;
639 do_arg (Type ty) = IfaceType (toIfaceType ext_lhs (deNoteType ty))
640 do_arg arg = toIfaceExpr ext_lhs arg
642 bogusIfaceRule :: IfaceExtName -> IfaceRule
643 bogusIfaceRule id_name
644 = IfaceRule { ifRuleName = FSLIT("bogus"), ifActivation = NeverActive,
645 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
646 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
648 ---------------------
649 toIfaceExpr :: (Name -> IfaceExtName) -> CoreExpr -> IfaceExpr
650 toIfaceExpr ext (Var v) = toIfaceVar ext v
651 toIfaceExpr ext (Lit l) = IfaceLit l
652 toIfaceExpr ext (Type ty) = IfaceType (toIfaceType ext ty)
653 toIfaceExpr ext (Lam x b) = IfaceLam (toIfaceBndr ext x) (toIfaceExpr ext b)
654 toIfaceExpr ext (App f a) = toIfaceApp ext f [a]
655 toIfaceExpr ext (Case s x ty as) = IfaceCase (toIfaceExpr ext s) (getOccName x) (toIfaceType ext ty) (map (toIfaceAlt ext) as)
656 toIfaceExpr ext (Let b e) = IfaceLet (toIfaceBind ext b) (toIfaceExpr ext e)
657 toIfaceExpr ext (Note n e) = IfaceNote (toIfaceNote ext n) (toIfaceExpr ext e)
659 ---------------------
660 toIfaceNote ext (SCC cc) = IfaceSCC cc
661 toIfaceNote ext (Coerce t1 _) = IfaceCoerce (toIfaceType ext t1)
662 toIfaceNote ext InlineMe = IfaceInlineMe
663 toIfaceNote ext (CoreNote s) = IfaceCoreNote s
665 ---------------------
666 toIfaceBind ext (NonRec b r) = IfaceNonRec (toIfaceIdBndr ext b) (toIfaceExpr ext r)
667 toIfaceBind ext (Rec prs) = IfaceRec [(toIfaceIdBndr ext b, toIfaceExpr ext r) | (b,r) <- prs]
669 ---------------------
670 toIfaceAlt ext (c,bs,r) = (toIfaceCon c, map getOccName bs, toIfaceExpr ext r)
672 ---------------------
673 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
674 | otherwise = IfaceDataAlt (getOccName dc)
678 toIfaceCon (LitAlt l) = IfaceLitAlt l
679 toIfaceCon DEFAULT = IfaceDefault
681 ---------------------
682 toIfaceApp ext (App f a) as = toIfaceApp ext f (a:as)
683 toIfaceApp ext (Var v) as
684 = case isDataConWorkId_maybe v of
685 -- We convert the *worker* for tuples into IfaceTuples
686 Just dc | isTupleTyCon tc && saturated
687 -> IfaceTuple (tupleTyConBoxity tc) tup_args
689 val_args = dropWhile isTypeArg as
690 saturated = val_args `lengthIs` idArity v
691 tup_args = map (toIfaceExpr ext) val_args
694 other -> mkIfaceApps ext (toIfaceVar ext v) as
696 toIfaceApp ext e as = mkIfaceApps ext (toIfaceExpr ext e) as
698 mkIfaceApps ext f as = foldl (\f a -> IfaceApp f (toIfaceExpr ext a)) f as
700 ---------------------
701 toIfaceVar :: (Name -> IfaceExtName) -> Id -> IfaceExpr
703 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType ext (idType v))
704 -- Foreign calls have special syntax
705 | isExternalName name = IfaceExt (ext name)
706 | otherwise = IfaceLcl (nameOccName name)
712 %************************************************************************
714 Equality, for interface file version generaion only
716 %************************************************************************
718 Equality over IfaceSyn returns an IfaceEq, not a Bool. The new constructor is
719 EqBut, which gives the set of *locally-defined* things whose version must be equal
720 for the whole thing to be equal. So the key function is eqIfExt, which compares
723 Of course, equality is also done modulo alpha conversion.
727 = Equal -- Definitely exactly the same
728 | NotEqual -- Definitely different
729 | EqBut OccSet -- The same provided these local things have not changed
731 bool :: Bool -> IfaceEq
733 bool False = NotEqual
735 zapEq :: IfaceEq -> IfaceEq -- Used to forget EqBut information
736 zapEq (EqBut _) = Equal
739 (&&&) :: IfaceEq -> IfaceEq -> IfaceEq
741 NotEqual &&& x = NotEqual
742 EqBut occs &&& Equal = EqBut occs
743 EqBut occs &&& NotEqual = NotEqual
744 EqBut occs1 &&& EqBut occs2 = EqBut (occs1 `unionOccSets` occs2)
746 ---------------------
747 eqIfExt :: IfaceExtName -> IfaceExtName -> IfaceEq
748 -- This function is the core of the EqBut stuff
749 eqIfExt (ExtPkg mod1 occ1) (ExtPkg mod2 occ2) = bool (mod1==mod2 && occ1==occ2)
750 eqIfExt (HomePkg mod1 occ1 v1) (HomePkg mod2 occ2 v2) = bool (mod1==mod2 && occ1==occ2 && v1==v2)
751 eqIfExt (LocalTop occ1) (LocalTop occ2) | occ1 == occ2 = EqBut (unitOccSet occ1)
752 eqIfExt (LocalTopSub occ1 p1) (LocalTop occ2) | occ1 == occ2 = EqBut (unitOccSet p1)
753 eqIfExt (LocalTopSub occ1 p1) (LocalTopSub occ2 _) | occ1 == occ2 = EqBut (unitOccSet p1)
754 eqIfExt n1 n2 = NotEqual
759 ---------------------
760 eqIfDecl :: IfaceDecl -> IfaceDecl -> IfaceEq
761 eqIfDecl (IfaceId s1 t1 i1) (IfaceId s2 t2 i2)
762 = bool (s1 == s2) &&& (t1 `eqIfType` t2) &&& (i1 `eqIfIdInfo` i2)
764 eqIfDecl d1@(IfaceForeign {}) d2@(IfaceForeign {})
765 = bool (ifName d1 == ifName d2 && ifExtName d1 == ifExtName d2)
767 eqIfDecl d1@(IfaceData {}) d2@(IfaceData {})
768 = bool (ifName d1 == ifName d2 &&
769 ifRec d1 == ifRec d2 &&
770 ifVrcs d1 == ifVrcs d2 &&
771 ifGeneric d1 == ifGeneric d2) &&&
772 eqWith (ifTyVars d1) (ifTyVars d2) (\ env ->
773 eq_ifContext env (ifCtxt d1) (ifCtxt d2) &&&
774 eq_hsCD env (ifCons d1) (ifCons d2)
776 -- The type variables of the data type do not scope
777 -- over the constructors (any more), but they do scope
778 -- over the stupid context in the IfaceConDecls
780 eqIfDecl d1@(IfaceSyn {}) d2@(IfaceSyn {})
781 = bool (ifName d1 == ifName d2) &&&
782 eqWith (ifTyVars d1) (ifTyVars d2) (\ env ->
783 eq_ifType env (ifSynRhs d1) (ifSynRhs d2)
786 eqIfDecl d1@(IfaceClass {}) d2@(IfaceClass {})
787 = bool (ifName d1 == ifName d2 &&
788 ifRec d1 == ifRec d2 &&
789 ifVrcs d1 == ifVrcs d2) &&&
790 eqWith (ifTyVars d1) (ifTyVars d2) (\ env ->
791 eq_ifContext env (ifCtxt d1) (ifCtxt d2) &&&
792 eqListBy (eq_hsFD env) (ifFDs d1) (ifFDs d2) &&&
793 eqListBy (eq_cls_sig env) (ifSigs d1) (ifSigs d2)
796 eqIfDecl _ _ = NotEqual -- default case
799 eqWith :: [IfaceTvBndr] -> [IfaceTvBndr] -> (EqEnv -> IfaceEq) -> IfaceEq
800 eqWith = eq_ifTvBndrs emptyEqEnv
802 -----------------------
803 eqIfInst d1 d2 = bool (ifDFun d1 == ifDFun d2)
804 -- All other changes are handled via the version info on the dfun
806 eqIfRule (IfaceRule n1 a1 bs1 f1 es1 rhs1 o1)
807 (IfaceRule n2 a2 bs2 f2 es2 rhs2 o2)
808 = bool (n1==n2 && a1==a2 && o1 == o2) &&&
810 eq_ifBndrs emptyEqEnv bs1 bs2 (\env ->
811 zapEq (eqListBy (eq_ifaceExpr env) es1 es2) &&&
812 -- zapEq: for the LHSs, ignore the EqBut part
813 eq_ifaceExpr env rhs1 rhs2)
815 eq_hsCD env (IfDataTyCon c1) (IfDataTyCon c2)
816 = eqListBy (eq_ConDecl env) c1 c2
818 eq_hsCD env (IfNewTyCon c1) (IfNewTyCon c2) = eq_ConDecl env c1 c2
819 eq_hsCD env IfAbstractTyCon IfAbstractTyCon = Equal
820 eq_hsCD env d1 d2 = NotEqual
822 eq_ConDecl env c1@(IfVanillaCon {}) c2@(IfVanillaCon {})
823 = bool (ifConOcc c1 == ifConOcc c2 &&
824 ifConInfix c1 == ifConInfix c2 &&
825 ifConStricts c1 == ifConStricts c2 &&
826 ifConFields c1 == ifConFields c2) &&&
827 eq_ifTypes env (ifConArgTys c1) (ifConArgTys c2)
829 eq_ConDecl env c1@(IfGadtCon {}) c2@(IfGadtCon {})
830 = bool (ifConOcc c1 == ifConOcc c2 &&
831 ifConStricts c1 == ifConStricts c2) &&&
832 eq_ifTvBndrs env (ifConTyVars c1) (ifConTyVars c2) (\ env ->
833 eq_ifContext env (ifConCtxt c1) (ifConCtxt c2) &&&
834 eq_ifTypes env (ifConResTys c1) (ifConResTys c2) &&&
835 eq_ifTypes env (ifConArgTys c1) (ifConArgTys c2))
837 eq_ConDecl env c1 c2 = NotEqual
839 eq_hsFD env (ns1,ms1) (ns2,ms2)
840 = eqListBy (eqIfOcc env) ns1 ns2 &&& eqListBy (eqIfOcc env) ms1 ms2
842 eq_cls_sig env (IfaceClassOp n1 dm1 ty1) (IfaceClassOp n2 dm2 ty2)
843 = bool (n1==n2 && dm1 == dm2) &&& eq_ifType env ty1 ty2
849 eqIfIdInfo NoInfo NoInfo = Equal
850 eqIfIdInfo (HasInfo is1) (HasInfo is2) = eqListBy eq_item is1 is2
851 eqIfIdInfo i1 i2 = NotEqual
853 eq_item (HsInline a1) (HsInline a2) = bool (a1 == a2)
854 eq_item (HsArity a1) (HsArity a2) = bool (a1 == a2)
855 eq_item (HsStrictness s1) (HsStrictness s2) = bool (s1 == s2)
856 eq_item (HsUnfold u1) (HsUnfold u2) = eq_ifaceExpr emptyEqEnv u1 u2
857 eq_item HsNoCafRefs HsNoCafRefs = Equal
858 eq_item (HsWorker wkr1 a1) (HsWorker wkr2 a2) = bool (a1==a2) &&& (wkr1 `eqIfExt` wkr2)
859 eq_item _ _ = NotEqual
862 eq_ifaceExpr :: EqEnv -> IfaceExpr -> IfaceExpr -> IfaceEq
863 eq_ifaceExpr env (IfaceLcl v1) (IfaceLcl v2) = eqIfOcc env v1 v2
864 eq_ifaceExpr env (IfaceExt v1) (IfaceExt v2) = eqIfExt v1 v2
865 eq_ifaceExpr env (IfaceLit l1) (IfaceLit l2) = bool (l1 == l2)
866 eq_ifaceExpr env (IfaceFCall c1 ty1) (IfaceFCall c2 ty2) = bool (c1==c2) &&& eq_ifType env ty1 ty2
867 eq_ifaceExpr env (IfaceType ty1) (IfaceType ty2) = eq_ifType env ty1 ty2
868 eq_ifaceExpr env (IfaceTuple n1 as1) (IfaceTuple n2 as2) = bool (n1==n2) &&& eqListBy (eq_ifaceExpr env) as1 as2
869 eq_ifaceExpr env (IfaceLam b1 body1) (IfaceLam b2 body2) = eq_ifBndr env b1 b2 (\env -> eq_ifaceExpr env body1 body2)
870 eq_ifaceExpr env (IfaceApp f1 a1) (IfaceApp f2 a2) = eq_ifaceExpr env f1 f2 &&& eq_ifaceExpr env a1 a2
871 eq_ifaceExpr env (IfaceNote n1 r1) (IfaceNote n2 r2) = eq_ifaceNote env n1 n2 &&& eq_ifaceExpr env r1 r2
873 eq_ifaceExpr env (IfaceCase s1 b1 ty1 as1) (IfaceCase s2 b2 ty2 as2)
874 = eq_ifaceExpr env s1 s2 &&&
875 eq_ifType env ty1 ty2 &&&
876 eq_ifNakedBndr env b1 b2 (\env -> eqListBy (eq_ifaceAlt env) as1 as2)
878 eq_ifaceAlt env (c1,bs1,r1) (c2,bs2,r2)
879 = bool (eq_ifaceConAlt c1 c2) &&&
880 eq_ifNakedBndrs env bs1 bs2 (\env -> eq_ifaceExpr env r1 r2)
882 eq_ifaceExpr env (IfaceLet (IfaceNonRec b1 r1) x1) (IfaceLet (IfaceNonRec b2 r2) x2)
883 = eq_ifaceExpr env r1 r2 &&& eq_ifIdBndr env b1 b2 (\env -> eq_ifaceExpr env x1 x2)
885 eq_ifaceExpr env (IfaceLet (IfaceRec as1) x1) (IfaceLet (IfaceRec as2) x2)
886 = eq_ifIdBndrs env bs1 bs2 (\env -> eqListBy (eq_ifaceExpr env) rs1 rs2 &&& eq_ifaceExpr env x1 x2)
888 (bs1,rs1) = unzip as1
889 (bs2,rs2) = unzip as2
892 eq_ifaceExpr env _ _ = NotEqual
895 eq_ifaceConAlt :: IfaceConAlt -> IfaceConAlt -> Bool
896 eq_ifaceConAlt IfaceDefault IfaceDefault = True
897 eq_ifaceConAlt (IfaceDataAlt n1) (IfaceDataAlt n2) = n1==n2
898 eq_ifaceConAlt (IfaceTupleAlt c1) (IfaceTupleAlt c2) = c1==c2
899 eq_ifaceConAlt (IfaceLitAlt l1) (IfaceLitAlt l2) = l1==l2
900 eq_ifaceConAlt _ _ = False
903 eq_ifaceNote :: EqEnv -> IfaceNote -> IfaceNote -> IfaceEq
904 eq_ifaceNote env (IfaceSCC c1) (IfaceSCC c2) = bool (c1==c2)
905 eq_ifaceNote env (IfaceCoerce t1) (IfaceCoerce t2) = eq_ifType env t1 t2
906 eq_ifaceNote env IfaceInlineMe IfaceInlineMe = Equal
907 eq_ifaceNote env (IfaceCoreNote s1) (IfaceCoreNote s2) = bool (s1==s2)
908 eq_ifaceNote env _ _ = NotEqual
912 ---------------------
913 eqIfType t1 t2 = eq_ifType emptyEqEnv t1 t2
916 eq_ifType env (IfaceTyVar n1) (IfaceTyVar n2) = eqIfOcc env n1 n2
917 eq_ifType env (IfaceAppTy s1 t1) (IfaceAppTy s2 t2) = eq_ifType env s1 s2 &&& eq_ifType env t1 t2
918 eq_ifType env (IfacePredTy st1) (IfacePredTy st2) = eq_ifPredType env st1 st2
919 eq_ifType env (IfaceTyConApp tc1 ts1) (IfaceTyConApp tc2 ts2) = tc1 `eqIfTc` tc2 &&& eq_ifTypes env ts1 ts2
920 eq_ifType env (IfaceForAllTy tv1 t1) (IfaceForAllTy tv2 t2) = eq_ifTvBndr env tv1 tv2 (\env -> eq_ifType env t1 t2)
921 eq_ifType env (IfaceFunTy s1 t1) (IfaceFunTy s2 t2) = eq_ifType env s1 s2 &&& eq_ifType env t1 t2
922 eq_ifType env _ _ = NotEqual
925 eq_ifTypes env = eqListBy (eq_ifType env)
928 eq_ifContext env a b = eqListBy (eq_ifPredType env) a b
931 eq_ifPredType env (IfaceClassP c1 tys1) (IfaceClassP c2 tys2) = c1 `eqIfExt` c2 &&& eq_ifTypes env tys1 tys2
932 eq_ifPredType env (IfaceIParam n1 ty1) (IfaceIParam n2 ty2) = bool (n1 == n2) &&& eq_ifType env ty1 ty2
933 eq_ifPredType env _ _ = NotEqual
936 eqIfTc (IfaceTc tc1) (IfaceTc tc2) = tc1 `eqIfExt` tc2
937 eqIfTc IfaceIntTc IfaceIntTc = Equal
938 eqIfTc IfaceCharTc IfaceCharTc = Equal
939 eqIfTc IfaceBoolTc IfaceBoolTc = Equal
940 eqIfTc IfaceListTc IfaceListTc = Equal
941 eqIfTc IfacePArrTc IfacePArrTc = Equal
942 eqIfTc (IfaceTupTc bx1 ar1) (IfaceTupTc bx2 ar2) = bool (bx1==bx2 && ar1==ar2)
943 eqIfTc _ _ = NotEqual
946 -----------------------------------------------------------
947 Support code for equality checking
948 -----------------------------------------------------------
951 ------------------------------------
952 type EqEnv = OccEnv OccName -- Tracks the mapping from L-variables to R-variables
954 eqIfOcc :: EqEnv -> OccName -> OccName -> IfaceEq
955 eqIfOcc env n1 n2 = case lookupOccEnv env n1 of
956 Just n1 -> bool (n1 == n2)
957 Nothing -> bool (n1 == n2)
959 extendEqEnv :: EqEnv -> OccName -> OccName -> EqEnv
960 extendEqEnv env n1 n2 | n1 == n2 = env
961 | otherwise = extendOccEnv env n1 n2
964 emptyEqEnv = emptyOccEnv
966 ------------------------------------
967 type ExtEnv bndr = EqEnv -> bndr -> bndr -> (EqEnv -> IfaceEq) -> IfaceEq
969 eq_ifNakedBndr :: ExtEnv OccName
970 eq_ifBndr :: ExtEnv IfaceBndr
971 eq_ifTvBndr :: ExtEnv IfaceTvBndr
972 eq_ifIdBndr :: ExtEnv IfaceIdBndr
974 eq_ifNakedBndr env n1 n2 k = k (extendEqEnv env n1 n2)
976 eq_ifBndr env (IfaceIdBndr b1) (IfaceIdBndr b2) k = eq_ifIdBndr env b1 b2 k
977 eq_ifBndr env (IfaceTvBndr b1) (IfaceTvBndr b2) k = eq_ifTvBndr env b1 b2 k
978 eq_ifBndr _ _ _ _ = NotEqual
980 eq_ifTvBndr env (v1, k1) (v2, k2) k = bool (k1 == k2) &&& k (extendEqEnv env v1 v2)
981 eq_ifIdBndr env (v1, t1) (v2, t2) k = eq_ifType env t1 t2 &&& k (extendEqEnv env v1 v2)
983 eq_ifBndrs :: ExtEnv [IfaceBndr]
984 eq_ifIdBndrs :: ExtEnv [IfaceIdBndr]
985 eq_ifTvBndrs :: ExtEnv [IfaceTvBndr]
986 eq_ifNakedBndrs :: ExtEnv [OccName]
987 eq_ifBndrs = eq_bndrs_with eq_ifBndr
988 eq_ifIdBndrs = eq_bndrs_with eq_ifIdBndr
989 eq_ifTvBndrs = eq_bndrs_with eq_ifTvBndr
990 eq_ifNakedBndrs = eq_bndrs_with eq_ifNakedBndr
992 eq_bndrs_with eq env [] [] k = k env
993 eq_bndrs_with eq env (b1:bs1) (b2:bs2) k = eq env b1 b2 (\env -> eq_bndrs_with eq env bs1 bs2 k)
994 eq_bndrs_with eq env _ _ _ = NotEqual
998 eqListBy :: (a->a->IfaceEq) -> [a] -> [a] -> IfaceEq
999 eqListBy eq [] [] = Equal
1000 eqListBy eq (x:xs) (y:ys) = eq x y &&& eqListBy eq xs ys
1001 eqListBy eq xs ys = NotEqual
1003 eqMaybeBy :: (a->a->IfaceEq) -> Maybe a -> Maybe a -> IfaceEq
1004 eqMaybeBy eq Nothing Nothing = Equal
1005 eqMaybeBy eq (Just x) (Just y) = eq x y
1006 eqMaybeBy eq x y = NotEqual