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, getSynTyConDefn,
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 wiredInNameTyThing_maybe )
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 ifCtxt :: IfaceContext, -- The "stupid theta"
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 [IfaceConDecl] -- data type decls
131 | IfNewTyCon IfaceConDecl -- newtype decls
133 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
134 visibleIfConDecls IfAbstractTyCon = []
135 visibleIfConDecls (IfDataTyCon cs) = cs
136 visibleIfConDecls (IfNewTyCon c) = [c]
140 ifConOcc :: OccName, -- Constructor name
141 ifConInfix :: Bool, -- True <=> declared infix
142 ifConArgTys :: [IfaceType], -- Arg types
143 ifConStricts :: [StrictnessMark], -- Empty (meaning all lazy), or 1-1 corresp with arg types
144 ifConFields :: [OccName] } -- ...ditto... (field labels)
146 ifConOcc :: OccName, -- Constructor name
147 ifConTyVars :: [IfaceTvBndr], -- All tyvars
148 ifConCtxt :: IfaceContext, -- Non-stupid context
149 ifConArgTys :: [IfaceType], -- Arg types
150 ifConResTys :: [IfaceType], -- Result type args
151 ifConStricts :: [StrictnessMark] } -- Empty (meaning all lazy), or 1-1 corresp with arg types
154 = IfaceInst { ifInstCls :: IfaceExtName, -- See comments with
155 ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance
156 ifDFun :: OccName, -- The dfun
157 ifOFlag :: OverlapFlag, -- Overlap flag
158 ifInstOrph :: Maybe OccName } -- See is_orph in defn of Instance
159 -- There's always a separate IfaceDecl for the DFun, which gives
160 -- its IdInfo with its full type and version number.
161 -- The instance declarations taken together have a version number,
162 -- and we don't want that to wobble gratuitously
163 -- If this instance decl is *used*, we'll record a usage on the dfun;
164 -- and if the head does not change it won't be used if it wasn't before
168 ifRuleName :: RuleName,
169 ifActivation :: Activation,
170 ifRuleBndrs :: [IfaceBndr], -- Tyvars and term vars
171 ifRuleHead :: IfaceExtName, -- Head of lhs
172 ifRuleArgs :: [IfaceExpr], -- Args of LHS
173 ifRuleRhs :: IfaceExpr,
174 ifRuleOrph :: Maybe OccName -- Just like IfaceInst
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
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, ifCtxt = context,
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])
269 pp_nd = case condecls of
270 IfAbstractTyCon -> ptext SLIT("data")
271 IfDataTyCon _ -> ptext SLIT("data")
272 IfNewTyCon _ -> ptext SLIT("newtype")
274 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
275 ifFDs = fds, ifSigs = sigs, ifVrcs = vrcs, ifRec = isrec})
276 = hang (ptext SLIT("class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
277 4 (vcat [pprVrcs vrcs,
281 pprVrcs vrcs = ptext SLIT("Variances") <+> ppr vrcs
282 pprRec isrec = ptext SLIT("RecFlag") <+> ppr isrec
283 pprGen True = ptext SLIT("Generics: yes")
284 pprGen False = ptext SLIT("Generics: no")
286 instance Outputable IfaceClassOp where
287 ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
289 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
290 pprIfaceDeclHead context thing tyvars
291 = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing), pprIfaceTvBndrs tyvars]
293 pp_condecls tc IfAbstractTyCon = ptext SLIT("{- abstract -}")
294 pp_condecls tc (IfNewTyCon c) = equals <+> pprIfaceConDecl tc c
295 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext SLIT(" |"))
296 (map (pprIfaceConDecl tc) cs))
298 pprIfaceConDecl tc (IfVanillaCon {
299 ifConOcc = name, ifConInfix = is_infix,
300 ifConArgTys = arg_tys,
301 ifConStricts = strs, ifConFields = fields })
302 = sep [ppr name <+> sep (map pprParendIfaceType arg_tys),
303 if is_infix then ptext SLIT("Infix") else empty,
304 if null strs then empty
305 else nest 4 (ptext SLIT("Stricts:") <+> hsep (map ppr strs)),
306 if null fields then empty
307 else nest 4 (ptext SLIT("Fields:") <+> hsep (map ppr fields))]
309 pprIfaceConDecl tc (IfGadtCon {
311 ifConTyVars = tvs, ifConCtxt = ctxt,
312 ifConArgTys = arg_tys, ifConResTys = res_tys,
313 ifConStricts = strs })
314 = sep [ppr name <+> dcolon <+> pprIfaceForAllPart tvs ctxt (ppr con_tau),
315 if null strs then empty
316 else nest 4 (ptext SLIT("Stricts:") <+> hsep (map ppr strs))]
318 con_tau = foldr1 IfaceFunTy (arg_tys ++ [tc_app])
319 tc_app = IfaceTyConApp (IfaceTc (LocalTop tc)) res_tys
320 -- Gruesome, but jsut for debug print
322 instance Outputable IfaceRule where
323 ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
324 ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
325 = sep [hsep [doubleQuotes (ftext name), ppr act,
326 ptext SLIT("forall") <+> pprIfaceBndrs bndrs],
327 nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
328 ptext SLIT("=") <+> ppr rhs])
331 instance Outputable IfaceInst where
332 ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
333 ifInstCls = cls, ifInstTys = mb_tcs})
334 = hang (ptext SLIT("instance") <+> ppr flag
335 <+> ppr cls <+> brackets (pprWithCommas ppr_mb mb_tcs))
336 2 (equals <+> ppr dfun_id)
339 ppr_mb (Just tc) = ppr tc
343 ----------------------------- Printing IfaceExpr ------------------------------------
346 instance Outputable IfaceExpr where
347 ppr e = pprIfaceExpr noParens e
349 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
350 -- The function adds parens in context that need
351 -- an atomic value (e.g. function args)
353 pprIfaceExpr add_par (IfaceLcl v) = ppr v
354 pprIfaceExpr add_par (IfaceExt v) = ppr v
355 pprIfaceExpr add_par (IfaceLit l) = ppr l
356 pprIfaceExpr add_par (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
357 pprIfaceExpr add_par (IfaceType ty) = char '@' <+> pprParendIfaceType ty
359 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
360 pprIfaceExpr add_par (IfaceTuple c as) = tupleParens c (interpp'SP as)
362 pprIfaceExpr add_par e@(IfaceLam _ _)
363 = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
364 pprIfaceExpr noParens body])
366 (bndrs,body) = collect [] e
367 collect bs (IfaceLam b e) = collect (b:bs) e
368 collect bs e = (reverse bs, e)
371 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
373 = add_par (sep [ptext SLIT("case") <+> char '@' <+> pprParendIfaceType ty <+> pprIfaceExpr noParens scrut <+> ptext SLIT("of")
374 <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
375 pprIfaceExpr noParens rhs <+> char '}'])
378 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
380 = add_par (sep [ptext SLIT("case") <+> char '@' <+> pprParendIfaceType ty <+> pprIfaceExpr noParens scrut <+> ptext SLIT("of")
381 <+> ppr bndr <+> char '{',
382 nest 2 (sep (map ppr_alt alts)) <+> char '}'])
384 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
385 = add_par (sep [ptext SLIT("let {"),
386 nest 2 (ppr_bind (b, rhs)),
388 pprIfaceExpr noParens body])
390 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
391 = add_par (sep [ptext SLIT("letrec {"),
392 nest 2 (sep (map ppr_bind pairs)),
394 pprIfaceExpr noParens body])
396 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
398 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
399 arrow <+> pprIfaceExpr noParens rhs]
401 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
402 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
404 ppr_bind ((b,ty),rhs) = sep [ppr b <+> dcolon <+> ppr ty,
405 equals <+> pprIfaceExpr noParens rhs]
408 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args)
409 pprIfaceApp fun args = sep (pprIfaceExpr parens fun : args)
412 instance Outputable IfaceNote where
413 ppr (IfaceSCC cc) = pprCostCentreCore cc
414 ppr (IfaceCoerce ty) = ptext SLIT("__coerce") <+> pprParendIfaceType ty
415 ppr IfaceInlineCall = ptext SLIT("__inline_call")
416 ppr IfaceInlineMe = ptext SLIT("__inline_me")
417 ppr (IfaceCoreNote s) = ptext SLIT("__core_note") <+> pprHsString (mkFastString s)
419 instance Outputable IfaceConAlt where
420 ppr IfaceDefault = text "DEFAULT"
421 ppr (IfaceLitAlt l) = ppr l
422 ppr (IfaceDataAlt d) = ppr d
423 ppr (IfaceTupleAlt b) = panic "ppr IfaceConAlt"
424 -- IfaceTupleAlt is handled by the case-alternative printer
427 instance Outputable IfaceIdInfo where
429 ppr (HasInfo is) = ptext SLIT("{-") <+> fsep (map ppr_hs_info is) <+> ptext SLIT("-}")
431 ppr_hs_info (HsUnfold prag unf) = sep [ptext SLIT("Unfolding: ") <> ppr prag,
432 parens (pprIfaceExpr noParens unf)]
433 ppr_hs_info (HsArity arity) = ptext SLIT("Arity:") <+> int arity
434 ppr_hs_info (HsStrictness str) = ptext SLIT("Strictness:") <+> pprIfaceStrictSig str
435 ppr_hs_info HsNoCafRefs = ptext SLIT("HasNoCafRefs")
436 ppr_hs_info (HsWorker w a) = ptext SLIT("Worker:") <+> ppr w <+> int a
440 %************************************************************************
442 Converting things to their Iface equivalents
444 %************************************************************************
448 tyThingToIfaceDecl :: (Name -> IfaceExtName) -> TyThing -> IfaceDecl
449 -- Assumption: the thing is already tidied, so that locally-bound names
450 -- (lambdas, for-alls) already have non-clashing OccNames
451 -- Reason: Iface stuff uses OccNames, and the conversion here does
452 -- not do tidying on the way
453 tyThingToIfaceDecl ext (AnId id)
454 = IfaceId { ifName = getOccName id,
455 ifType = toIfaceType ext (idType id),
458 info = case toIfaceIdInfo ext (idInfo id) of
460 items -> HasInfo items
462 tyThingToIfaceDecl ext (AClass clas)
463 = IfaceClass { ifCtxt = toIfaceContext ext sc_theta,
464 ifName = getOccName clas,
465 ifTyVars = toIfaceTvBndrs clas_tyvars,
466 ifFDs = map toIfaceFD clas_fds,
467 ifSigs = map toIfaceClassOp op_stuff,
468 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
469 ifVrcs = tyConArgVrcs tycon }
471 (clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
472 tycon = classTyCon clas
474 toIfaceClassOp (sel_id, def_meth)
475 = ASSERT(sel_tyvars == clas_tyvars)
476 IfaceClassOp (getOccName sel_id) def_meth (toIfaceType ext op_ty)
478 -- Be careful when splitting the type, because of things
479 -- like class Foo a where
480 -- op :: (?x :: String) => a -> a
481 -- and class Baz a where
482 -- op :: (Ord a) => a -> a
483 (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
484 op_ty = funResultTy rho_ty
486 toIfaceFD (tvs1, tvs2) = (map getOccName tvs1, map getOccName tvs2)
488 tyThingToIfaceDecl ext (ATyCon tycon)
490 = IfaceSyn { ifName = getOccName tycon,
491 ifTyVars = toIfaceTvBndrs tyvars,
492 ifVrcs = tyConArgVrcs tycon,
493 ifSynRhs = toIfaceType ext syn_ty }
496 = IfaceData { ifName = getOccName tycon,
497 ifTyVars = toIfaceTvBndrs tyvars,
498 ifCtxt = toIfaceContext ext (tyConStupidTheta tycon),
499 ifCons = ifaceConDecls (algTyConRhs tycon),
500 ifRec = boolToRecFlag (isRecursiveTyCon tycon),
501 ifVrcs = tyConArgVrcs tycon,
502 ifGeneric = tyConHasGenerics tycon }
504 | isForeignTyCon tycon
505 = IfaceForeign { ifName = getOccName tycon,
506 ifExtName = tyConExtName tycon }
508 | isPrimTyCon tycon || isFunTyCon tycon
509 -- Needed in GHCi for ':info Int#', for example
510 = IfaceData { ifName = getOccName tycon,
511 ifTyVars = toIfaceTvBndrs (take (tyConArity tycon) alphaTyVars),
513 ifCons = IfAbstractTyCon,
515 ifRec = NonRecursive,
516 ifVrcs = tyConArgVrcs tycon }
518 | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
520 tyvars = tyConTyVars tycon
521 (_, syn_ty) = getSynTyConDefn tycon
523 ifaceConDecls (NewTyCon con _ _) = IfNewTyCon (ifaceConDecl con)
524 ifaceConDecls (DataTyCon cons _) = IfDataTyCon (map ifaceConDecl cons)
525 ifaceConDecls AbstractTyCon = IfAbstractTyCon
526 -- The last case happens when a TyCon has been trimmed during tidying
527 -- Furthermore, tyThingToIfaceDecl is also used
528 -- in TcRnDriver for GHCi, when browsing a module, in which case the
529 -- AbstractTyCon case is perfectly sensible.
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 ext (ADataCon dc)
551 = pprPanic "toIfaceDecl" (ppr dc) -- Should be trimmed out earlier
554 --------------------------
555 instanceToIfaceInst :: (Name -> IfaceExtName) -> Instance -> IfaceInst
556 instanceToIfaceInst ext_lhs ispec@(Instance { is_dfun = dfun_id, is_flag = oflag,
557 is_cls = cls, is_tcs = mb_tcs,
559 = IfaceInst { ifDFun = getOccName dfun_id,
561 ifInstCls = ext_lhs cls,
562 ifInstTys = map do_rough mb_tcs,
565 do_rough Nothing = Nothing
566 do_rough (Just n) | Just (ATyCon tc) <- wiredInNameTyThing_maybe n
567 = Just (toIfaceTyCon ext_lhs tc)
569 = Just (IfaceTc (ext_lhs n))
571 --------------------------
572 toIfaceIdInfo :: (Name -> IfaceExtName) -> IdInfo -> [IfaceInfoItem]
573 toIfaceIdInfo ext id_info
574 = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
575 wrkr_hsinfo, unfold_hsinfo]
577 ------------ Arity --------------
578 arity_info = arityInfo id_info
579 arity_hsinfo | arity_info == 0 = Nothing
580 | otherwise = Just (HsArity arity_info)
582 ------------ Caf Info --------------
583 caf_info = cafInfo id_info
584 caf_hsinfo = case caf_info of
585 NoCafRefs -> Just HsNoCafRefs
588 ------------ Strictness --------------
589 -- No point in explicitly exporting TopSig
590 strict_hsinfo = case newStrictnessInfo id_info of
591 Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
594 ------------ Worker --------------
595 work_info = workerInfo id_info
596 has_worker = case work_info of { HasWorker _ _ -> True; other -> False }
597 wrkr_hsinfo = case work_info of
598 HasWorker work_id wrap_arity ->
599 Just (HsWorker (ext (idName work_id)) wrap_arity)
602 ------------ Unfolding --------------
603 -- The unfolding is redundant if there is a worker
604 unfold_info = unfoldingInfo id_info
605 inline_prag = inlinePragInfo id_info
606 rhs = unfoldingTemplate unfold_info
607 unfold_hsinfo | neverUnfold unfold_info
608 || has_worker = Nothing
609 | otherwise = Just (HsUnfold inline_prag (toIfaceExpr ext rhs))
611 --------------------------
612 coreRuleToIfaceRule :: (Name -> IfaceExtName) -- For the LHS names
613 -> (Name -> IfaceExtName) -- For the RHS names
614 -> CoreRule -> IfaceRule
615 coreRuleToIfaceRule ext_lhs ext_rhs (BuiltinRule { ru_fn = fn})
616 = pprTrace "toHsRule: builtin" (ppr fn) $
617 bogusIfaceRule (mkIfaceExtName fn)
619 coreRuleToIfaceRule ext_lhs ext_rhs
620 (Rule { ru_name = name, ru_fn = fn, ru_act = act, ru_bndrs = bndrs,
621 ru_args = args, ru_rhs = rhs, ru_orph = orph })
622 = IfaceRule { ifRuleName = name, ifActivation = act,
623 ifRuleBndrs = map (toIfaceBndr ext_lhs) bndrs,
624 ifRuleHead = ext_lhs fn,
625 ifRuleArgs = map do_arg args,
626 ifRuleRhs = toIfaceExpr ext_rhs rhs,
629 -- For type args we must remove synonyms from the outermost
630 -- level. Reason: so that when we read it back in we'll
631 -- construct the same ru_rough field as we have right now;
633 do_arg (Type ty) = IfaceType (toIfaceType ext_lhs (deNoteType ty))
634 do_arg arg = toIfaceExpr ext_lhs arg
636 bogusIfaceRule :: IfaceExtName -> IfaceRule
637 bogusIfaceRule id_name
638 = IfaceRule { ifRuleName = FSLIT("bogus"), ifActivation = NeverActive,
639 ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
640 ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
642 ---------------------
643 toIfaceExpr :: (Name -> IfaceExtName) -> CoreExpr -> IfaceExpr
644 toIfaceExpr ext (Var v) = toIfaceVar ext v
645 toIfaceExpr ext (Lit l) = IfaceLit l
646 toIfaceExpr ext (Type ty) = IfaceType (toIfaceType ext ty)
647 toIfaceExpr ext (Lam x b) = IfaceLam (toIfaceBndr ext x) (toIfaceExpr ext b)
648 toIfaceExpr ext (App f a) = toIfaceApp ext f [a]
650 toIfaceExpr ext (Case s x ty as) = IfaceCase (toIfaceExpr ext s) (getOccName x) (toIfaceType ext ty) (map (toIfaceAlt ext) as)
651 toIfaceExpr ext (Let b e) = IfaceLet (toIfaceBind ext b) (toIfaceExpr ext e)
652 toIfaceExpr ext (Note n e) = IfaceNote (toIfaceNote ext n) (toIfaceExpr ext e)
654 ---------------------
655 toIfaceNote ext (SCC cc) = IfaceSCC cc
656 toIfaceNote ext (Coerce t1 _) = IfaceCoerce (toIfaceType ext t1)
657 toIfaceNote ext InlineCall = IfaceInlineCall
658 toIfaceNote ext InlineMe = IfaceInlineMe
659 toIfaceNote ext (CoreNote s) = IfaceCoreNote s
661 ---------------------
662 toIfaceBind ext (NonRec b r) = IfaceNonRec (toIfaceIdBndr ext b) (toIfaceExpr ext r)
663 toIfaceBind ext (Rec prs) = IfaceRec [(toIfaceIdBndr ext b, toIfaceExpr ext r) | (b,r) <- prs]
665 ---------------------
666 toIfaceAlt ext (c,bs,r) = (toIfaceCon c, map getOccName bs, toIfaceExpr ext r)
668 ---------------------
669 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
670 | otherwise = IfaceDataAlt (getOccName dc)
674 toIfaceCon (LitAlt l) = IfaceLitAlt l
675 toIfaceCon DEFAULT = IfaceDefault
677 ---------------------
678 toIfaceApp ext (App f a) as = toIfaceApp ext f (a:as)
679 toIfaceApp ext (Var v) as
680 = case isDataConWorkId_maybe v of
681 -- We convert the *worker* for tuples into IfaceTuples
682 Just dc | isTupleTyCon tc && saturated
683 -> IfaceTuple (tupleTyConBoxity tc) tup_args
685 val_args = dropWhile isTypeArg as
686 saturated = val_args `lengthIs` idArity v
687 tup_args = map (toIfaceExpr ext) val_args
690 other -> mkIfaceApps ext (toIfaceVar ext v) as
692 toIfaceApp ext e as = mkIfaceApps ext (toIfaceExpr ext e) as
694 mkIfaceApps ext f as = foldl (\f a -> IfaceApp f (toIfaceExpr ext a)) f as
696 ---------------------
697 toIfaceVar :: (Name -> IfaceExtName) -> Id -> IfaceExpr
699 | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType ext (idType v))
700 -- Foreign calls have special syntax
701 | isExternalName name = IfaceExt (ext name)
702 | otherwise = IfaceLcl (nameOccName name)
708 %************************************************************************
710 Equality, for interface file version generaion only
712 %************************************************************************
714 Equality over IfaceSyn returns an IfaceEq, not a Bool. The new constructor is
715 EqBut, which gives the set of *locally-defined* things whose version must be equal
716 for the whole thing to be equal. So the key function is eqIfExt, which compares
719 Of course, equality is also done modulo alpha conversion.
723 = Equal -- Definitely exactly the same
724 | NotEqual -- Definitely different
725 | EqBut OccSet -- The same provided these local things have not changed
727 bool :: Bool -> IfaceEq
729 bool False = NotEqual
731 zapEq :: IfaceEq -> IfaceEq -- Used to forget EqBut information
732 zapEq (EqBut _) = Equal
735 (&&&) :: IfaceEq -> IfaceEq -> IfaceEq
737 NotEqual &&& x = NotEqual
738 EqBut occs &&& Equal = EqBut occs
739 EqBut occs &&& NotEqual = NotEqual
740 EqBut occs1 &&& EqBut occs2 = EqBut (occs1 `unionOccSets` occs2)
742 ---------------------
743 eqIfExt :: IfaceExtName -> IfaceExtName -> IfaceEq
744 -- This function is the core of the EqBut stuff
745 eqIfExt (ExtPkg mod1 occ1) (ExtPkg mod2 occ2) = bool (mod1==mod2 && occ1==occ2)
746 eqIfExt (HomePkg mod1 occ1 v1) (HomePkg mod2 occ2 v2) = bool (mod1==mod2 && occ1==occ2 && v1==v2)
747 eqIfExt (LocalTop occ1) (LocalTop occ2) | occ1 == occ2 = EqBut (unitOccSet occ1)
748 eqIfExt (LocalTopSub occ1 p1) (LocalTop occ2) | occ1 == occ2 = EqBut (unitOccSet p1)
749 eqIfExt (LocalTopSub occ1 p1) (LocalTopSub occ2 _) | occ1 == occ2 = EqBut (unitOccSet p1)
750 eqIfExt n1 n2 = NotEqual
755 ---------------------
756 eqIfDecl :: IfaceDecl -> IfaceDecl -> IfaceEq
757 eqIfDecl (IfaceId s1 t1 i1) (IfaceId s2 t2 i2)
758 = bool (s1 == s2) &&& (t1 `eqIfType` t2) &&& (i1 `eqIfIdInfo` i2)
760 eqIfDecl d1@(IfaceForeign {}) d2@(IfaceForeign {})
761 = bool (ifName d1 == ifName d2 && ifExtName d1 == ifExtName d2)
763 eqIfDecl d1@(IfaceData {}) d2@(IfaceData {})
764 = bool (ifName d1 == ifName d2 &&
765 ifRec d1 == ifRec d2 &&
766 ifVrcs d1 == ifVrcs d2 &&
767 ifGeneric d1 == ifGeneric d2) &&&
768 eqWith (ifTyVars d1) (ifTyVars d2) (\ env ->
769 eq_ifContext env (ifCtxt d1) (ifCtxt d2) &&&
770 eq_hsCD env (ifCons d1) (ifCons d2)
772 -- The type variables of the data type do not scope
773 -- over the constructors (any more), but they do scope
774 -- over the stupid context in the IfaceConDecls
776 eqIfDecl d1@(IfaceSyn {}) d2@(IfaceSyn {})
777 = bool (ifName d1 == ifName d2) &&&
778 eqWith (ifTyVars d1) (ifTyVars d2) (\ env ->
779 eq_ifType env (ifSynRhs d1) (ifSynRhs d2)
782 eqIfDecl d1@(IfaceClass {}) d2@(IfaceClass {})
783 = bool (ifName d1 == ifName d2 &&
784 ifRec d1 == ifRec d2 &&
785 ifVrcs d1 == ifVrcs d2) &&&
786 eqWith (ifTyVars d1) (ifTyVars d2) (\ env ->
787 eq_ifContext env (ifCtxt d1) (ifCtxt d2) &&&
788 eqListBy (eq_hsFD env) (ifFDs d1) (ifFDs d2) &&&
789 eqListBy (eq_cls_sig env) (ifSigs d1) (ifSigs d2)
792 eqIfDecl _ _ = NotEqual -- default case
795 eqWith :: [IfaceTvBndr] -> [IfaceTvBndr] -> (EqEnv -> IfaceEq) -> IfaceEq
796 eqWith = eq_ifTvBndrs emptyEqEnv
798 -----------------------
799 eqIfInst d1 d2 = bool (ifDFun d1 == ifDFun d2)
800 -- All other changes are handled via the version info on the dfun
802 eqIfRule (IfaceRule n1 a1 bs1 f1 es1 rhs1 o1)
803 (IfaceRule n2 a2 bs2 f2 es2 rhs2 o2)
804 = bool (n1==n2 && a1==a2 && o1 == o2) &&&
806 eq_ifBndrs emptyEqEnv bs1 bs2 (\env ->
807 zapEq (eqListBy (eq_ifaceExpr env) es1 es2) &&&
808 -- zapEq: for the LHSs, ignore the EqBut part
809 eq_ifaceExpr env rhs1 rhs2)
811 eq_hsCD env (IfDataTyCon c1) (IfDataTyCon c2)
812 = eqListBy (eq_ConDecl env) c1 c2
814 eq_hsCD env (IfNewTyCon c1) (IfNewTyCon c2) = eq_ConDecl env c1 c2
815 eq_hsCD env IfAbstractTyCon IfAbstractTyCon = Equal
816 eq_hsCD env d1 d2 = NotEqual
818 eq_ConDecl env c1@(IfVanillaCon {}) c2@(IfVanillaCon {})
819 = bool (ifConOcc c1 == ifConOcc c2 &&
820 ifConInfix c1 == ifConInfix c2 &&
821 ifConStricts c1 == ifConStricts c2 &&
822 ifConFields c1 == ifConFields c2) &&&
823 eq_ifTypes env (ifConArgTys c1) (ifConArgTys c2)
825 eq_ConDecl env c1@(IfGadtCon {}) c2@(IfGadtCon {})
826 = bool (ifConOcc c1 == ifConOcc c2 &&
827 ifConStricts c1 == ifConStricts c2) &&&
828 eq_ifTvBndrs env (ifConTyVars c1) (ifConTyVars c2) (\ env ->
829 eq_ifContext env (ifConCtxt c1) (ifConCtxt c2) &&&
830 eq_ifTypes env (ifConResTys c1) (ifConResTys c2) &&&
831 eq_ifTypes env (ifConArgTys c1) (ifConArgTys c2))
833 eq_ConDecl env c1 c2 = NotEqual
835 eq_hsFD env (ns1,ms1) (ns2,ms2)
836 = eqListBy (eqIfOcc env) ns1 ns2 &&& eqListBy (eqIfOcc env) ms1 ms2
838 eq_cls_sig env (IfaceClassOp n1 dm1 ty1) (IfaceClassOp n2 dm2 ty2)
839 = bool (n1==n2 && dm1 == dm2) &&& eq_ifType env ty1 ty2
845 eqIfIdInfo NoInfo NoInfo = Equal
846 eqIfIdInfo (HasInfo is1) (HasInfo is2) = eqListBy eq_item is1 is2
847 eqIfIdInfo i1 i2 = NotEqual
849 eq_item (HsArity a1) (HsArity a2) = bool (a1 == a2)
850 eq_item (HsStrictness s1) (HsStrictness s2) = bool (s1 == s2)
851 eq_item (HsUnfold a1 u1) (HsUnfold a2 u2) = bool (a1 == a2) &&& eq_ifaceExpr emptyEqEnv u1 u2
852 eq_item HsNoCafRefs HsNoCafRefs = Equal
853 eq_item (HsWorker wkr1 a1) (HsWorker wkr2 a2) = bool (a1==a2) &&& (wkr1 `eqIfExt` wkr2)
854 eq_item _ _ = NotEqual
857 eq_ifaceExpr :: EqEnv -> IfaceExpr -> IfaceExpr -> IfaceEq
858 eq_ifaceExpr env (IfaceLcl v1) (IfaceLcl v2) = eqIfOcc env v1 v2
859 eq_ifaceExpr env (IfaceExt v1) (IfaceExt v2) = eqIfExt v1 v2
860 eq_ifaceExpr env (IfaceLit l1) (IfaceLit l2) = bool (l1 == l2)
861 eq_ifaceExpr env (IfaceFCall c1 ty1) (IfaceFCall c2 ty2) = bool (c1==c2) &&& eq_ifType env ty1 ty2
862 eq_ifaceExpr env (IfaceType ty1) (IfaceType ty2) = eq_ifType env ty1 ty2
863 eq_ifaceExpr env (IfaceTuple n1 as1) (IfaceTuple n2 as2) = bool (n1==n2) &&& eqListBy (eq_ifaceExpr env) as1 as2
864 eq_ifaceExpr env (IfaceLam b1 body1) (IfaceLam b2 body2) = eq_ifBndr env b1 b2 (\env -> eq_ifaceExpr env body1 body2)
865 eq_ifaceExpr env (IfaceApp f1 a1) (IfaceApp f2 a2) = eq_ifaceExpr env f1 f2 &&& eq_ifaceExpr env a1 a2
866 eq_ifaceExpr env (IfaceNote n1 r1) (IfaceNote n2 r2) = eq_ifaceNote env n1 n2 &&& eq_ifaceExpr env r1 r2
868 eq_ifaceExpr env (IfaceCase s1 b1 ty1 as1) (IfaceCase s2 b2 ty2 as2)
869 = eq_ifaceExpr env s1 s2 &&&
870 eq_ifType env ty1 ty2 &&&
871 eq_ifNakedBndr env b1 b2 (\env -> eqListBy (eq_ifaceAlt env) as1 as2)
873 eq_ifaceAlt env (c1,bs1,r1) (c2,bs2,r2)
874 = bool (eq_ifaceConAlt c1 c2) &&&
875 eq_ifNakedBndrs env bs1 bs2 (\env -> eq_ifaceExpr env r1 r2)
877 eq_ifaceExpr env (IfaceLet (IfaceNonRec b1 r1) x1) (IfaceLet (IfaceNonRec b2 r2) x2)
878 = eq_ifaceExpr env r1 r2 &&& eq_ifIdBndr env b1 b2 (\env -> eq_ifaceExpr env x1 x2)
880 eq_ifaceExpr env (IfaceLet (IfaceRec as1) x1) (IfaceLet (IfaceRec as2) x2)
881 = eq_ifIdBndrs env bs1 bs2 (\env -> eqListBy (eq_ifaceExpr env) rs1 rs2 &&& eq_ifaceExpr env x1 x2)
883 (bs1,rs1) = unzip as1
884 (bs2,rs2) = unzip as2
887 eq_ifaceExpr env _ _ = NotEqual
890 eq_ifaceConAlt :: IfaceConAlt -> IfaceConAlt -> Bool
891 eq_ifaceConAlt IfaceDefault IfaceDefault = True
892 eq_ifaceConAlt (IfaceDataAlt n1) (IfaceDataAlt n2) = n1==n2
893 eq_ifaceConAlt (IfaceTupleAlt c1) (IfaceTupleAlt c2) = c1==c2
894 eq_ifaceConAlt (IfaceLitAlt l1) (IfaceLitAlt l2) = l1==l2
895 eq_ifaceConAlt _ _ = False
898 eq_ifaceNote :: EqEnv -> IfaceNote -> IfaceNote -> IfaceEq
899 eq_ifaceNote env (IfaceSCC c1) (IfaceSCC c2) = bool (c1==c2)
900 eq_ifaceNote env (IfaceCoerce t1) (IfaceCoerce t2) = eq_ifType env t1 t2
901 eq_ifaceNote env IfaceInlineCall IfaceInlineCall = Equal
902 eq_ifaceNote env IfaceInlineMe IfaceInlineMe = Equal
903 eq_ifaceNote env (IfaceCoreNote s1) (IfaceCoreNote s2) = bool (s1==s2)
904 eq_ifaceNote env _ _ = NotEqual
908 ---------------------
909 eqIfType t1 t2 = eq_ifType emptyEqEnv t1 t2
912 eq_ifType env (IfaceTyVar n1) (IfaceTyVar n2) = eqIfOcc env n1 n2
913 eq_ifType env (IfaceAppTy s1 t1) (IfaceAppTy s2 t2) = eq_ifType env s1 s2 &&& eq_ifType env t1 t2
914 eq_ifType env (IfacePredTy st1) (IfacePredTy st2) = eq_ifPredType env st1 st2
915 eq_ifType env (IfaceTyConApp tc1 ts1) (IfaceTyConApp tc2 ts2) = tc1 `eqIfTc` tc2 &&& eq_ifTypes env ts1 ts2
916 eq_ifType env (IfaceForAllTy tv1 t1) (IfaceForAllTy tv2 t2) = eq_ifTvBndr env tv1 tv2 (\env -> eq_ifType env t1 t2)
917 eq_ifType env (IfaceFunTy s1 t1) (IfaceFunTy s2 t2) = eq_ifType env s1 s2 &&& eq_ifType env t1 t2
918 eq_ifType env _ _ = NotEqual
921 eq_ifTypes env = eqListBy (eq_ifType env)
924 eq_ifContext env a b = eqListBy (eq_ifPredType env) a b
927 eq_ifPredType env (IfaceClassP c1 tys1) (IfaceClassP c2 tys2) = c1 `eqIfExt` c2 &&& eq_ifTypes env tys1 tys2
928 eq_ifPredType env (IfaceIParam n1 ty1) (IfaceIParam n2 ty2) = bool (n1 == n2) &&& eq_ifType env ty1 ty2
929 eq_ifPredType env _ _ = NotEqual
932 eqIfTc (IfaceTc tc1) (IfaceTc tc2) = tc1 `eqIfExt` tc2
933 eqIfTc IfaceIntTc IfaceIntTc = Equal
934 eqIfTc IfaceCharTc IfaceCharTc = Equal
935 eqIfTc IfaceBoolTc IfaceBoolTc = Equal
936 eqIfTc IfaceListTc IfaceListTc = Equal
937 eqIfTc IfacePArrTc IfacePArrTc = Equal
938 eqIfTc (IfaceTupTc bx1 ar1) (IfaceTupTc bx2 ar2) = bool (bx1==bx2 && ar1==ar2)
939 eqIfTc _ _ = NotEqual
942 -----------------------------------------------------------
943 Support code for equality checking
944 -----------------------------------------------------------
947 ------------------------------------
948 type EqEnv = OccEnv OccName -- Tracks the mapping from L-variables to R-variables
950 eqIfOcc :: EqEnv -> OccName -> OccName -> IfaceEq
951 eqIfOcc env n1 n2 = case lookupOccEnv env n1 of
952 Just n1 -> bool (n1 == n2)
953 Nothing -> bool (n1 == n2)
955 extendEqEnv :: EqEnv -> OccName -> OccName -> EqEnv
956 extendEqEnv env n1 n2 | n1 == n2 = env
957 | otherwise = extendOccEnv env n1 n2
960 emptyEqEnv = emptyOccEnv
962 ------------------------------------
963 type ExtEnv bndr = EqEnv -> bndr -> bndr -> (EqEnv -> IfaceEq) -> IfaceEq
965 eq_ifNakedBndr :: ExtEnv OccName
966 eq_ifBndr :: ExtEnv IfaceBndr
967 eq_ifTvBndr :: ExtEnv IfaceTvBndr
968 eq_ifIdBndr :: ExtEnv IfaceIdBndr
970 eq_ifNakedBndr env n1 n2 k = k (extendEqEnv env n1 n2)
972 eq_ifBndr env (IfaceIdBndr b1) (IfaceIdBndr b2) k = eq_ifIdBndr env b1 b2 k
973 eq_ifBndr env (IfaceTvBndr b1) (IfaceTvBndr b2) k = eq_ifTvBndr env b1 b2 k
974 eq_ifBndr _ _ _ _ = NotEqual
976 eq_ifTvBndr env (v1, k1) (v2, k2) k = bool (k1 == k2) &&& k (extendEqEnv env v1 v2)
977 eq_ifIdBndr env (v1, t1) (v2, t2) k = eq_ifType env t1 t2 &&& k (extendEqEnv env v1 v2)
979 eq_ifBndrs :: ExtEnv [IfaceBndr]
980 eq_ifIdBndrs :: ExtEnv [IfaceIdBndr]
981 eq_ifTvBndrs :: ExtEnv [IfaceTvBndr]
982 eq_ifNakedBndrs :: ExtEnv [OccName]
983 eq_ifBndrs = eq_bndrs_with eq_ifBndr
984 eq_ifIdBndrs = eq_bndrs_with eq_ifIdBndr
985 eq_ifTvBndrs = eq_bndrs_with eq_ifTvBndr
986 eq_ifNakedBndrs = eq_bndrs_with eq_ifNakedBndr
988 eq_bndrs_with eq env [] [] k = k env
989 eq_bndrs_with eq env (b1:bs1) (b2:bs2) k = eq env b1 b2 (\env -> eq_bndrs_with eq env bs1 bs2 k)
990 eq_bndrs_with eq env _ _ _ = NotEqual
994 eqListBy :: (a->a->IfaceEq) -> [a] -> [a] -> IfaceEq
995 eqListBy eq [] [] = Equal
996 eqListBy eq (x:xs) (y:ys) = eq x y &&& eqListBy eq xs ys
997 eqListBy eq xs ys = NotEqual
999 eqMaybeBy :: (a->a->IfaceEq) -> Maybe a -> Maybe a -> IfaceEq
1000 eqMaybeBy eq Nothing Nothing = Equal
1001 eqMaybeBy eq (Just x) (Just y) = eq x y
1002 eqMaybeBy eq x y = NotEqual