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, emptyOccEnv,
61 lookupOccEnv, extendOccEnv, parenSymOcc,
62 OccSet, unionOccSets, unitOccSet )
63 import Name ( Name, NamedThing(..), nameOccName, isExternalName )
64 import NameSet ( NameSet, elemNameSet )
65 import CostCentre ( CostCentre, pprCostCentreCore )
66 import Literal ( Literal )
67 import ForeignCall ( ForeignCall )
68 import TysPrim ( alphaTyVars )
69 import BasicTypes ( Arity, Activation(..), StrictnessMark,
70 RecFlag(..), boolToRecFlag, Boxity(..),
74 import Maybes ( catMaybes )
75 import Util ( lengthIs )
78 infix 4 `eqIfExt`, `eqIfIdInfo`, `eqIfType`
82 %************************************************************************
84 Data type declarations
86 %************************************************************************
90 = IfaceId { ifName :: OccName,
92 ifIdInfo :: IfaceIdInfo }
94 | IfaceData { ifName :: OccName, -- Type constructor
95 ifTyVars :: [IfaceTvBndr], -- Type variables
96 ifCons :: IfaceConDecls, -- Includes new/data info
97 ifRec :: RecFlag, -- Recursive or not?
99 ifGeneric :: Bool -- True <=> generic converter functions available
100 } -- We need this for imported data decls, since the
101 -- imported modules may have been compiled with
102 -- different flags to the current compilation unit
104 | IfaceSyn { ifName :: OccName, -- Type constructor
105 ifTyVars :: [IfaceTvBndr], -- Type variables
107 ifSynRhs :: IfaceType -- synonym expansion
110 | IfaceClass { ifCtxt :: IfaceContext, -- Context...
111 ifName :: OccName, -- Name of the class
112 ifTyVars :: [IfaceTvBndr], -- Type variables
113 ifFDs :: [FunDep OccName], -- Functional dependencies
114 ifSigs :: [IfaceClassOp], -- Method signatures
115 ifRec :: RecFlag, -- Is newtype/datatype associated with the class recursive?
116 ifVrcs :: ArgVrcs -- ... and what are its argument variances ...
119 | IfaceForeign { ifName :: OccName, -- Needs expanding when we move beyond .NET
120 ifExtName :: Maybe FastString }
122 data IfaceClassOp = IfaceClassOp OccName DefMeth IfaceType
123 -- Nothing => no default method
124 -- Just False => ordinary polymorphic default method
125 -- Just True => generic default method
128 = IfAbstractTyCon -- No info
129 | IfDataTyCon -- data type decls
130 (Maybe IfaceContext) -- See TyCon.AlgTyConRhs; H98 or GADT
132 | IfNewTyCon IfaceConDecl -- newtype decls
134 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
135 visibleIfConDecls IfAbstractTyCon = []
136 visibleIfConDecls (IfDataTyCon _ cs) = cs
137 visibleIfConDecls (IfNewTyCon c) = [c]
141 ifConOcc :: OccName, -- Constructor name
142 ifConInfix :: Bool, -- True <=> declared infix
143 ifConArgTys :: [IfaceType], -- Arg types
144 ifConStricts :: [StrictnessMark], -- Empty (meaning all lazy), or 1-1 corresp with arg types
145 ifConFields :: [OccName] } -- ...ditto... (field labels)
147 ifConOcc :: OccName, -- Constructor name
148 ifConTyVars :: [IfaceTvBndr], -- All tyvars
149 ifConCtxt :: IfaceContext, -- Non-stupid context
150 ifConArgTys :: [IfaceType], -- Arg types
151 ifConResTys :: [IfaceType], -- Result type args
152 ifConStricts :: [StrictnessMark] } -- Empty (meaning all lazy), or 1-1 corresp with arg types
154 data IfaceInst = IfaceInst { ifInstHead :: IfaceType, -- Just the instance head type, quantified
155 -- so that it'll compare alpha-wise
156 ifDFun :: OccName } -- And the dfun
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
173 | IfaceBuiltinRule IfaceExtName CoreRule -- So that built-in rules can
174 -- wait in the RulePol
177 = NoInfo -- When writing interface file without -O
178 | HasInfo [IfaceInfoItem] -- Has info, and here it is
180 -- Here's a tricky case:
181 -- * Compile with -O module A, and B which imports A.f
182 -- * Change function f in A, and recompile without -O
183 -- * When we read in old A.hi we read in its IdInfo (as a thunk)
184 -- (In earlier GHCs we used to drop IdInfo immediately on reading,
185 -- but we do not do that now. Instead it's discarded when the
186 -- ModIface is read into the various decl pools.)
187 -- * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
188 -- and so gives a new version.
192 | HsStrictness StrictSig
193 | HsUnfold Activation IfaceExpr
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
211 | IfaceCase IfaceExpr OccName IfaceType [IfaceAlt]
212 | IfaceLet IfaceBinding IfaceExpr
213 | IfaceNote IfaceNote IfaceExpr
215 | IfaceFCall ForeignCall IfaceType
217 data IfaceNote = IfaceSCC CostCentre
218 | IfaceCoerce IfaceType
221 | IfaceCoreNote String
223 type IfaceAlt = (IfaceConAlt, [OccName], IfaceExpr)
224 -- Note: OccName, not IfaceBndr (and same with the case binder)
225 -- We reconstruct the kind/type of the thing from the context
226 -- thus saving bulk in interface files
228 data IfaceConAlt = IfaceDefault
229 | IfaceDataAlt OccName
230 | IfaceTupleAlt Boxity
231 | IfaceLitAlt Literal
234 = IfaceNonRec IfaceIdBndr IfaceExpr
235 | IfaceRec [(IfaceIdBndr, IfaceExpr)]
239 %************************************************************************
241 \subsection[HsCore-print]{Printing Core unfoldings}
243 %************************************************************************
245 ----------------------------- Printing IfaceDecl ------------------------------------
248 instance Outputable IfaceDecl where
251 pprIfaceDecl (IfaceId {ifName = var, ifType = ty, ifIdInfo = info})
252 = sep [ ppr var <+> dcolon <+> ppr ty,
255 pprIfaceDecl (IfaceForeign {ifName = tycon})
256 = hsep [ptext SLIT("foreign import type dotnet"), ppr tycon]
258 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, ifSynRhs = mono_ty, ifVrcs = vrcs})
259 = hang (ptext SLIT("type") <+> pprIfaceDeclHead [] tycon tyvars)
260 4 (vcat [equals <+> ppr mono_ty,
263 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen,
264 ifTyVars = tyvars, ifCons = condecls,
265 ifRec = isrec, ifVrcs = vrcs})
266 = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
267 4 (vcat [pprVrcs vrcs, pprRec isrec, pprGen gen, pp_condecls tycon condecls])
271 IfAbstractTyCon -> ([], ptext SLIT("data"))
272 IfDataTyCon Nothing _ -> ([], ptext SLIT("data"))
273 IfDataTyCon (Just c) _ -> (c, ptext SLIT("data"))
274 IfNewTyCon _ -> ([], ptext SLIT("newtype"))
276 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
277 ifFDs = fds, ifSigs = sigs, ifVrcs = vrcs, ifRec = isrec})
278 = hang (ptext SLIT("class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
279 4 (vcat [pprVrcs vrcs,
283 pprVrcs vrcs = ptext SLIT("Variances") <+> ppr vrcs
284 pprRec isrec = ptext SLIT("RecFlag") <+> ppr isrec
285 pprGen True = ptext SLIT("Generics: yes")
286 pprGen False = ptext SLIT("Generics: no")
288 instance Outputable IfaceClassOp where
289 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
291 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
292 pprIfaceDeclHead context thing tyvars
293 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing), pprIfaceTvBndrs tyvars]
295 pp_condecls tc IfAbstractTyCon = ptext SLIT("{- abstract -}")
296 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
297 pp_condecls tc (IfDataTyCon _ cs) = equals <+> sep (punctuate (ptext SLIT(" |"))
298 (map (pprIfaceConDecl tc) cs))
300 pprIfaceConDecl tc (IfVanillaCon {
301 ifConOcc = name, ifConInfix = is_infix,
302 ifConArgTys = arg_tys,
303 ifConStricts = strs, ifConFields = fields })
304 = sep [ppr name <+> sep (map pprParendIfaceType arg_tys),
305 if is_infix then ptext SLIT("Infix") else empty,
306 if null strs then empty
307 else nest 4 (ptext SLIT("Stricts:") <+> hsep (map ppr strs)),
308 if null fields then empty
309 else nest 4 (ptext SLIT("Fields:") <+> hsep (map ppr fields))]
311 pprIfaceConDecl tc (IfGadtCon {
313 ifConTyVars = tvs, ifConCtxt = ctxt,
314 ifConArgTys = arg_tys, ifConResTys = res_tys,
315 ifConStricts = strs })
316 = sep [ppr name <+> dcolon <+> pprIfaceForAllPart tvs ctxt (ppr con_tau),
317 if null strs then empty
318 else nest 4 (ptext SLIT("Stricts:") <+> hsep (map ppr strs))]
320 con_tau = foldr1 IfaceFunTy (arg_tys ++ [tc_app])
321 tc_app = IfaceTyConApp (IfaceTc (LocalTop tc)) res_tys
322 -- Gruesome, but jsut for debug print
324 instance Outputable IfaceRule where
325 ppr (IfaceRule name act bndrs fn args rhs)
326 = sep [hsep [doubleQuotes (ftext name), ppr act,
327 ptext SLIT("forall") <+> pprIfaceBndrs bndrs],
328 nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
329 ptext SLIT("=") <+> ppr rhs])
331 ppr (IfaceBuiltinRule name rule)
332 = ptext SLIT("Built-in rule for") <+> ppr name
334 instance Outputable IfaceInst where
335 ppr (IfaceInst {ifDFun = dfun_id, ifInstHead = ty})
336 = hang (ptext SLIT("instance") <+> ppr ty)
337 2 (equals <+> ppr dfun_id)
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 IfaceInlineCall = ptext SLIT("__inline_call")
414 ppr IfaceInlineMe = ptext SLIT("__inline_me")
415 ppr (IfaceCoreNote s) = ptext SLIT("__core_note") <+> pprHsString (mkFastString s)
417 instance Outputable IfaceConAlt where
418 ppr IfaceDefault = text "DEFAULT"
419 ppr (IfaceLitAlt l) = ppr l
420 ppr (IfaceDataAlt d) = ppr d
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 prag unf) = sep [ptext SLIT("Unfolding: ") <> ppr prag,
429 parens (pprIfaceExpr noParens unf)]
430 ppr_hs_info (HsArity arity) = ptext SLIT("Arity:") <+> int arity
431 ppr_hs_info (HsStrictness str) = ptext SLIT("Strictness:") <+> pprIfaceStrictSig str
432 ppr_hs_info HsNoCafRefs = ptext SLIT("HasNoCafRefs")
433 ppr_hs_info (HsWorker w a) = ptext SLIT("Worker:") <+> ppr w <+> int a
437 %************************************************************************
439 Converting things to their Iface equivalents
441 %************************************************************************
445 tyThingToIfaceDecl :: Bool
446 -> NameSet -- Tycons and classes to export abstractly
447 -> (Name -> IfaceExtName) -> TyThing -> IfaceDecl
448 -- Assumption: the thing is already tidied, so that locally-bound names
449 -- (lambdas, for-alls) already have non-clashing OccNames
450 -- Reason: Iface stuff uses OccNames, and the conversion here does
451 -- not do tidying on the way
452 tyThingToIfaceDecl discard_id_info _ ext (AnId id)
453 = IfaceId { ifName = getOccName id,
454 ifType = toIfaceType ext (idType id),
457 info | discard_id_info = NoInfo
458 | otherwise = HasInfo (toIfaceIdInfo ext (idInfo id))
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 _ abstract_tcs 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 ifCons = ifaceConDecls (algTyConRhs tycon),
497 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
498 ifVrcs = tyConArgVrcs tycon,
499 ifGeneric = tyConHasGenerics tycon }
501 | isForeignTyCon tycon
502 = IfaceForeign { ifName = getOccName tycon,
503 ifExtName = tyConExtName tycon }
505 | isPrimTyCon tycon || isFunTyCon tycon
506 -- Needed in GHCi for ':info Int#', for example
507 = IfaceData { ifName = getOccName tycon,
508 ifTyVars = toIfaceTvBndrs (take (tyConArity tycon) alphaTyVars),
509 ifCons = IfAbstractTyCon,
511 ifRec = NonRecursive,
512 ifVrcs = tyConArgVrcs tycon }
514 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
516 tyvars = tyConTyVars tycon
517 (_, syn_ty) = getSynTyConDefn tycon
518 abstract = getName tycon `elemNameSet` abstract_tcs
520 ifaceConDecls _ | abstract = IfAbstractTyCon
521 ifaceConDecls (NewTyCon con _ _) = IfNewTyCon (ifaceConDecl con)
522 ifaceConDecls (DataTyCon mb_theta cons _) = IfDataTyCon (ifaceDataCtxt mb_theta)
523 (map ifaceConDecl cons)
524 ifaceConDecls AbstractTyCon = IfAbstractTyCon
525 -- The last case should never happen when we are generating an
526 -- interface file (we're exporting this thing, so it's locally defined
527 -- and should not be abstract). But tyThingToIfaceDecl is also used
528 -- in TcRnDriver for GHCi, when browsing a module, in which case the
529 -- AbstractTyCon case is perfectly sensible.
531 ifaceDataCtxt Nothing = Nothing
532 ifaceDataCtxt (Just theta) = Just (toIfaceContext ext theta)
534 ifaceConDecl data_con
535 | isVanillaDataCon data_con
536 = IfVanillaCon {ifConOcc = getOccName (dataConName data_con),
537 ifConInfix = dataConIsInfix data_con,
538 ifConArgTys = map (toIfaceType ext) arg_tys,
539 ifConStricts = strict_marks,
540 ifConFields = map getOccName field_labels }
542 = IfGadtCon { ifConOcc = getOccName (dataConName data_con),
543 ifConTyVars = toIfaceTvBndrs tyvars,
544 ifConCtxt = toIfaceContext ext theta,
545 ifConArgTys = map (toIfaceType ext) arg_tys,
546 ifConResTys = map (toIfaceType ext) res_tys,
547 ifConStricts = strict_marks }
549 (tyvars, theta, arg_tys, _, res_tys) = dataConSig data_con
550 field_labels = dataConFieldLabels data_con
551 strict_marks = dataConStrictMarks data_con
553 tyThingToIfaceDecl dis abstr ext (ADataCon dc)
554 = pprPanic "toIfaceDecl" (ppr dc)
557 --------------------------
558 dfunToIfaceInst :: (Name -> IfaceExtName) -> DFunId -> IfaceInst
559 dfunToIfaceInst ext_lhs dfun_id
560 = IfaceInst { ifDFun = nameOccName dfun_name,
561 ifInstHead = toIfaceType ext_lhs tidy_ty }
563 dfun_name = idName dfun_id
564 (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun_id)
565 head_ty = mkForAllTys tvs (mkPredTy (mkClassPred cls tys))
566 -- No need to record the instance context;
567 -- it's in the dfun anyway
569 tidy_ty = tidyTopType (deNoteType head_ty)
570 -- The deNoteType is very important. It removes all type
571 -- synonyms from the instance type in interface files.
572 -- That in turn makes sure that when reading in instance decls
573 -- from interface files that the 'gating' mechanism works properly.
574 -- Otherwise you could have
575 -- type Tibble = T Int
576 -- instance Foo Tibble where ...
577 -- and this instance decl wouldn't get imported into a module
578 -- that mentioned T but not Tibble.
581 --------------------------
582 toIfaceIdInfo :: (Name -> IfaceExtName) -> IdInfo -> [IfaceInfoItem]
583 toIfaceIdInfo ext id_info
584 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
585 wrkr_hsinfo, unfold_hsinfo]
587 ------------ Arity --------------
588 arity_info = arityInfo id_info
589 arity_hsinfo | arity_info == 0 = Nothing
590 | otherwise = Just (HsArity arity_info)
592 ------------ Caf Info --------------
593 caf_info = cafInfo id_info
594 caf_hsinfo = case caf_info of
595 NoCafRefs -> Just HsNoCafRefs
598 ------------ Strictness --------------
599 -- No point in explicitly exporting TopSig
600 strict_hsinfo = case newStrictnessInfo id_info of
601 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
604 ------------ Worker --------------
605 work_info = workerInfo id_info
606 has_worker = case work_info of { HasWorker _ _ -> True; other -> False }
607 wrkr_hsinfo = case work_info of
608 HasWorker work_id wrap_arity ->
609 Just (HsWorker (ext (idName work_id)) wrap_arity)
612 ------------ Unfolding --------------
613 -- The unfolding is redundant if there is a worker
614 unfold_info = unfoldingInfo id_info
615 inline_prag = inlinePragInfo id_info
616 rhs = unfoldingTemplate unfold_info
617 unfold_hsinfo | neverUnfold unfold_info
618 || has_worker = Nothing
619 | otherwise = Just (HsUnfold inline_prag (toIfaceExpr ext rhs))
621 --------------------------
622 coreRuleToIfaceRule :: (Name -> IfaceExtName) -- For the LHS names
623 -> (Name -> IfaceExtName) -- For the RHS names
624 -> IdCoreRule -> IfaceRule
625 coreRuleToIfaceRule ext_lhs ext_rhs (IdCoreRule id _ (BuiltinRule _ _))
626 = pprTrace "toHsRule: builtin" (ppr id) (bogusIfaceRule (mkIfaceExtName (getName id)))
628 coreRuleToIfaceRule ext_lhs ext_rhs (IdCoreRule id _ (Rule name act bndrs args rhs))
629 = IfaceRule { ifRuleName = name, ifActivation = act,
630 ifRuleBndrs = map (toIfaceBndr ext_lhs) bndrs,
631 ifRuleHead = ext_lhs (idName id),
632 ifRuleArgs = map (toIfaceExpr ext_lhs) args,
633 ifRuleRhs = toIfaceExpr ext_rhs rhs }
635 bogusIfaceRule :: IfaceExtName -> IfaceRule
636 bogusIfaceRule id_name
637 = IfaceRule FSLIT("bogus") NeverActive [] id_name [] (IfaceExt id_name)
639 ---------------------
640 toIfaceExpr :: (Name -> IfaceExtName) -> CoreExpr -> IfaceExpr
641 toIfaceExpr ext (Var v) = toIfaceVar ext v
642 toIfaceExpr ext (Lit l) = IfaceLit l
643 toIfaceExpr ext (Type ty) = IfaceType (toIfaceType ext ty)
644 toIfaceExpr ext (Lam x b) = IfaceLam (toIfaceBndr ext x) (toIfaceExpr ext b)
645 toIfaceExpr ext (App f a) = toIfaceApp ext f [a]
647 toIfaceExpr ext (Case s x ty as) = IfaceCase (toIfaceExpr ext s) (getOccName x) (toIfaceType ext ty) (map (toIfaceAlt ext) as)
648 toIfaceExpr ext (Let b e) = IfaceLet (toIfaceBind ext b) (toIfaceExpr ext e)
649 toIfaceExpr ext (Note n e) = IfaceNote (toIfaceNote ext n) (toIfaceExpr ext e)
651 ---------------------
652 toIfaceNote ext (SCC cc) = IfaceSCC cc
653 toIfaceNote ext (Coerce t1 _) = IfaceCoerce (toIfaceType ext t1)
654 toIfaceNote ext InlineCall = IfaceInlineCall
655 toIfaceNote ext InlineMe = IfaceInlineMe
656 toIfaceNote ext (CoreNote s) = IfaceCoreNote s
658 ---------------------
659 toIfaceBind ext (NonRec b r) = IfaceNonRec (toIfaceIdBndr ext b) (toIfaceExpr ext r)
660 toIfaceBind ext (Rec prs) = IfaceRec [(toIfaceIdBndr ext b, toIfaceExpr ext r) | (b,r) <- prs]
662 ---------------------
663 toIfaceAlt ext (c,bs,r) = (toIfaceCon c, map getOccName bs, toIfaceExpr ext r)
665 ---------------------
666 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
667 | otherwise = IfaceDataAlt (getOccName dc)
671 toIfaceCon (LitAlt l) = IfaceLitAlt l
672 toIfaceCon DEFAULT = IfaceDefault
674 ---------------------
675 toIfaceApp ext (App f a) as = toIfaceApp ext f (a:as)
676 toIfaceApp ext (Var v) as
677 = case isDataConWorkId_maybe v of
678 -- We convert the *worker* for tuples into IfaceTuples
679 Just dc | isTupleTyCon tc && saturated
680 -> IfaceTuple (tupleTyConBoxity tc) tup_args
682 val_args = dropWhile isTypeArg as
683 saturated = val_args `lengthIs` idArity v
684 tup_args = map (toIfaceExpr ext) val_args
687 other -> mkIfaceApps ext (toIfaceVar ext v) as
689 toIfaceApp ext e as = mkIfaceApps ext (toIfaceExpr ext e) as
691 mkIfaceApps ext f as = foldl (\f a -> IfaceApp f (toIfaceExpr ext a)) f as
693 ---------------------
694 toIfaceVar :: (Name -> IfaceExtName) -> Id -> IfaceExpr
696 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType ext (idType v))
697 -- Foreign calls have special syntax
698 | isExternalName name = IfaceExt (ext name)
699 | otherwise = IfaceLcl (nameOccName name)
705 %************************************************************************
707 Equality, for interface file version generaion only
709 %************************************************************************
711 Equality over IfaceSyn returns an IfaceEq, not a Bool. The new constructor is
712 EqBut, which gives the set of *locally-defined* things whose version must be equal
713 for the whole thing to be equal. So the key function is eqIfExt, which compares
716 Of course, equality is also done modulo alpha conversion.
720 = Equal -- Definitely exactly the same
721 | NotEqual -- Definitely different
722 | EqBut OccSet -- The same provided these local things have not changed
724 bool :: Bool -> IfaceEq
726 bool False = NotEqual
728 zapEq :: IfaceEq -> IfaceEq -- Used to forget EqBut information
729 zapEq (EqBut _) = Equal
732 (&&&) :: IfaceEq -> IfaceEq -> IfaceEq
734 NotEqual &&& x = NotEqual
735 EqBut occs &&& Equal = EqBut occs
736 EqBut occs &&& NotEqual = NotEqual
737 EqBut occs1 &&& EqBut occs2 = EqBut (occs1 `unionOccSets` occs2)
739 ---------------------
740 eqIfExt :: IfaceExtName -> IfaceExtName -> IfaceEq
741 -- This function is the core of the EqBut stuff
742 eqIfExt (ExtPkg mod1 occ1) (ExtPkg mod2 occ2) = bool (mod1==mod2 && occ1==occ2)
743 eqIfExt (HomePkg mod1 occ1 v1) (HomePkg mod2 occ2 v2) = bool (mod1==mod2 && occ1==occ2 && v1==v2)
744 eqIfExt (LocalTop occ1) (LocalTop occ2) | occ1 == occ2 = EqBut (unitOccSet occ1)
745 eqIfExt (LocalTopSub occ1 p1) (LocalTop occ2) | occ1 == occ2 = EqBut (unitOccSet p1)
746 eqIfExt (LocalTopSub occ1 p1) (LocalTopSub occ2 _) | occ1 == occ2 = EqBut (unitOccSet p1)
747 eqIfExt n1 n2 = NotEqual
752 ---------------------
753 eqIfDecl :: IfaceDecl -> IfaceDecl -> IfaceEq
754 eqIfDecl (IfaceId s1 t1 i1) (IfaceId s2 t2 i2)
755 = bool (s1 == s2) &&& (t1 `eqIfType` t2) &&& (i1 `eqIfIdInfo` i2)
757 eqIfDecl d1@(IfaceForeign {}) d2@(IfaceForeign {})
758 = bool (ifName d1 == ifName d2 && ifExtName d1 == ifExtName d2)
760 eqIfDecl d1@(IfaceData {}) d2@(IfaceData {})
761 = bool (ifName d1 == ifName d2 &&
762 ifRec d1 == ifRec d2 &&
763 ifVrcs d1 == ifVrcs d2 &&
764 ifGeneric d1 == ifGeneric d2) &&&
765 eqWith (ifTyVars d1) (ifTyVars d2) (\ env ->
766 eq_hsCD env (ifCons d1) (ifCons d2)
768 -- The type variables of the data type do not scope
769 -- over the constructors (any more), but they do scope
770 -- over the stupid context in the IfaceConDecls
772 eqIfDecl d1@(IfaceSyn {}) d2@(IfaceSyn {})
773 = bool (ifName d1 == ifName d2) &&&
774 eqWith (ifTyVars d1) (ifTyVars d2) (\ env ->
775 eq_ifType env (ifSynRhs d1) (ifSynRhs d2)
778 eqIfDecl d1@(IfaceClass {}) d2@(IfaceClass {})
779 = bool (ifName d1 == ifName d2 &&
780 ifRec d1 == ifRec d2 &&
781 ifVrcs d1 == ifVrcs d2) &&&
782 eqWith (ifTyVars d1) (ifTyVars d2) (\ env ->
783 eq_ifContext env (ifCtxt d1) (ifCtxt d2) &&&
784 eqListBy (eq_hsFD env) (ifFDs d1) (ifFDs d2) &&&
785 eqListBy (eq_cls_sig env) (ifSigs d1) (ifSigs d2)
788 eqIfDecl _ _ = NotEqual -- default case
791 eqWith :: [IfaceTvBndr] -> [IfaceTvBndr] -> (EqEnv -> IfaceEq) -> IfaceEq
792 eqWith = eq_ifTvBndrs emptyEqEnv
794 -----------------------
795 eqIfInst d1 d2 = bool (ifDFun d1 == ifDFun d2) &&&
796 zapEq (ifInstHead d1 `eqIfType` ifInstHead d2)
797 -- zapEq: for instances, ignore the EqBut part
799 eqIfRule (IfaceRule n1 a1 bs1 f1 es1 rhs1)
800 (IfaceRule n2 a2 bs2 f2 es2 rhs2)
801 = bool (n1==n2 && a1==a2) &&&
803 eq_ifBndrs emptyEqEnv bs1 bs2 (\env ->
804 zapEq (eqListBy (eq_ifaceExpr env) es1 es2) &&&
805 -- zapEq: for the LHSs, ignore the EqBut part
806 eq_ifaceExpr env rhs1 rhs2)
807 eqIfRule _ _ = NotEqual
809 eq_hsCD env (IfDataTyCon st1 c1) (IfDataTyCon st2 c2)
810 = eqMaybeBy (eq_ifContext env) st1 st2 &&&
811 eqListBy (eq_ConDecl env) c1 c2
813 eq_hsCD env (IfNewTyCon c1) (IfNewTyCon c2) = eq_ConDecl env c1 c2
814 eq_hsCD env IfAbstractTyCon IfAbstractTyCon = Equal
815 eq_hsCD env d1 d2 = NotEqual
817 eq_ConDecl env c1@(IfVanillaCon {}) c2@(IfVanillaCon {})
818 = bool (ifConOcc c1 == ifConOcc c2 &&
819 ifConInfix c1 == ifConInfix c2 &&
820 ifConStricts c1 == ifConStricts c2 &&
821 ifConFields c1 == ifConFields c2) &&&
822 eq_ifTypes env (ifConArgTys c1) (ifConArgTys c2)
824 eq_ConDecl env c1@(IfGadtCon {}) c2@(IfGadtCon {})
825 = bool (ifConOcc c1 == ifConOcc c2 &&
826 ifConStricts c1 == ifConStricts c2) &&&
827 eq_ifTvBndrs env (ifConTyVars c1) (ifConTyVars c2) (\ env ->
828 eq_ifContext env (ifConCtxt c1) (ifConCtxt c2) &&&
829 eq_ifTypes env (ifConResTys c1) (ifConResTys c2) &&&
830 eq_ifTypes env (ifConArgTys c1) (ifConArgTys c2))
832 eq_ConDecl env c1 c2 = NotEqual
834 eq_hsFD env (ns1,ms1) (ns2,ms2)
835 = eqListBy (eqIfOcc env) ns1 ns2 &&& eqListBy (eqIfOcc env) ms1 ms2
837 eq_cls_sig env (IfaceClassOp n1 dm1 ty1) (IfaceClassOp n2 dm2 ty2)
838 = bool (n1==n2 && dm1 == dm2) &&& eq_ifType env ty1 ty2
844 eqIfIdInfo NoInfo NoInfo = Equal
845 eqIfIdInfo (HasInfo is1) (HasInfo is2) = eqListBy eq_item is1 is2
846 eqIfIdInfo i1 i2 = NotEqual
848 eq_item (HsArity a1) (HsArity a2) = bool (a1 == a2)
849 eq_item (HsStrictness s1) (HsStrictness s2) = bool (s1 == s2)
850 eq_item (HsUnfold a1 u1) (HsUnfold a2 u2) = bool (a1 == a2) &&& eq_ifaceExpr emptyEqEnv u1 u2
851 eq_item HsNoCafRefs HsNoCafRefs = Equal
852 eq_item (HsWorker wkr1 a1) (HsWorker wkr2 a2) = bool (a1==a2) &&& (wkr1 `eqIfExt` wkr2)
853 eq_item _ _ = NotEqual
856 eq_ifaceExpr :: EqEnv -> IfaceExpr -> IfaceExpr -> IfaceEq
857 eq_ifaceExpr env (IfaceLcl v1) (IfaceLcl v2) = eqIfOcc env v1 v2
858 eq_ifaceExpr env (IfaceExt v1) (IfaceExt v2) = eqIfExt v1 v2
859 eq_ifaceExpr env (IfaceLit l1) (IfaceLit l2) = bool (l1 == l2)
860 eq_ifaceExpr env (IfaceFCall c1 ty1) (IfaceFCall c2 ty2) = bool (c1==c2) &&& eq_ifType env ty1 ty2
861 eq_ifaceExpr env (IfaceType ty1) (IfaceType ty2) = eq_ifType env ty1 ty2
862 eq_ifaceExpr env (IfaceTuple n1 as1) (IfaceTuple n2 as2) = bool (n1==n2) &&& eqListBy (eq_ifaceExpr env) as1 as2
863 eq_ifaceExpr env (IfaceLam b1 body1) (IfaceLam b2 body2) = eq_ifBndr env b1 b2 (\env -> eq_ifaceExpr env body1 body2)
864 eq_ifaceExpr env (IfaceApp f1 a1) (IfaceApp f2 a2) = eq_ifaceExpr env f1 f2 &&& eq_ifaceExpr env a1 a2
865 eq_ifaceExpr env (IfaceNote n1 r1) (IfaceNote n2 r2) = eq_ifaceNote env n1 n2 &&& eq_ifaceExpr env r1 r2
867 eq_ifaceExpr env (IfaceCase s1 b1 ty1 as1) (IfaceCase s2 b2 ty2 as2)
868 = eq_ifaceExpr env s1 s2 &&&
869 eq_ifType env ty1 ty2 &&&
870 eq_ifNakedBndr env b1 b2 (\env -> eqListBy (eq_ifaceAlt env) as1 as2)
872 eq_ifaceAlt env (c1,bs1,r1) (c2,bs2,r2)
873 = bool (eq_ifaceConAlt c1 c2) &&&
874 eq_ifNakedBndrs env bs1 bs2 (\env -> eq_ifaceExpr env r1 r2)
876 eq_ifaceExpr env (IfaceLet (IfaceNonRec b1 r1) x1) (IfaceLet (IfaceNonRec b2 r2) x2)
877 = eq_ifaceExpr env r1 r2 &&& eq_ifIdBndr env b1 b2 (\env -> eq_ifaceExpr env x1 x2)
879 eq_ifaceExpr env (IfaceLet (IfaceRec as1) x1) (IfaceLet (IfaceRec as2) x2)
880 = eq_ifIdBndrs env bs1 bs2 (\env -> eqListBy (eq_ifaceExpr env) rs1 rs2 &&& eq_ifaceExpr env x1 x2)
882 (bs1,rs1) = unzip as1
883 (bs2,rs2) = unzip as2
886 eq_ifaceExpr env _ _ = NotEqual
889 eq_ifaceConAlt :: IfaceConAlt -> IfaceConAlt -> Bool
890 eq_ifaceConAlt IfaceDefault IfaceDefault = True
891 eq_ifaceConAlt (IfaceDataAlt n1) (IfaceDataAlt n2) = n1==n2
892 eq_ifaceConAlt (IfaceTupleAlt c1) (IfaceTupleAlt c2) = c1==c2
893 eq_ifaceConAlt (IfaceLitAlt l1) (IfaceLitAlt l2) = l1==l2
894 eq_ifaceConAlt _ _ = False
897 eq_ifaceNote :: EqEnv -> IfaceNote -> IfaceNote -> IfaceEq
898 eq_ifaceNote env (IfaceSCC c1) (IfaceSCC c2) = bool (c1==c2)
899 eq_ifaceNote env (IfaceCoerce t1) (IfaceCoerce t2) = eq_ifType env t1 t2
900 eq_ifaceNote env IfaceInlineCall IfaceInlineCall = Equal
901 eq_ifaceNote env IfaceInlineMe IfaceInlineMe = Equal
902 eq_ifaceNote env (IfaceCoreNote s1) (IfaceCoreNote s2) = bool (s1==s2)
903 eq_ifaceNote env _ _ = NotEqual
907 ---------------------
908 eqIfType t1 t2 = eq_ifType emptyEqEnv t1 t2
911 eq_ifType env (IfaceTyVar n1) (IfaceTyVar n2) = eqIfOcc env n1 n2
912 eq_ifType env (IfaceAppTy s1 t1) (IfaceAppTy s2 t2) = eq_ifType env s1 s2 &&& eq_ifType env t1 t2
913 eq_ifType env (IfacePredTy st1) (IfacePredTy st2) = eq_ifPredType env st1 st2
914 eq_ifType env (IfaceTyConApp tc1 ts1) (IfaceTyConApp tc2 ts2) = tc1 `eqIfTc` tc2 &&& eq_ifTypes env ts1 ts2
915 eq_ifType env (IfaceForAllTy tv1 t1) (IfaceForAllTy tv2 t2) = eq_ifTvBndr env tv1 tv2 (\env -> eq_ifType env t1 t2)
916 eq_ifType env (IfaceFunTy s1 t1) (IfaceFunTy s2 t2) = eq_ifType env s1 s2 &&& eq_ifType env t1 t2
917 eq_ifType env _ _ = NotEqual
920 eq_ifTypes env = eqListBy (eq_ifType env)
923 eq_ifContext env a b = eqListBy (eq_ifPredType env) a b
926 eq_ifPredType env (IfaceClassP c1 tys1) (IfaceClassP c2 tys2) = c1 `eqIfExt` c2 &&& eq_ifTypes env tys1 tys2
927 eq_ifPredType env (IfaceIParam n1 ty1) (IfaceIParam n2 ty2) = bool (n1 == n2) &&& eq_ifType env ty1 ty2
928 eq_ifPredType env _ _ = NotEqual
931 eqIfTc (IfaceTc tc1) (IfaceTc tc2) = tc1 `eqIfExt` tc2
932 eqIfTc IfaceIntTc IfaceIntTc = Equal
933 eqIfTc IfaceCharTc IfaceCharTc = Equal
934 eqIfTc IfaceBoolTc IfaceBoolTc = Equal
935 eqIfTc IfaceListTc IfaceListTc = Equal
936 eqIfTc IfacePArrTc IfacePArrTc = Equal
937 eqIfTc (IfaceTupTc bx1 ar1) (IfaceTupTc bx2 ar2) = bool (bx1==bx2 && ar1==ar2)
938 eqIfTc _ _ = NotEqual
941 -----------------------------------------------------------
942 Support code for equality checking
943 -----------------------------------------------------------
946 ------------------------------------
947 type EqEnv = OccEnv OccName -- Tracks the mapping from L-variables to R-variables
949 eqIfOcc :: EqEnv -> OccName -> OccName -> IfaceEq
950 eqIfOcc env n1 n2 = case lookupOccEnv env n1 of
951 Just n1 -> bool (n1 == n2)
952 Nothing -> bool (n1 == n2)
954 extendEqEnv :: EqEnv -> OccName -> OccName -> EqEnv
955 extendEqEnv env n1 n2 | n1 == n2 = env
956 | otherwise = extendOccEnv env n1 n2
959 emptyEqEnv = emptyOccEnv
961 ------------------------------------
962 type ExtEnv bndr = EqEnv -> bndr -> bndr -> (EqEnv -> IfaceEq) -> IfaceEq
964 eq_ifNakedBndr :: ExtEnv OccName
965 eq_ifBndr :: ExtEnv IfaceBndr
966 eq_ifTvBndr :: ExtEnv IfaceTvBndr
967 eq_ifIdBndr :: ExtEnv IfaceIdBndr
969 eq_ifNakedBndr env n1 n2 k = k (extendEqEnv env n1 n2)
971 eq_ifBndr env (IfaceIdBndr b1) (IfaceIdBndr b2) k = eq_ifIdBndr env b1 b2 k
972 eq_ifBndr env (IfaceTvBndr b1) (IfaceTvBndr b2) k = eq_ifTvBndr env b1 b2 k
973 eq_ifBndr _ _ _ _ = NotEqual
975 eq_ifTvBndr env (v1, k1) (v2, k2) k = bool (k1 == k2) &&& k (extendEqEnv env v1 v2)
976 eq_ifIdBndr env (v1, t1) (v2, t2) k = eq_ifType env t1 t2 &&& k (extendEqEnv env v1 v2)
978 eq_ifBndrs :: ExtEnv [IfaceBndr]
979 eq_ifIdBndrs :: ExtEnv [IfaceIdBndr]
980 eq_ifTvBndrs :: ExtEnv [IfaceTvBndr]
981 eq_ifNakedBndrs :: ExtEnv [OccName]
982 eq_ifBndrs = eq_bndrs_with eq_ifBndr
983 eq_ifIdBndrs = eq_bndrs_with eq_ifIdBndr
984 eq_ifTvBndrs = eq_bndrs_with eq_ifTvBndr
985 eq_ifNakedBndrs = eq_bndrs_with eq_ifNakedBndr
987 eq_bndrs_with eq env [] [] k = k env
988 eq_bndrs_with eq env (b1:bs1) (b2:bs2) k = eq env b1 b2 (\env -> eq_bndrs_with eq env bs1 bs2 k)
989 eq_bndrs_with eq env _ _ _ = NotEqual
993 eqListBy :: (a->a->IfaceEq) -> [a] -> [a] -> IfaceEq
994 eqListBy eq [] [] = Equal
995 eqListBy eq (x:xs) (y:ys) = eq x y &&& eqListBy eq xs ys
996 eqListBy eq xs ys = NotEqual
998 eqMaybeBy :: (a->a->IfaceEq) -> Maybe a -> Maybe a -> IfaceEq
999 eqMaybeBy eq Nothing Nothing = Equal
1000 eqMaybeBy eq (Just x) (Just y) = eq x y
1001 eqMaybeBy eq x y = NotEqual