compiler/iface/IfaceSyn.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4 %************************************************************************
   5 %*                                                                      *
   6 \section[HsCore]{Core-syntax unfoldings in Haskell interface files}
   7 %*                                                                      *
   8 %************************************************************************
   9
  10 We could either use this, or parameterise @GenCoreExpr@ on @Types@ and
  11 @TyVars@ as well.  Currently trying the former... MEGA SIGH.
  12
  13 \begin{code}
  14 module IfaceSyn (
  15         module IfaceType,               -- Re-export all this
  16
  17         IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
  18         IfaceExpr(..), IfaceAlt, IfaceNote(..),
  19         IfaceBinding(..), IfaceConAlt(..), IfaceIdInfo(..),
  20         IfaceInfoItem(..), IfaceRule(..), IfaceInst(..), IfaceFamInst(..),
  21
  22         -- Misc
  23         ifaceDeclSubBndrs, visibleIfConDecls,
  24
  25         -- Equality
  26         GenIfaceEq(..), IfaceEq, (&&&), bool, eqListBy, eqMaybeBy,
  27         eqIfDecl, eqIfInst, eqIfRule, checkBootDecl,
  28
  29         -- Pretty printing
  30         pprIfaceExpr, pprIfaceDeclHead
  31     ) where
  32
  33 #include "HsVersions.h"
  34
  35 import CoreSyn
  36 import IfaceType
  37
  38 import NewDemand        ( StrictSig, pprIfaceStrictSig )
  39 import Class            ( FunDep, DefMeth, pprFundeps )
  40 import OccName
  41 import UniqFM           ( UniqFM, emptyUFM, addToUFM, lookupUFM )
  42 import Unique           ( mkBuiltinUnique )
  43 import NameSet
  44 import Name             ( Name, NamedThing(..), isExternalName,
  45                           mkInternalName )
  46 import CostCentre       ( CostCentre, pprCostCentreCore )
  47 import Literal          ( Literal )
  48 import ForeignCall      ( ForeignCall )
  49 import SrcLoc           ( noSrcLoc )
  50 import BasicTypes
  51 import Outputable
  52 import FastString
  53 import Maybes           ( catMaybes )
  54
  55 import Data.List        ( nub )
  56 import Data.Maybe       ( isJust )
  57
  58 infixl 3 &&&
  59 infix  4 `eqIfExt`, `eqIfIdInfo`, `eqIfType`
  60 \end{code}
  61
  62
  63 %************************************************************************
  64 %*                                                                      *
  65                 Data type declarations
  66 %*                                                                      *
  67 %************************************************************************
  68
  69 \begin{code}
  70 data IfaceDecl
  71   = IfaceId { ifName   :: OccName,
  72               ifType   :: IfaceType,
  73               ifIdInfo :: IfaceIdInfo }
  74
  75   | IfaceData { ifName       :: OccName,        -- Type constructor
  76                 ifTyVars     :: [IfaceTvBndr],  -- Type variables
  77                 ifCtxt       :: IfaceContext,   -- The "stupid theta"
  78                 ifCons       :: IfaceConDecls,  -- Includes new/data info
  79                 ifRec        :: RecFlag,        -- Recursive or not?
  80                 ifGadtSyntax :: Bool,           -- True <=> declared using
  81                                                 -- GADT syntax
  82                 ifGeneric    :: Bool,           -- True <=> generic converter
  83                                                 --          functions available
  84                                                 -- We need this for imported
  85                                                 -- data decls, since the
  86                                                 -- imported modules may have
  87                                                 -- been compiled with
  88                                                 -- different flags to the
  89                                                 -- current compilation unit
  90                 ifFamInst    :: Maybe (IfaceTyCon, [IfaceType])
  91                                                 -- Just <=> instance of family
  92     }
  93
  94   | IfaceSyn  { ifName    :: OccName,           -- Type constructor
  95                 ifTyVars  :: [IfaceTvBndr],     -- Type variables
  96                 ifOpenSyn :: Bool,              -- Is an open family?
  97                 ifSynRhs  :: IfaceType          -- Type for an ordinary
  98                                                 -- synonym and kind for an
  99                                                 -- open family
 100     }
 101
 102   | IfaceClass { ifCtxt    :: IfaceContext,     -- Context...
 103                  ifName    :: OccName,          -- Name of the class
 104                  ifTyVars  :: [IfaceTvBndr],    -- Type variables
 105                  ifFDs     :: [FunDep FastString], -- Functional dependencies
 106                  ifATs     :: [IfaceDecl],      -- Associated type families
 107                  ifSigs    :: [IfaceClassOp],   -- Method signatures
 108                  ifRec     :: RecFlag           -- Is newtype/datatype associated with the class recursive?
 109     }
 110
 111   | IfaceForeign { ifName :: OccName,           -- Needs expanding when we move
 112                                                 -- beyond .NET
 113                    ifExtName :: Maybe FastString }
 114
 115 data IfaceClassOp = IfaceClassOp OccName DefMeth IfaceType
 116         -- Nothing    => no default method
 117         -- Just False => ordinary polymorphic default method
 118         -- Just True  => generic default method
 119
 120 data IfaceConDecls
 121   = IfAbstractTyCon             -- No info
 122   | IfOpenDataTyCon             -- Open data family
 123   | IfOpenNewTyCon              -- Open newtype family
 124   | IfDataTyCon [IfaceConDecl]  -- data type decls
 125   | IfNewTyCon  IfaceConDecl    -- newtype decls
 126
 127 visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
 128 visibleIfConDecls IfAbstractTyCon  = []
 129 visibleIfConDecls IfOpenDataTyCon  = []
 130 visibleIfConDecls IfOpenNewTyCon   = []
 131 visibleIfConDecls (IfDataTyCon cs) = cs
 132 visibleIfConDecls (IfNewTyCon c)   = [c]
 133
 134 data IfaceConDecl
 135   = IfCon {
 136         ifConOcc     :: OccName,                -- Constructor name
 137         ifConInfix   :: Bool,                   -- True <=> declared infix
 138         ifConUnivTvs :: [IfaceTvBndr],          -- Universal tyvars
 139         ifConExTvs   :: [IfaceTvBndr],          -- Existential tyvars
 140         ifConEqSpec  :: [(OccName,IfaceType)],  -- Equality contraints
 141         ifConCtxt    :: IfaceContext,           -- Non-stupid context
 142         ifConArgTys  :: [IfaceType],            -- Arg types
 143         ifConFields  :: [OccName],              -- ...ditto... (field labels)
 144         ifConStricts :: [StrictnessMark]}       -- Empty (meaning all lazy),
 145                                                 -- or 1-1 corresp with arg tys
 146
 147 data IfaceInst
 148   = IfaceInst { ifInstCls  :: Name,                     -- See comments with
 149                 ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of Instance
 150                 ifDFun     :: Name,                     -- The dfun
 151                 ifOFlag    :: OverlapFlag,              -- Overlap flag
 152                 ifInstOrph :: Maybe OccName }           -- See is_orph in defn of Instance
 153         -- There's always a separate IfaceDecl for the DFun, which gives
 154         -- its IdInfo with its full type and version number.
 155         -- The instance declarations taken together have a version number,
 156         -- and we don't want that to wobble gratuitously
 157         -- If this instance decl is *used*, we'll record a usage on the dfun;
 158         -- and if the head does not change it won't be used if it wasn't before
 159
 160 data IfaceFamInst
 161   = IfaceFamInst { ifFamInstFam   :: Name                -- Family tycon
 162                  , ifFamInstTys   :: [Maybe IfaceTyCon]  -- Rough match types
 163                  , ifFamInstTyCon :: IfaceTyCon          -- Instance decl
 164                  }
 165
 166 data IfaceRule
 167   = IfaceRule {
 168         ifRuleName   :: RuleName,
 169         ifActivation :: Activation,
 170         ifRuleBndrs  :: [IfaceBndr],    -- Tyvars and term vars
 171         ifRuleHead   :: Name,           -- Head of lhs
 172         ifRuleArgs   :: [IfaceExpr],    -- Args of LHS
 173         ifRuleRhs    :: IfaceExpr,
 174         ifRuleOrph   :: Maybe OccName   -- Just like IfaceInst
 175     }
 176
 177 data IfaceIdInfo
 178   = NoInfo                      -- When writing interface file without -O
 179   | HasInfo [IfaceInfoItem]     -- Has info, and here it is
 180
 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.
 190
 191 data IfaceInfoItem
 192   = HsArity      Arity
 193   | HsStrictness StrictSig
 194   | HsInline     Activation
 195   | HsUnfold     IfaceExpr
 196   | HsNoCafRefs
 197   | HsWorker     Name Arity     -- Worker, if any see IdInfo.WorkerInfo
 198                                         -- for why we want arity here.
 199         -- NB: we need IfaceExtName (not just OccName) because the worker
 200         --     can simplify to a function in another module.
 201 -- NB: Specialisations and rules come in separately and are
 202 -- only later attached to the Id.  Partial reason: some are orphans.
 203
 204 --------------------------------
 205 data IfaceExpr
 206   = IfaceLcl    FastString
 207   | IfaceExt    Name
 208   | IfaceType   IfaceType
 209   | IfaceTuple  Boxity [IfaceExpr]              -- Saturated; type arguments omitted
 210   | IfaceLam    IfaceBndr IfaceExpr
 211   | IfaceApp    IfaceExpr IfaceExpr
 212   | IfaceCase   IfaceExpr FastString IfaceType [IfaceAlt]
 213   | IfaceLet    IfaceBinding  IfaceExpr
 214   | IfaceNote   IfaceNote IfaceExpr
 215   | IfaceCast   IfaceExpr IfaceCoercion
 216   | IfaceLit    Literal
 217   | IfaceFCall  ForeignCall IfaceType
 218
 219 data IfaceNote = IfaceSCC CostCentre
 220                | IfaceInlineMe
 221                | IfaceCoreNote String
 222
 223 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
 224         -- Note: FastString, 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
 227
 228 data IfaceConAlt = IfaceDefault
 229                  | IfaceDataAlt Name
 230                  | IfaceTupleAlt Boxity
 231                  | IfaceLitAlt Literal
 232
 233 data IfaceBinding
 234   = IfaceNonRec IfaceIdBndr IfaceExpr
 235   | IfaceRec    [(IfaceIdBndr, IfaceExpr)]
 236
 237 -- -----------------------------------------------------------------------------
 238 -- Utils on IfaceSyn
 239
 240 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
 241 --  *Excludes* the 'main' name, but *includes* the implicitly-bound names
 242 -- Deeply revolting, because it has to predict what gets bound,
 243 -- especially the question of whether there's a wrapper for a datacon
 244
 245 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ,
 246                                ifSigs = sigs, ifATs = ats })
 247   = co_occs ++
 248     [tc_occ, dc_occ, dcww_occ] ++
 249     [op | IfaceClassOp op  _ _ <- sigs] ++
 250     [ifName at | at <- ats ] ++
 251     [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]]
 252   where
 253     n_ctxt = length sc_ctxt
 254     n_sigs = length sigs
 255     tc_occ  = mkClassTyConOcc cls_occ
 256     dc_occ  = mkClassDataConOcc cls_occ
 257     co_occs | is_newtype = [mkNewTyCoOcc tc_occ]
 258             | otherwise  = []
 259     dcww_occ -- | is_newtype = mkDataConWrapperOcc dc_occ       -- Newtypes have wrapper but no worker
 260              | otherwise  = mkDataConWorkerOcc dc_occ   -- Otherwise worker but no wrapper
 261     is_newtype = n_sigs + n_ctxt == 1                   -- Sigh
 262
 263 ifaceDeclSubBndrs IfaceData {ifCons = IfAbstractTyCon}
 264   = []
 265 -- Newtype
 266 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
 267                               ifCons = IfNewTyCon (
 268                                          IfCon { ifConOcc = con_occ,
 269                                                            ifConFields = fields
 270                                                          }),
 271                               ifFamInst = famInst})
 272   = fields ++ [con_occ, mkDataConWorkerOcc con_occ, mkNewTyCoOcc tc_occ]
 273     ++ famInstCo famInst tc_occ
 274
 275 ifaceDeclSubBndrs (IfaceData {ifName = tc_occ,
 276                               ifCons = IfDataTyCon cons,
 277                               ifFamInst = famInst})
 278   = nub (concatMap ifConFields cons)    -- Eliminate duplicate fields
 279     ++ concatMap dc_occs cons
 280     ++ famInstCo famInst tc_occ
 281   where
 282     dc_occs con_decl
 283         | has_wrapper = [con_occ, work_occ, wrap_occ]
 284         | otherwise   = [con_occ, work_occ]
 285         where
 286           con_occ = ifConOcc con_decl
 287           strs    = ifConStricts con_decl
 288           wrap_occ = mkDataConWrapperOcc con_occ
 289           work_occ = mkDataConWorkerOcc con_occ
 290           has_wrapper = any isMarkedStrict strs -- See MkId.mkDataConIds (sigh)
 291                         || not (null . ifConEqSpec $ con_decl)
 292                         || isJust famInst
 293                 -- ToDo: may miss strictness in existential dicts
 294
 295 ifaceDeclSubBndrs _other = []
 296
 297 -- coercion for data/newtype family instances
 298 famInstCo Nothing  baseOcc = []
 299 famInstCo (Just _) baseOcc = [mkInstTyCoOcc baseOcc]
 300
 301 ----------------------------- Printing IfaceDecl ------------------------------
 302
 303 instance Outputable IfaceDecl where
 304   ppr = pprIfaceDecl
 305
 306 pprIfaceDecl (IfaceId {ifName = var, ifType = ty, ifIdInfo = info})
 307   = sep [ ppr var <+> dcolon <+> ppr ty,
 308           nest 2 (ppr info) ]
 309
 310 pprIfaceDecl (IfaceForeign {ifName = tycon})
 311   = hsep [ptext SLIT("foreign import type dotnet"), ppr tycon]
 312
 313 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
 314                         ifOpenSyn = False, ifSynRhs = mono_ty})
 315   = hang (ptext SLIT("type") <+> pprIfaceDeclHead [] tycon tyvars)
 316        4 (equals <+> ppr mono_ty)
 317
 318 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
 319                         ifOpenSyn = True, ifSynRhs = mono_ty})
 320   = hang (ptext SLIT("type family") <+> pprIfaceDeclHead [] tycon tyvars)
 321        4 (dcolon <+> ppr mono_ty)
 322
 323 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
 324                          ifTyVars = tyvars, ifCons = condecls,
 325                          ifRec = isrec, ifFamInst = mbFamInst})
 326   = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
 327        4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
 328                 pprFamily mbFamInst])
 329   where
 330     pp_nd = case condecls of
 331                 IfAbstractTyCon -> ptext SLIT("data")
 332                 IfOpenDataTyCon -> ptext SLIT("data family")
 333                 IfDataTyCon _   -> ptext SLIT("data")
 334                 IfNewTyCon _    -> ptext SLIT("newtype")
 335                 IfOpenNewTyCon  -> ptext SLIT("newtype family")
 336
 337 pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
 338                           ifFDs = fds, ifATs = ats, ifSigs = sigs,
 339                           ifRec = isrec})
 340   = hang (ptext SLIT("class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
 341        4 (vcat [pprRec isrec,
 342                 sep (map ppr ats),
 343                 sep (map ppr sigs)])
 344
 345 pprRec isrec = ptext SLIT("RecFlag") <+> ppr isrec
 346 pprGen True  = ptext SLIT("Generics: yes")
 347 pprGen False = ptext SLIT("Generics: no")
 348
 349 pprFamily Nothing        = ptext SLIT("FamilyInstance: none")
 350 pprFamily (Just famInst) = ptext SLIT("FamilyInstance:") <+> ppr famInst
 351
 352 instance Outputable IfaceClassOp where
 353    ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
 354
 355 pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
 356 pprIfaceDeclHead context thing tyvars
 357   = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing),
 358           pprIfaceTvBndrs tyvars]
 359
 360 pp_condecls tc IfAbstractTyCon  = ptext SLIT("{- abstract -}")
 361 pp_condecls tc IfOpenNewTyCon   = empty
 362 pp_condecls tc (IfNewTyCon c)   = equals <+> pprIfaceConDecl tc c
 363 pp_condecls tc IfOpenDataTyCon  = empty
 364 pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext SLIT(" |"))
 365                                                              (map (pprIfaceConDecl tc) cs))
 366
 367 pprIfaceConDecl tc
 368         (IfCon { ifConOcc = name, ifConInfix = is_infix,
 369                  ifConUnivTvs = univ_tvs, ifConExTvs = ex_tvs,
 370                  ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
 371                  ifConStricts = strs, ifConFields = fields })
 372   = sep [main_payload,
 373          if is_infix then ptext SLIT("Infix") else empty,
 374          if null strs then empty
 375               else nest 4 (ptext SLIT("Stricts:") <+> hsep (map ppr strs)),
 376          if null fields then empty
 377               else nest 4 (ptext SLIT("Fields:") <+> hsep (map ppr fields))]
 378   where
 379     main_payload = ppr name <+> dcolon <+>
 380                    pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) (ppr con_tau)
 381
 382     eq_ctxt = [(IfaceEqPred (IfaceTyVar (occNameFS tv)) ty)
 383               | (tv,ty) <- eq_spec]
 384     con_tau = foldr1 IfaceFunTy (arg_tys ++ [tc_app])
 385     tc_app  = IfaceTyConApp (IfaceTc tc_name)
 386                             [IfaceTyVar tv | (tv,_) <- univ_tvs]
 387     tc_name = mkInternalName (mkBuiltinUnique 1) tc noSrcLoc
 388         -- Really Gruesome, but just for debug print
 389
 390 instance Outputable IfaceRule where
 391   ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
 392                    ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
 393     = sep [hsep [doubleQuotes (ftext name), ppr act,
 394                  ptext SLIT("forall") <+> pprIfaceBndrs bndrs],
 395            nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
 396                         ptext SLIT("=") <+> ppr rhs])
 397       ]
 398
 399 instance Outputable IfaceInst where
 400   ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag,
 401                   ifInstCls = cls, ifInstTys = mb_tcs})
 402     = hang (ptext SLIT("instance") <+> ppr flag
 403                 <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
 404          2 (equals <+> ppr dfun_id)
 405
 406 instance Outputable IfaceFamInst where
 407   ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
 408                      ifFamInstTyCon = tycon_id})
 409     = hang (ptext SLIT("family instance") <+>
 410             ppr fam <+> brackets (pprWithCommas ppr_rough mb_tcs))
 411          2 (equals <+> ppr tycon_id)
 412
 413 ppr_rough :: Maybe IfaceTyCon -> SDoc
 414 ppr_rough Nothing   = dot
 415 ppr_rough (Just tc) = ppr tc
 416 \end{code}
 417
 418
 419 ----------------------------- Printing IfaceExpr ------------------------------------
 420
 421 \begin{code}
 422 instance Outputable IfaceExpr where
 423     ppr e = pprIfaceExpr noParens e
 424
 425 pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
 426         -- The function adds parens in context that need
 427         -- an atomic value (e.g. function args)
 428
 429 pprIfaceExpr add_par (IfaceLcl v)       = ppr v
 430 pprIfaceExpr add_par (IfaceExt v)       = ppr v
 431 pprIfaceExpr add_par (IfaceLit l)       = ppr l
 432 pprIfaceExpr add_par (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
 433 pprIfaceExpr add_par (IfaceType ty)     = char '@' <+> pprParendIfaceType ty
 434
 435 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
 436 pprIfaceExpr add_par (IfaceTuple c as)  = tupleParens c (interpp'SP as)
 437
 438 pprIfaceExpr add_par e@(IfaceLam _ _)
 439   = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
 440                   pprIfaceExpr noParens body])
 441   where
 442     (bndrs,body) = collect [] e
 443     collect bs (IfaceLam b e) = collect (b:bs) e
 444     collect bs e              = (reverse bs, e)
 445
 446 pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
 447   = add_par (sep [ptext SLIT("case") <+> char '@' <+> pprParendIfaceType ty
 448                         <+> pprIfaceExpr noParens scrut <+> ptext SLIT("of")
 449                         <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
 450                   pprIfaceExpr noParens rhs <+> char '}'])
 451
 452 pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
 453   = add_par (sep [ptext SLIT("case") <+> char '@' <+> pprParendIfaceType ty
 454                         <+> pprIfaceExpr noParens scrut <+> ptext SLIT("of")
 455                         <+> ppr bndr <+> char '{',
 456                   nest 2 (sep (map ppr_alt alts)) <+> char '}'])
 457
 458 pprIfaceExpr add_par (IfaceCast expr co)
 459   = sep [pprIfaceExpr parens expr,
 460          nest 2 (ptext SLIT("`cast`")),
 461          pprParendIfaceType co]
 462
 463 pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
 464   = add_par (sep [ptext SLIT("let {"),
 465                   nest 2 (ppr_bind (b, rhs)),
 466                   ptext SLIT("} in"),
 467                   pprIfaceExpr noParens body])
 468
 469 pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
 470   = add_par (sep [ptext SLIT("letrec {"),
 471                   nest 2 (sep (map ppr_bind pairs)),
 472                   ptext SLIT("} in"),
 473                   pprIfaceExpr noParens body])
 474
 475 pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
 476
 477 ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
 478                               arrow <+> pprIfaceExpr noParens rhs]
 479
 480 ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
 481 ppr_con_bs con bs                     = ppr con <+> hsep (map ppr bs)
 482
 483 ppr_bind ((b,ty),rhs) = sep [ppr b <+> dcolon <+> ppr ty,
 484                              equals <+> pprIfaceExpr noParens rhs]
 485
 486 ------------------
 487 pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args)
 488 pprIfaceApp fun                args = sep (pprIfaceExpr parens fun : args)
 489
 490 ------------------
 491 instance Outputable IfaceNote where
 492     ppr (IfaceSCC cc)     = pprCostCentreCore cc
 493     ppr IfaceInlineMe     = ptext SLIT("__inline_me")
 494     ppr (IfaceCoreNote s) = ptext SLIT("__core_note") <+> pprHsString (mkFastString s)
 495
 496 instance Outputable IfaceConAlt where
 497     ppr IfaceDefault      = text "DEFAULT"
 498     ppr (IfaceLitAlt l)   = ppr l
 499     ppr (IfaceDataAlt d)  = ppr d
 500     ppr (IfaceTupleAlt b) = panic "ppr IfaceConAlt"
 501         -- IfaceTupleAlt is handled by the case-alternative printer
 502
 503 ------------------
 504 instance Outputable IfaceIdInfo where
 505    ppr NoInfo       = empty
 506    ppr (HasInfo is) = ptext SLIT("{-") <+> fsep (map ppr_hs_info is) <+> ptext SLIT("-}")
 507
 508 ppr_hs_info (HsUnfold unf)      = ptext SLIT("Unfolding:") <+>
 509                                         parens (pprIfaceExpr noParens unf)
 510 ppr_hs_info (HsInline act)      = ptext SLIT("Inline:") <+> ppr act
 511 ppr_hs_info (HsArity arity)     = ptext SLIT("Arity:") <+> int arity
 512 ppr_hs_info (HsStrictness str)  = ptext SLIT("Strictness:") <+> pprIfaceStrictSig str
 513 ppr_hs_info HsNoCafRefs         = ptext SLIT("HasNoCafRefs")
 514 ppr_hs_info (HsWorker w a)      = ptext SLIT("Worker:") <+> ppr w <+> int a
 515 \end{code}
 516
 517
 518 %************************************************************************
 519 %*                                                                      *
 520         Equality, for interface file version generaion only
 521 %*                                                                      *
 522 %************************************************************************
 523
 524 Equality over IfaceSyn returns an IfaceEq, not a Bool.  The new
 525 constructor is EqBut, which gives the set of things whose version must
 526 be equal for the whole thing to be equal.  So the key function is
 527 eqIfExt, which compares Names.
 528
 529 Of course, equality is also done modulo alpha conversion.
 530
 531 \begin{code}
 532 data GenIfaceEq a
 533   = Equal               -- Definitely exactly the same
 534   | NotEqual            -- Definitely different
 535   | EqBut a       -- The same provided these Names have not changed
 536
 537 type IfaceEq = GenIfaceEq NameSet
 538
 539 instance Outputable IfaceEq where
 540   ppr Equal          = ptext SLIT("Equal")
 541   ppr NotEqual       = ptext SLIT("NotEqual")
 542   ppr (EqBut occset) = ptext SLIT("EqBut") <+> ppr (nameSetToList occset)
 543
 544 bool :: Bool -> IfaceEq
 545 bool True  = Equal
 546 bool False = NotEqual
 547
 548 toBool :: IfaceEq -> Bool
 549 toBool Equal     = True
 550 toBool (EqBut _) = True
 551 toBool NotEqual  = False
 552
 553 zapEq :: IfaceEq -> IfaceEq     -- Used to forget EqBut information
 554 zapEq (EqBut _) = Equal
 555 zapEq other     = other
 556
 557 (&&&) :: IfaceEq -> IfaceEq -> IfaceEq
 558 Equal       &&& x           = x
 559 NotEqual    &&& x           = NotEqual
 560 EqBut nms   &&& Equal       = EqBut nms
 561 EqBut nms   &&& NotEqual    = NotEqual
 562 EqBut nms1  &&& EqBut nms2  = EqBut (nms1 `unionNameSets` nms2)
 563
 564 -- This function is the core of the EqBut stuff
 565 -- ASSUMPTION: The left-hand argument is the NEW CODE, and hence
 566 -- any Names in the left-hand arg have the correct parent in them.
 567 eqIfExt :: Name -> Name -> IfaceEq
 568 eqIfExt name1 name2
 569   | name1 == name2 = EqBut (unitNameSet name1)
 570   | otherwise      = NotEqual
 571
 572 ---------------------
 573 checkBootDecl :: IfaceDecl      -- The boot decl
 574               -> IfaceDecl      -- The real decl
 575               -> Bool           -- True <=> compatible
 576 checkBootDecl (IfaceId s1 t1 _) (IfaceId s2 t2 _)
 577   = ASSERT( s1==s2 ) toBool (t1 `eqIfType` t2)
 578
 579 checkBootDecl d1@(IfaceForeign {}) d2@(IfaceForeign {})
 580   = ASSERT (ifName d1 == ifName d2 ) ifExtName d1 == ifExtName d2
 581
 582 checkBootDecl d1@(IfaceSyn {}) d2@(IfaceSyn {})
 583   = ASSERT( ifName d1 == ifName d2 )
 584     toBool $ eqWith (ifTyVars d1) (ifTyVars d2) $ \ env ->
 585           eq_ifType env (ifSynRhs d1) (ifSynRhs d2)
 586
 587 checkBootDecl d1@(IfaceData {}) d2@(IfaceData {})
 588 -- We don't check the recursion flags because the boot-one is
 589 -- recursive, to be conservative, but the real one may not be.
 590 -- I'm not happy with the way recursive flags are dealt with.
 591   = ASSERT( ifName d1    == ifName d2 )
 592     toBool $ eqWith (ifTyVars d1) (ifTyVars d2) $ \ env ->
 593         eq_ifContext env (ifCtxt d1) (ifCtxt d2) &&&
 594         case ifCons d1 of
 595             IfAbstractTyCon -> Equal
 596             cons1           -> eq_hsCD env cons1 (ifCons d2)
 597
 598 checkBootDecl d1@(IfaceClass {}) d2@(IfaceClass {})
 599   = ASSERT( ifName d1 == ifName d2 )
 600     toBool $ eqWith (ifTyVars d1) (ifTyVars d2) $ \ env ->
 601           eqListBy (eq_hsFD env)    (ifFDs d1)  (ifFDs d2) &&&
 602           case (ifCtxt d1, ifSigs d1) of
 603              ([], [])      -> Equal
 604              (cxt1, sigs1) -> eq_ifContext env cxt1 (ifCtxt d2)  &&&
 605                               eqListBy (eq_cls_sig env) sigs1 (ifSigs d2)
 606
 607 checkBootDecl _ _ = False       -- default case
 608
 609 ---------------------
 610 eqIfDecl :: IfaceDecl -> IfaceDecl -> IfaceEq
 611 eqIfDecl (IfaceId s1 t1 i1) (IfaceId s2 t2 i2)
 612   = bool (s1 == s2) &&& (t1 `eqIfType` t2) &&& (i1 `eqIfIdInfo` i2)
 613
 614 eqIfDecl d1@(IfaceForeign {}) d2@(IfaceForeign {})
 615   = bool (ifName d1 == ifName d2 && ifExtName d1 == ifExtName d2)
 616
 617 eqIfDecl d1@(IfaceData {}) d2@(IfaceData {})
 618   = bool (ifName d1    == ifName d2 &&
 619           ifRec d1     == ifRec   d2 &&
 620           ifGadtSyntax d1 == ifGadtSyntax   d2 &&
 621           ifGeneric d1 == ifGeneric d2) &&&
 622     ifFamInst d1 `eqIfTc_fam` ifFamInst d2 &&&
 623     eqWith (ifTyVars d1) (ifTyVars d2) (\ env ->
 624             eq_ifContext env (ifCtxt d1) (ifCtxt d2) &&&
 625             eq_hsCD env (ifCons d1) (ifCons d2)
 626         )
 627         -- The type variables of the data type do not scope
 628         -- over the constructors (any more), but they do scope
 629         -- over the stupid context in the IfaceConDecls
 630   where
 631     Nothing             `eqIfTc_fam` Nothing             = Equal
 632     (Just (fam1, tys1)) `eqIfTc_fam` (Just (fam2, tys2)) =
 633       fam1 `eqIfTc` fam2 &&& eqListBy eqIfType tys1 tys2
 634     _                   `eqIfTc_fam` _                   = NotEqual
 635
 636 eqIfDecl d1@(IfaceSyn {}) d2@(IfaceSyn {})
 637   = bool (ifName d1 == ifName d2) &&&
 638     eqWith (ifTyVars d1) (ifTyVars d2) (\ env ->
 639           eq_ifType env (ifSynRhs d1) (ifSynRhs d2)
 640         )
 641
 642 eqIfDecl d1@(IfaceClass {}) d2@(IfaceClass {})
 643   = bool (ifName d1 == ifName d2 &&
 644           ifRec d1  == ifRec  d2) &&&
 645     eqWith (ifTyVars d1) (ifTyVars d2) (\ env ->
 646           eq_ifContext env (ifCtxt d1) (ifCtxt d2)  &&&
 647           eqListBy (eq_hsFD env)    (ifFDs d1)  (ifFDs d2) &&&
 648           eqListBy eqIfDecl         (ifATs d1)  (ifATs d2) &&&
 649           eqListBy (eq_cls_sig env) (ifSigs d1) (ifSigs d2)
 650        )
 651
 652 eqIfDecl _ _ = NotEqual -- default case
 653
 654 -- Helper
 655 eqWith :: [IfaceTvBndr] -> [IfaceTvBndr] -> (EqEnv -> IfaceEq) -> IfaceEq
 656 eqWith = eq_ifTvBndrs emptyEqEnv
 657
 658 -----------------------
 659 eqIfInst d1 d2 = bool (ifDFun d1 == ifDFun d2 && ifOFlag d1 == ifOFlag d2)
 660 -- All other changes are handled via the version info on the dfun
 661
 662 eqIfRule (IfaceRule n1 a1 bs1 f1 es1 rhs1 o1)
 663          (IfaceRule n2 a2 bs2 f2 es2 rhs2 o2)
 664        = bool (n1==n2 && a1==a2 && o1 == o2) &&&
 665          f1 `eqIfExt` f2 &&&
 666          eq_ifBndrs emptyEqEnv bs1 bs2 (\env ->
 667          zapEq (eqListBy (eq_ifaceExpr env) es1 es2) &&&
 668                 -- zapEq: for the LHSs, ignore the EqBut part
 669          eq_ifaceExpr env rhs1 rhs2)
 670
 671 eq_hsCD env (IfDataTyCon c1) (IfDataTyCon c2)
 672   = eqListBy (eq_ConDecl env) c1 c2
 673
 674 eq_hsCD env (IfNewTyCon c1)  (IfNewTyCon c2)  = eq_ConDecl env c1 c2
 675 eq_hsCD env IfAbstractTyCon  IfAbstractTyCon  = Equal
 676 eq_hsCD env IfOpenDataTyCon  IfOpenDataTyCon  = Equal
 677 eq_hsCD env IfOpenNewTyCon   IfOpenNewTyCon   = Equal
 678 eq_hsCD env d1               d2               = NotEqual
 679
 680 eq_ConDecl env c1 c2
 681   = bool (ifConOcc c1     == ifConOcc c2 &&
 682           ifConInfix c1   == ifConInfix c2 &&
 683           ifConStricts c1 == ifConStricts c2 &&
 684           ifConFields c1  == ifConFields c2) &&&
 685     eq_ifTvBndrs env (ifConUnivTvs c1) (ifConUnivTvs c2) (\ env ->
 686     eq_ifTvBndrs env (ifConExTvs c1) (ifConExTvs c2) (\ env ->
 687         eq_ifContext env (ifConCtxt c1) (ifConCtxt c2) &&&
 688         eq_ifTypes env (ifConArgTys c1) (ifConArgTys c2)))
 689
 690 eq_hsFD env (ns1,ms1) (ns2,ms2)
 691   = eqListBy (eqIfOcc env) ns1 ns2 &&& eqListBy (eqIfOcc env) ms1 ms2
 692
 693 eq_cls_sig env (IfaceClassOp n1 dm1 ty1) (IfaceClassOp n2 dm2 ty2)
 694   = bool (n1==n2 && dm1 == dm2) &&& eq_ifType env ty1 ty2
 695 \end{code}
 696
 697
 698 \begin{code}
 699 -----------------
 700 eqIfIdInfo NoInfo        NoInfo        = Equal
 701 eqIfIdInfo (HasInfo is1) (HasInfo is2) = eqListBy eq_item is1 is2
 702 eqIfIdInfo i1            i2 = NotEqual
 703
 704 eq_item (HsInline a1)      (HsInline a2)      = bool (a1 == a2)
 705 eq_item (HsArity a1)       (HsArity a2)       = bool (a1 == a2)
 706 eq_item (HsStrictness s1)  (HsStrictness s2)  = bool (s1 == s2)
 707 eq_item (HsUnfold u1)   (HsUnfold u2)         = eq_ifaceExpr emptyEqEnv u1 u2
 708 eq_item HsNoCafRefs        HsNoCafRefs        = Equal
 709 eq_item (HsWorker wkr1 a1) (HsWorker wkr2 a2) = bool (a1==a2) &&& (wkr1 `eqIfExt` wkr2)
 710 eq_item _ _ = NotEqual
 711
 712 -----------------
 713 eq_ifaceExpr :: EqEnv -> IfaceExpr -> IfaceExpr -> IfaceEq
 714 eq_ifaceExpr env (IfaceLcl v1)        (IfaceLcl v2)        = eqIfOcc env v1 v2
 715 eq_ifaceExpr env (IfaceExt v1)        (IfaceExt v2)        = eqIfExt v1 v2
 716 eq_ifaceExpr env (IfaceLit l1)        (IfaceLit l2)        = bool (l1 == l2)
 717 eq_ifaceExpr env (IfaceFCall c1 ty1)  (IfaceFCall c2 ty2)  = bool (c1==c2) &&& eq_ifType env ty1 ty2
 718 eq_ifaceExpr env (IfaceType ty1)      (IfaceType ty2)      = eq_ifType env ty1 ty2
 719 eq_ifaceExpr env (IfaceTuple n1 as1)  (IfaceTuple n2 as2)  = bool (n1==n2) &&& eqListBy (eq_ifaceExpr env) as1 as2
 720 eq_ifaceExpr env (IfaceLam b1 body1)  (IfaceLam b2 body2)  = eq_ifBndr env b1 b2 (\env -> eq_ifaceExpr env body1 body2)
 721 eq_ifaceExpr env (IfaceApp f1 a1)     (IfaceApp f2 a2)     = eq_ifaceExpr env f1 f2 &&& eq_ifaceExpr env a1 a2
 722 eq_ifaceExpr env (IfaceCast e1 co1)   (IfaceCast e2 co2)   = eq_ifaceExpr env e1 e2 &&& eq_ifType env co1 co2
 723 eq_ifaceExpr env (IfaceNote n1 r1)    (IfaceNote n2 r2)    = eq_ifaceNote env n1 n2 &&& eq_ifaceExpr env r1 r2
 724
 725 eq_ifaceExpr env (IfaceCase s1 b1 ty1 as1) (IfaceCase s2 b2 ty2 as2)
 726   = eq_ifaceExpr env s1 s2 &&&
 727     eq_ifType env ty1 ty2 &&&
 728     eq_ifNakedBndr env b1 b2 (\env -> eqListBy (eq_ifaceAlt env) as1 as2)
 729   where
 730     eq_ifaceAlt env (c1,bs1,r1) (c2,bs2,r2)
 731         = bool (eq_ifaceConAlt c1 c2) &&&
 732           eq_ifNakedBndrs env bs1 bs2 (\env -> eq_ifaceExpr env r1 r2)
 733
 734 eq_ifaceExpr env (IfaceLet (IfaceNonRec b1 r1) x1) (IfaceLet (IfaceNonRec b2 r2) x2)
 735   = eq_ifaceExpr env r1 r2 &&& eq_ifIdBndr env b1 b2 (\env -> eq_ifaceExpr env x1 x2)
 736
 737 eq_ifaceExpr env (IfaceLet (IfaceRec as1) x1) (IfaceLet (IfaceRec as2) x2)
 738   = eq_ifIdBndrs env bs1 bs2 (\env -> eqListBy (eq_ifaceExpr env) rs1 rs2 &&& eq_ifaceExpr env x1 x2)
 739   where
 740     (bs1,rs1) = unzip as1
 741     (bs2,rs2) = unzip as2
 742
 743
 744 eq_ifaceExpr env _ _ = NotEqual
 745
 746 -----------------
 747 eq_ifaceConAlt :: IfaceConAlt -> IfaceConAlt -> Bool
 748 eq_ifaceConAlt IfaceDefault       IfaceDefault          = True
 749 eq_ifaceConAlt (IfaceDataAlt n1)  (IfaceDataAlt n2)     = n1==n2
 750 eq_ifaceConAlt (IfaceTupleAlt c1) (IfaceTupleAlt c2)    = c1==c2
 751 eq_ifaceConAlt (IfaceLitAlt l1)   (IfaceLitAlt l2)      = l1==l2
 752 eq_ifaceConAlt _ _ = False
 753
 754 -----------------
 755 eq_ifaceNote :: EqEnv -> IfaceNote -> IfaceNote -> IfaceEq
 756 eq_ifaceNote env (IfaceSCC c1)    (IfaceSCC c2)        = bool (c1==c2)
 757 eq_ifaceNote env IfaceInlineMe    IfaceInlineMe        = Equal
 758 eq_ifaceNote env (IfaceCoreNote s1) (IfaceCoreNote s2) = bool (s1==s2)
 759 eq_ifaceNote env _ _ = NotEqual
 760 \end{code}
 761
 762 \begin{code}
 763 ---------------------
 764 eqIfType t1 t2 = eq_ifType emptyEqEnv t1 t2
 765
 766 -------------------
 767 eq_ifType env (IfaceTyVar n1)         (IfaceTyVar n2)         = eqIfOcc env n1 n2
 768 eq_ifType env (IfaceAppTy s1 t1)      (IfaceAppTy s2 t2)      = eq_ifType env s1 s2 &&& eq_ifType env t1 t2
 769 eq_ifType env (IfacePredTy st1)       (IfacePredTy st2)       = eq_ifPredType env st1 st2
 770 eq_ifType env (IfaceTyConApp tc1 ts1) (IfaceTyConApp tc2 ts2) = tc1 `eqIfTc` tc2 &&& eq_ifTypes env ts1 ts2
 771 eq_ifType env (IfaceForAllTy tv1 t1)  (IfaceForAllTy tv2 t2)  = eq_ifTvBndr env tv1 tv2 (\env -> eq_ifType env t1 t2)
 772 eq_ifType env (IfaceFunTy s1 t1)      (IfaceFunTy s2 t2)      = eq_ifType env s1 s2 &&& eq_ifType env t1 t2
 773 eq_ifType env _ _ = NotEqual
 774
 775 -------------------
 776 eq_ifTypes env = eqListBy (eq_ifType env)
 777
 778 -------------------
 779 eq_ifContext env a b = eqListBy (eq_ifPredType env) a b
 780
 781 -------------------
 782 eq_ifPredType env (IfaceClassP c1 tys1) (IfaceClassP c2 tys2) = c1 `eqIfExt` c2 &&&  eq_ifTypes env tys1 tys2
 783 eq_ifPredType env (IfaceIParam n1 ty1) (IfaceIParam n2 ty2)   = bool (n1 == n2) &&& eq_ifType env ty1 ty2
 784 eq_ifPredType env _ _ = NotEqual
 785
 786 -------------------
 787 eqIfTc (IfaceTc tc1) (IfaceTc tc2) = tc1 `eqIfExt` tc2
 788 eqIfTc IfaceIntTc    IfaceIntTc    = Equal
 789 eqIfTc IfaceCharTc   IfaceCharTc   = Equal
 790 eqIfTc IfaceBoolTc   IfaceBoolTc   = Equal
 791 eqIfTc IfaceListTc   IfaceListTc   = Equal
 792 eqIfTc IfacePArrTc   IfacePArrTc   = Equal
 793 eqIfTc (IfaceTupTc bx1 ar1) (IfaceTupTc bx2 ar2) = bool (bx1==bx2 && ar1==ar2)
 794 eqIfTc IfaceLiftedTypeKindTc   IfaceLiftedTypeKindTc   = Equal
 795 eqIfTc IfaceOpenTypeKindTc     IfaceOpenTypeKindTc     = Equal
 796 eqIfTc IfaceUnliftedTypeKindTc IfaceUnliftedTypeKindTc = Equal
 797 eqIfTc IfaceUbxTupleKindTc     IfaceUbxTupleKindTc     = Equal
 798 eqIfTc IfaceArgTypeKindTc      IfaceArgTypeKindTc      = Equal
 799 eqIfTc _                       _                       = NotEqual
 800 \end{code}
 801
 802 -----------------------------------------------------------
 803         Support code for equality checking
 804 -----------------------------------------------------------
 805
 806 \begin{code}
 807 ------------------------------------
 808 type EqEnv = UniqFM FastString  -- Tracks the mapping from L-variables to R-variables
 809
 810 eqIfOcc :: EqEnv -> FastString -> FastString -> IfaceEq
 811 eqIfOcc env n1 n2 = case lookupUFM env n1 of
 812                         Just n1 -> bool (n1 == n2)
 813                         Nothing -> bool (n1 == n2)
 814
 815 extendEqEnv :: EqEnv -> FastString -> FastString -> EqEnv
 816 extendEqEnv env n1 n2 | n1 == n2  = env
 817                       | otherwise = addToUFM env n1 n2
 818
 819 emptyEqEnv :: EqEnv
 820 emptyEqEnv = emptyUFM
 821
 822 ------------------------------------
 823 type ExtEnv bndr = EqEnv -> bndr -> bndr -> (EqEnv -> IfaceEq) -> IfaceEq
 824
 825 eq_ifNakedBndr :: ExtEnv FastString
 826 eq_ifBndr      :: ExtEnv IfaceBndr
 827 eq_ifTvBndr    :: ExtEnv IfaceTvBndr
 828 eq_ifIdBndr    :: ExtEnv IfaceIdBndr
 829
 830 eq_ifNakedBndr env n1 n2 k = k (extendEqEnv env n1 n2)
 831
 832 eq_ifBndr env (IfaceIdBndr b1) (IfaceIdBndr b2) k = eq_ifIdBndr env b1 b2 k
 833 eq_ifBndr env (IfaceTvBndr b1) (IfaceTvBndr b2) k = eq_ifTvBndr env b1 b2 k
 834 eq_ifBndr _ _ _ _ = NotEqual
 835
 836 eq_ifTvBndr env (v1, k1) (v2, k2) k = eq_ifType env k1 k2 &&& k (extendEqEnv env v1 v2)
 837 eq_ifIdBndr env (v1, t1) (v2, t2) k = eq_ifType env t1 t2 &&& k (extendEqEnv env v1 v2)
 838
 839 eq_ifBndrs      :: ExtEnv [IfaceBndr]
 840 eq_ifIdBndrs    :: ExtEnv [IfaceIdBndr]
 841 eq_ifTvBndrs    :: ExtEnv [IfaceTvBndr]
 842 eq_ifNakedBndrs :: ExtEnv [FastString]
 843 eq_ifBndrs      = eq_bndrs_with eq_ifBndr
 844 eq_ifIdBndrs    = eq_bndrs_with eq_ifIdBndr
 845 eq_ifTvBndrs    = eq_bndrs_with eq_ifTvBndr
 846 eq_ifNakedBndrs = eq_bndrs_with eq_ifNakedBndr
 847
 848 eq_bndrs_with eq env []       []       k = k env
 849 eq_bndrs_with eq env (b1:bs1) (b2:bs2) k = eq env b1 b2 (\env -> eq_bndrs_with eq env bs1 bs2 k)
 850 eq_bndrs_with eq env _        _        _ = NotEqual
 851 \end{code}
 852
 853 \begin{code}
 854 eqListBy :: (a->a->IfaceEq) -> [a] -> [a] -> IfaceEq
 855 eqListBy eq []     []     = Equal
 856 eqListBy eq (x:xs) (y:ys) = eq x y &&& eqListBy eq xs ys
 857 eqListBy eq xs     ys     = NotEqual
 858
 859 eqMaybeBy :: (a->a->IfaceEq) -> Maybe a -> Maybe a -> IfaceEq
 860 eqMaybeBy eq Nothing Nothing   = Equal
 861 eqMaybeBy eq (Just x) (Just y) = eq x y
 862 eqMaybeBy eq x        y        = NotEqual
 863 \end{code}