ghc/compiler/types/Type.lhs

   1 \begin{code}
   2 #include "HsVersions.h"
   3
   4 module Type (
   5         GenType(..), Type(..), TauType(..),
   6         mkTyVarTy, mkTyVarTys,
   7         getTyVar, getTyVar_maybe, isTyVarTy,
   8         mkAppTy, mkAppTys, splitAppTy,
   9         mkFunTy, mkFunTys, splitFunTy, getFunTy_maybe,
  10         mkTyConTy, getTyCon_maybe, applyTyCon,
  11         mkSynTy,
  12         mkForAllTy, mkForAllTys, getForAllTy_maybe, splitForAllTy,
  13         mkForAllUsageTy, getForAllUsageTy,
  14         applyTy,
  15
  16         isPrimType,
  17
  18         RhoType(..), SigmaType(..), ThetaType(..),
  19         mkDictTy,
  20         mkRhoTy, splitRhoTy,
  21         mkSigmaTy, splitSigmaTy,
  22
  23         maybeAppTyCon, getAppTyCon,
  24         maybeAppDataTyCon, getAppDataTyCon,
  25         maybeBoxedPrimType,
  26
  27         matchTy, matchTys, eqTy, eqSimpleTy, eqSimpleTheta,
  28
  29         instantiateTy,instantiateUsage,
  30
  31         isTauTy,
  32
  33         tyVarsOfType, tyVarsOfTypes, getTypeKind
  34
  35
  36 ) where
  37
  38 import Ubiq
  39 import IdLoop    -- for paranoia checking
  40 import TyLoop    -- for paranoia checking
  41 import PrelLoop  -- for paranoia checking
  42
  43 -- friends:
  44 import Class    ( getClassSig, getClassOpLocalType, GenClass{-instances-} )
  45 import Kind     ( mkBoxedTypeKind, resultKind )
  46 import TyCon    ( mkFunTyCon, mkTupleTyCon, isFunTyCon, isPrimTyCon,
  47                   getTyConKind, getTyConDataCons, TyCon )
  48 import TyVar    ( getTyVarKind, GenTyVar{-instances-}, GenTyVarSet(..),
  49                   emptyTyVarSet, unionTyVarSets, minusTyVarSet,
  50                   singletonTyVarSet, nullTyVarEnv, lookupTyVarEnv,
  51                   addOneToTyVarEnv, TyVarEnv(..) )
  52 import Usage    ( usageOmega, GenUsage, Usage(..), UVar(..), UVarEnv(..),
  53                   nullUVarEnv, addOneToUVarEnv, lookupUVarEnv, eqUVar,
  54                   eqUsage )
  55
  56 -- others
  57 import Util     ( thenCmp, zipEqual, panic, panic#, assertPanic,
  58                   Ord3(..){-instances-}
  59                 )
  60 \end{code}
  61
  62 Data types
  63 ~~~~~~~~~~
  64
  65 \begin{code}
  66 type Type  = GenType TyVar UVar -- Used after typechecker
  67
  68 data GenType tyvar uvar -- Parameterised over type and usage variables
  69   = TyVarTy tyvar
  70
  71   | AppTy
  72         (GenType tyvar uvar)
  73         (GenType tyvar uvar)
  74
  75   | TyConTy     -- Constants of a specified kind
  76         TyCon
  77         (GenUsage uvar) -- Usage gives uvar of the full application,
  78                         -- iff the full application is of kind Type
  79                         -- c.f. the Usage field in TyVars
  80
  81   | SynTy       -- Synonyms must be saturated, and contain their expansion
  82         TyCon   -- Must be a SynTyCon
  83         [GenType tyvar uvar]
  84         (GenType tyvar uvar)    -- Expansion!
  85
  86   | ForAllTy
  87         tyvar
  88         (GenType tyvar uvar)    -- TypeKind
  89
  90   | ForAllUsageTy
  91         uvar                    -- Quantify over this
  92         [uvar]                  -- Bounds; the quantified var must be
  93                                 -- less than or equal to all these
  94         (GenType tyvar uvar)
  95
  96         -- Two special cases that save a *lot* of administrative
  97         -- overhead:
  98
  99   | FunTy                       -- BoxedTypeKind
 100         (GenType tyvar uvar)    -- Both args are of TypeKind
 101         (GenType tyvar uvar)
 102         (GenUsage uvar)
 103
 104   | DictTy                      -- TypeKind
 105         Class                   -- Class
 106         (GenType tyvar uvar)    -- Arg has kind TypeKind
 107         (GenUsage uvar)
 108 \end{code}
 109
 110 \begin{code}
 111 type RhoType   = Type
 112 type TauType   = Type
 113 type ThetaType = [(Class, Type)]
 114 type SigmaType = Type
 115 \end{code}
 116
 117
 118 Expand abbreviations
 119 ~~~~~~~~~~~~~~~~~~~~
 120 Removes just the top level of any abbreviations.
 121
 122 \begin{code}
 123 expandTy :: Type -> Type        -- Restricted to Type due to Dict expansion
 124
 125 expandTy (FunTy t1 t2 u) = AppTy (AppTy (TyConTy mkFunTyCon u) t1) t2
 126 expandTy (SynTy _  _  t) = expandTy t
 127 expandTy (DictTy clas ty u)
 128   = case all_arg_tys of
 129
 130         [arg_ty] -> expandTy arg_ty     -- just the <whatever> itself
 131
 132                 -- The extra expandTy is to make sure that
 133                 -- the result isn't still a dict, which it might be
 134                 -- if the original guy was a dict with one superdict and
 135                 -- no methods!
 136
 137         other -> ASSERT(not (null all_arg_tys))
 138                 foldl AppTy (TyConTy (mkTupleTyCon (length all_arg_tys)) u) all_arg_tys
 139
 140                 -- A tuple of 'em
 141                 -- Note: length of all_arg_tys can be 0 if the class is
 142                 --       _CCallable, _CReturnable (and anything else
 143                 --       *really weird* that the user writes).
 144   where
 145     (tyvar, super_classes, ops) = getClassSig clas
 146     super_dict_tys = map mk_super_ty super_classes
 147     class_op_tys   = map mk_op_ty ops
 148     all_arg_tys    = super_dict_tys ++ class_op_tys
 149     mk_super_ty sc = DictTy sc ty usageOmega
 150     mk_op_ty    op = instantiateTy [(tyvar,ty)] (getClassOpLocalType op)
 151
 152 expandTy ty = ty
 153 \end{code}
 154
 155 Simple construction and analysis functions
 156 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 157 \begin{code}
 158 mkTyVarTy  :: t   -> GenType t u
 159 mkTyVarTys :: [t] -> [GenType t y]
 160 mkTyVarTy  = TyVarTy
 161 mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
 162
 163 getTyVar :: String -> GenType t u -> t
 164 getTyVar msg (TyVarTy tv)   = tv
 165 getTyVar msg (SynTy _ _ t)  = getTyVar msg t
 166 getTyVar msg other          = panic ("getTyVar: " ++ msg)
 167
 168 getTyVar_maybe :: GenType t u -> Maybe t
 169 getTyVar_maybe (TyVarTy tv)  = Just tv
 170 getTyVar_maybe (SynTy _ _ t) = getTyVar_maybe t
 171 getTyVar_maybe other         = Nothing
 172
 173 isTyVarTy :: GenType t u -> Bool
 174 isTyVarTy (TyVarTy tv)  = True
 175 isTyVarTy (SynTy _ _ t) = isTyVarTy t
 176 isTyVarTy other = False
 177 \end{code}
 178
 179 \begin{code}
 180 mkAppTy = AppTy
 181
 182 mkAppTys :: GenType t u -> [GenType t u] -> GenType t u
 183 mkAppTys t ts = foldl AppTy t ts
 184
 185 splitAppTy :: GenType t u -> (GenType t u, [GenType t u])
 186 splitAppTy t = go t []
 187   where
 188     go (AppTy t arg)     ts = go t (arg:ts)
 189     go (FunTy fun arg u) ts = (TyConTy mkFunTyCon u, fun:arg:ts)
 190     go (SynTy _ _ t)     ts = go t ts
 191     go t                 ts = (t,ts)
 192 \end{code}
 193
 194 \begin{code}
 195 -- NB mkFunTy, mkFunTys puts in Omega usages, for now at least
 196 mkFunTy arg res = FunTy arg res usageOmega
 197
 198 mkFunTys :: [GenType t u] -> GenType t u -> GenType t u
 199 mkFunTys ts t = foldr (\ f a -> FunTy f a usageOmega) t ts
 200
 201 getFunTy_maybe :: GenType t u -> Maybe (GenType t u, GenType t u)
 202 getFunTy_maybe (FunTy arg result _) = Just (arg,result)
 203 getFunTy_maybe (AppTy (AppTy (TyConTy tycon _) arg) res)
 204                  | isFunTyCon tycon = Just (arg, res)
 205 getFunTy_maybe (SynTy _ _ t)        = getFunTy_maybe t
 206 getFunTy_maybe other                = Nothing
 207
 208 splitFunTy :: GenType t u -> ([GenType t u], GenType t u)
 209 splitFunTy t = go t []
 210   where
 211     go (FunTy arg res _) ts = go res (arg:ts)
 212     go (AppTy (AppTy (TyConTy tycon _) arg) res) ts
 213         | isFunTyCon tycon
 214         = go res (arg:ts)
 215     go (SynTy _ _ t) ts
 216         = go t ts
 217     go t ts
 218         = (reverse ts, t)
 219 \end{code}
 220
 221 \begin{code}
 222 -- NB applyTyCon puts in usageOmega, for now at least
 223 mkTyConTy tycon = TyConTy tycon usageOmega
 224
 225 applyTyCon :: TyCon -> [GenType t u] -> GenType t u
 226 applyTyCon tycon tys = foldl AppTy (TyConTy tycon usageOmega) tys
 227
 228 getTyCon_maybe :: GenType t u -> Maybe TyCon
 229 getTyCon_maybe (TyConTy tycon _) = Just tycon
 230 getTyCon_maybe (SynTy _ _ t)     = getTyCon_maybe t
 231 getTyCon_maybe other_ty          = Nothing
 232 \end{code}
 233
 234 \begin{code}
 235 mkSynTy syn_tycon tys
 236   = SynTy syn_tycon tys (panic "Type.mkSynTy:expansion")
 237 \end{code}
 238
 239 Tau stuff
 240 ~~~~~~~~~
 241 \begin{code}
 242 isTauTy :: GenType t u -> Bool
 243 isTauTy (TyVarTy v)        = True
 244 isTauTy (TyConTy _ _)      = True
 245 isTauTy (AppTy a b)        = isTauTy a && isTauTy b
 246 isTauTy (FunTy a b _)      = isTauTy a && isTauTy b
 247 isTauTy (SynTy _ _ ty)     = isTauTy ty
 248 isTauTy other              = False
 249 \end{code}
 250
 251 Rho stuff
 252 ~~~~~~~~~
 253 NB mkRhoTy and mkDictTy put in usageOmega, for now at least
 254
 255 \begin{code}
 256 mkDictTy :: Class -> GenType t u -> GenType t u
 257 mkDictTy clas ty = DictTy clas ty usageOmega
 258
 259 mkRhoTy :: [(Class, GenType t u)] -> GenType t u -> GenType t u
 260 mkRhoTy theta ty =
 261   foldr (\(c,t) r -> FunTy (DictTy c t usageOmega) r usageOmega) ty theta
 262
 263 splitRhoTy :: GenType t u -> ([(Class,GenType t u)], GenType t u)
 264 splitRhoTy t =
 265   go t []
 266  where
 267   go (FunTy (DictTy c t _) r _) ts = go r ((c,t):ts)
 268   go (AppTy (AppTy (TyConTy tycon _) (DictTy c t _)) r) ts
 269         | isFunTyCon tycon
 270         = go r ((c,t):ts)
 271   go (SynTy _ _ t) ts = go t ts
 272   go t ts = (reverse ts, t)
 273 \end{code}
 274
 275
 276 Forall stuff
 277 ~~~~~~~~~~~~
 278 \begin{code}
 279 mkForAllTy = ForAllTy
 280
 281 mkForAllTys :: [t] -> GenType t u -> GenType t u
 282 mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
 283
 284 getForAllTy_maybe :: GenType t u -> Maybe (t,GenType t u)
 285 getForAllTy_maybe (SynTy _ _ t)      = getForAllTy_maybe t
 286 getForAllTy_maybe (ForAllTy tyvar t) = Just(tyvar,t)
 287 getForAllTy_maybe _                  = Nothing
 288
 289 splitForAllTy :: GenType t u-> ([t], GenType t u)
 290 splitForAllTy t = go t []
 291                where
 292                     go (ForAllTy tv t) tvs = go t (tv:tvs)
 293                     go (SynTy _ _ t)   tvs = go t tvs
 294                     go t               tvs = (reverse tvs, t)
 295 \end{code}
 296
 297 \begin{code}
 298 mkForAllUsageTy :: u -> [u] -> GenType t u -> GenType t u
 299 mkForAllUsageTy = ForAllUsageTy
 300
 301 getForAllUsageTy :: GenType t u -> Maybe (u,[u],GenType t u)
 302 getForAllUsageTy (ForAllUsageTy uvar bounds t) = Just(uvar,bounds,t)
 303 getForAllUsageTy (SynTy _ _ t) = getForAllUsageTy t
 304 getForAllUsageTy _ = Nothing
 305 \end{code}
 306
 307 Applied tycons (includes FunTyCons)
 308 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 309 \begin{code}
 310 maybeAppTyCon
 311         :: GenType tyvar uvar
 312         -> Maybe (TyCon,                -- the type constructor
 313                   [GenType tyvar uvar]) -- types to which it is applied
 314
 315 maybeAppTyCon ty
 316   = case (getTyCon_maybe app_ty) of
 317         Nothing    -> Nothing
 318         Just tycon -> Just (tycon, arg_tys)
 319   where
 320     (app_ty, arg_tys) = splitAppTy ty
 321
 322
 323 getAppTyCon
 324         :: GenType tyvar uvar
 325         -> (TyCon,                      -- the type constructor
 326             [GenType tyvar uvar])       -- types to which it is applied
 327
 328 getAppTyCon ty
 329   = case maybeAppTyCon ty of
 330       Just stuff -> stuff
 331 #ifdef DEBUG
 332       Nothing    -> panic "Type.getAppTyCon" -- (ppr PprShowAll ty)
 333 #endif
 334 \end{code}
 335
 336 Applied data tycons (give back constrs)
 337 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 338 \begin{code}
 339 maybeAppDataTyCon
 340         :: GenType tyvar uvar
 341         -> Maybe (TyCon,                -- the type constructor
 342                   [GenType tyvar uvar], -- types to which it is applied
 343                   [Id])                 -- its family of data-constructors
 344
 345 maybeAppDataTyCon ty
 346   = case (getTyCon_maybe app_ty) of
 347         Nothing    -> Nothing
 348         Just tycon | isFunTyCon tycon
 349                    -> Nothing
 350                    | otherwise
 351                    -> Just (tycon, arg_tys, getTyConDataCons tycon)
 352   where
 353     (app_ty, arg_tys) = splitAppTy ty
 354
 355
 356 getAppDataTyCon
 357         :: GenType tyvar uvar
 358         -> (TyCon,                      -- the type constructor
 359             [GenType tyvar uvar],       -- types to which it is applied
 360             [Id])                       -- its family of data-constructors
 361
 362 getAppDataTyCon ty
 363   = case maybeAppDataTyCon ty of
 364       Just stuff -> stuff
 365 #ifdef DEBUG
 366       Nothing    -> panic "Type.getAppDataTyCon" -- (ppr PprShowAll ty)
 367 #endif
 368
 369
 370 maybeBoxedPrimType :: Type -> Maybe (Id, Type)
 371
 372 maybeBoxedPrimType ty
 373   = case (maybeAppDataTyCon ty) of              -- Data type,
 374       Just (tycon, tys_applied, [data_con])     -- with exactly one constructor
 375         -> case (getInstantiatedDataConSig data_con tys_applied) of
 376              (_, [data_con_arg_ty], _)          -- Applied to exactly one type,
 377                 | isPrimType data_con_arg_ty    -- which is primitive
 378                 -> Just (data_con, data_con_arg_ty)
 379              other_cases -> Nothing
 380       other_cases -> Nothing
 381 \end{code}
 382
 383 \begin{code}
 384 splitSigmaTy :: GenType t u -> ([t], [(Class,GenType t u)], GenType t u)
 385 splitSigmaTy ty =
 386   (tyvars, theta, tau)
 387  where
 388   (tyvars,rho) = splitForAllTy ty
 389   (theta,tau)  = splitRhoTy rho
 390
 391 mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkRhoTy theta tau)
 392 \end{code}
 393
 394
 395 Finding the kind of a type
 396 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 397 \begin{code}
 398 getTypeKind :: GenType (GenTyVar any) u -> Kind
 399 getTypeKind (TyVarTy tyvar)             = getTyVarKind tyvar
 400 getTypeKind (TyConTy tycon usage)       = getTyConKind tycon
 401 getTypeKind (SynTy _ _ ty)              = getTypeKind ty
 402 getTypeKind (FunTy fun arg _)           = mkBoxedTypeKind
 403 getTypeKind (DictTy clas arg _)         = mkBoxedTypeKind
 404 getTypeKind (AppTy fun arg)             = resultKind (getTypeKind fun)
 405 getTypeKind (ForAllTy _ _)              = mkBoxedTypeKind
 406 getTypeKind (ForAllUsageTy _ _ _)       = mkBoxedTypeKind
 407 \end{code}
 408
 409
 410 Free variables of a type
 411 ~~~~~~~~~~~~~~~~~~~~~~~~
 412 \begin{code}
 413 tyVarsOfType :: GenType (GenTyVar flexi) uvar -> GenTyVarSet flexi
 414
 415 tyVarsOfType (TyVarTy tv)               = singletonTyVarSet tv
 416 tyVarsOfType (TyConTy tycon usage)      = emptyTyVarSet
 417 tyVarsOfType (SynTy _ tys ty)           = tyVarsOfTypes tys
 418 tyVarsOfType (FunTy arg res _)          = tyVarsOfType arg `unionTyVarSets` tyVarsOfType res
 419 tyVarsOfType (AppTy fun arg)            = tyVarsOfType fun `unionTyVarSets` tyVarsOfType arg
 420 tyVarsOfType (DictTy clas ty _)         = tyVarsOfType ty
 421 tyVarsOfType (ForAllTy tyvar ty)        = tyVarsOfType ty `minusTyVarSet` singletonTyVarSet tyvar
 422 tyVarsOfType (ForAllUsageTy _ _ ty)     = tyVarsOfType ty
 423
 424 tyVarsOfTypes :: [GenType (GenTyVar flexi) uvar] -> GenTyVarSet flexi
 425 tyVarsOfTypes tys = foldr (unionTyVarSets.tyVarsOfType) emptyTyVarSet tys
 426 \end{code}
 427
 428
 429 Instantiating a type
 430 ~~~~~~~~~~~~~~~~~~~~
 431 \begin{code}
 432 applyTy :: Eq t => GenType t u -> GenType t u -> GenType t u
 433 applyTy (SynTy _ _ fun)  arg = applyTy fun arg
 434 applyTy (ForAllTy tv ty) arg = instantiateTy [(tv,arg)] ty
 435 applyTy other            arg = panic "applyTy"
 436
 437 instantiateTy :: Eq t => [(t, GenType t u)] -> GenType t u -> GenType t u
 438 instantiateTy tenv ty
 439   = go ty
 440   where
 441     go (TyVarTy tv)             = case [ty | (tv',ty) <- tenv, tv==tv'] of
 442                                   []     -> TyVarTy tv
 443                                   (ty:_) -> ty
 444     go ty@(TyConTy tycon usage) = ty
 445     go (SynTy tycon tys ty)     = SynTy tycon (map go tys) (go ty)
 446     go (FunTy arg res usage)    = FunTy (go arg) (go res) usage
 447     go (AppTy fun arg)          = AppTy (go fun) (go arg)
 448     go (DictTy clas ty usage)   = DictTy clas (go ty) usage
 449     go (ForAllTy tv ty)         = ASSERT(null tv_bound)
 450                                   ForAllTy tv (go ty)
 451                                 where
 452                                   tv_bound = [() | (tv',_) <- tenv, tv==tv']
 453
 454     go (ForAllUsageTy uvar bds ty) = ForAllUsageTy uvar bds (go ty)
 455
 456 instantiateUsage
 457         :: Ord3 u => [(u, GenType t u')] -> GenType t u -> GenType t u'
 458 instantiateUsage = error "instantiateUsage: not implemented"
 459 \end{code}
 460
 461 \begin{code}
 462 isPrimType :: GenType tyvar uvar -> Bool
 463 isPrimType (AppTy ty _)      = isPrimType ty
 464 isPrimType (SynTy _ _ ty)    = isPrimType ty
 465 isPrimType (TyConTy tycon _) = isPrimTyCon tycon
 466 isPrimType _                 = False
 467 \end{code}
 468
 469 %************************************************************************
 470 %*                                                                      *
 471 \subsection{Matching on types}
 472 %*                                                                      *
 473 %************************************************************************
 474
 475 Matching is a {\em unidirectional} process, matching a type against a
 476 template (which is just a type with type variables in it).  The
 477 matcher assumes that there are no repeated type variables in the
 478 template, so that it simply returns a mapping of type variables to
 479 types.  It also fails on nested foralls.
 480
 481 @matchTys@ matches corresponding elements of a list of templates and
 482 types.
 483
 484 \begin{code}
 485 matchTy :: GenType t1 u1                -- Template
 486         -> GenType t2 u2                -- Proposed instance of template
 487         -> Maybe [(t1,GenType t2 u2)]   -- Matching substitution
 488
 489 matchTys :: [GenType t1 u1]             -- Templates
 490          -> [GenType t2 u2]             -- Proposed instance of template
 491          -> Maybe [(t1,GenType t2 u2)]  -- Matching substitution
 492
 493 matchTy  ty1  ty2  = match  [] [] ty1 ty2
 494 matchTys tys1 tys2 = match' [] (zipEqual tys1 tys2)
 495 \end{code}
 496
 497 @match@ is the main function.
 498
 499 \begin{code}
 500 match :: [(t1, GenType t2 u2)]                  -- r, the accumulating result
 501       -> [(GenType t1 u1, GenType t2 u2)]       -- w, the work list
 502       -> GenType t1 u1 -> GenType t2 u2         -- Current match pair
 503       -> Maybe [(t1, GenType t2 u2)]
 504
 505 match r w (TyVarTy v)          ty                   = match' ((v,ty) : r) w
 506 match r w (FunTy fun1 arg1 _)  (FunTy fun2 arg2 _)  = match r ((fun1,fun2):w) arg1 arg2
 507 match r w (AppTy fun1 arg1)  (AppTy fun2 arg2)      = match r ((fun1,fun2):w) arg1 arg2
 508 match r w (TyConTy con1 _)     (TyConTy con2 _)     | con1  == con2  = match' r w
 509 match r w (DictTy clas1 ty1 _) (DictTy clas2 ty2 _) | clas1 == clas2 = match r w ty1 ty2
 510 match r w (SynTy _ _ ty1)      ty2                  = match r w ty1 ty2
 511 match r w ty1                  (SynTy _ _ ty2)      = match r w ty1 ty2
 512
 513         -- With type synonyms, we have to be careful for the exact
 514         -- same reasons as in the unifier.  Please see the
 515         -- considerable commentary there before changing anything
 516         -- here! (WDP 95/05)
 517
 518 -- Catch-all fails
 519 match _ _ _ _ = Nothing
 520
 521 match' r []            = Just r
 522 match' r ((ty1,ty2):w) = match r w ty1 ty2
 523 \end{code}
 524
 525 %************************************************************************
 526 %*                                                                      *
 527 \subsection{Equality on types}
 528 %*                                                                      *
 529 %************************************************************************
 530
 531 The functions eqSimpleTy and eqSimpleTheta are polymorphic in the types t
 532 and u, but ONLY WORK FOR SIMPLE TYPES (ie. they panic if they see
 533 dictionaries or polymorphic types).  The function eqTy has a more
 534 specific type, but does the `right thing' for all types.
 535
 536 \begin{code}
 537 eqSimpleTheta :: (Eq t,Eq u) =>
 538     [(Class,GenType t u)] -> [(Class,GenType t u)] -> Bool
 539
 540 eqSimpleTheta [] [] = True
 541 eqSimpleTheta ((c1,t1):th1) ((c2,t2):th2) =
 542   c1==c2 && t1 `eqSimpleTy` t2 && th1 `eqSimpleTheta` th2
 543 eqSimpleTheta other1 other2 = False
 544 \end{code}
 545
 546 \begin{code}
 547 eqSimpleTy :: (Eq t,Eq u) => GenType t u -> GenType t u -> Bool
 548
 549 (TyVarTy tv1) `eqSimpleTy` (TyVarTy tv2) =
 550   tv1 == tv2
 551 (AppTy f1 a1)  `eqSimpleTy` (AppTy f2 a2) =
 552   f1 `eqSimpleTy` f2 && a1 `eqSimpleTy` a2
 553 (TyConTy tc1 u1) `eqSimpleTy` (TyConTy tc2 u2) =
 554   tc1 == tc2 && u1 == u2
 555
 556 (FunTy f1 a1 u1) `eqSimpleTy` (FunTy f2 a2 u2) =
 557   f1 `eqSimpleTy` f2 && a1 `eqSimpleTy` a2 && u1 == u2
 558 (FunTy f1 a1 u1) `eqSimpleTy` t2 =
 559   -- Expand t1 just in case t2 matches that version
 560   (AppTy (AppTy (TyConTy mkFunTyCon u1) f1) a1) `eqSimpleTy` t2
 561 t1 `eqSimpleTy` (FunTy f2 a2 u2) =
 562   -- Expand t2 just in case t1 matches that version
 563   t1 `eqSimpleTy` (AppTy (AppTy (TyConTy mkFunTyCon u2) f2) a2)
 564
 565 (SynTy tc1 ts1 t1) `eqSimpleTy` (SynTy tc2 ts2 t2) =
 566   (tc1 == tc2 && and (zipWith eqSimpleTy ts1 ts2) && length ts1 == length ts2)
 567   || t1 `eqSimpleTy` t2
 568 (SynTy _ _ t1) `eqSimpleTy` t2 =
 569   t1 `eqSimpleTy` t2  -- Expand the abbrevation and try again
 570 t1 `eqSimpleTy` (SynTy _ _ t2) =
 571   t1 `eqSimpleTy` t2  -- Expand the abbrevation and try again
 572
 573 (DictTy _ _ _) `eqSimpleTy` _ = panic "eqSimpleTy: got DictTy"
 574 _ `eqSimpleTy` (DictTy _ _ _) = panic "eqSimpleTy: got DictTy"
 575
 576 (ForAllTy _ _) `eqSimpleTy` _ = panic "eqSimpleTy: got ForAllTy"
 577 _ `eqSimpleTy` (ForAllTy _ _) = panic "eqSimpleTy: got ForAllTy"
 578
 579 (ForAllUsageTy _ _ _) `eqSimpleTy` _ = panic "eqSimpleTy: got ForAllUsageTy"
 580 _ `eqSimpleTy` (ForAllUsageTy _ _ _) = panic "eqSimpleTy: got ForAllUsageTy"
 581
 582 _ `eqSimpleTy` _ = False
 583 \end{code}
 584
 585 Types are ordered so we can sort on types in the renamer etc.  DNT: Since
 586 this class is also used in CoreLint and other such places, we DO expand out
 587 Fun/Syn/Dict types (if necessary).
 588
 589 \begin{code}
 590 eqTy :: Type -> Type -> Bool
 591
 592 eqTy t1 t2 =
 593   eq nullTyVarEnv nullUVarEnv t1 t2
 594  where
 595   eq tve uve (TyVarTy tv1) (TyVarTy tv2) =
 596     tv1 == tv2 ||
 597     case (lookupTyVarEnv tve tv1) of
 598       Just tv -> tv == tv2
 599       Nothing -> False
 600   eq tve uve (AppTy f1 a1) (AppTy f2 a2) =
 601     eq tve uve f1 f2 && eq tve uve a1 a2
 602   eq tve uve (TyConTy tc1 u1) (TyConTy tc2 u2) =
 603     tc1 == tc2 && eqUsage uve u1 u2
 604
 605   eq tve uve (FunTy f1 a1 u1) (FunTy f2 a2 u2) =
 606     eq tve uve f1 f2 && eq tve uve a1 a2 && eqUsage uve u1 u2
 607   eq tve uve (FunTy f1 a1 u1) t2 =
 608     -- Expand t1 just in case t2 matches that version
 609     eq tve uve (AppTy (AppTy (TyConTy mkFunTyCon u1) f1) a1) t2
 610   eq tve uve t1 (FunTy f2 a2 u2) =
 611     -- Expand t2 just in case t1 matches that version
 612     eq tve uve t1 (AppTy (AppTy (TyConTy mkFunTyCon u2) f2) a2)
 613
 614   eq tve uve (DictTy c1 t1 u1) (DictTy c2 t2 u2) =
 615     c1 == c2 && eq tve uve t1 t2 && eqUsage uve u1 u2
 616   eq tve uve t1@(DictTy _ _ _) t2 =
 617     eq tve uve (expandTy t1) t2  -- Expand the dictionary and try again
 618   eq tve uve t1 t2@(DictTy _ _ _) =
 619     eq tve uve t1 (expandTy t2)  -- Expand the dictionary and try again
 620
 621   eq tve uve (SynTy tc1 ts1 t1) (SynTy tc2 ts2 t2) =
 622     (tc1 == tc2 && and (zipWith (eq tve uve) ts1 ts2) && length ts1 == length ts2)
 623     || eq tve uve t1 t2
 624   eq tve uve (SynTy _ _ t1) t2 =
 625     eq tve uve t1 t2  -- Expand the abbrevation and try again
 626   eq tve uve t1 (SynTy _ _ t2) =
 627     eq tve uve t1 t2  -- Expand the abbrevation and try again
 628
 629   eq tve uve (ForAllTy tv1 t1) (ForAllTy tv2 t2) =
 630     eq (addOneToTyVarEnv tve tv1 tv2) uve t1 t2
 631   eq tve uve (ForAllUsageTy u1 b1 t1) (ForAllUsageTy u2 b2 t2) =
 632     eqBounds uve b1 b2 && eq tve (addOneToUVarEnv uve u1 u2) t1 t2
 633
 634   eq _ _ _ _ = False
 635
 636   eqBounds uve [] [] = True
 637   eqBounds uve (u1:b1) (u2:b2) = eqUVar uve u1 u2 && eqBounds uve b1 b2
 638   eqBounds uve _ _ = False
 639 \end{code}