2 #include "HsVersions.h"
5 GenType(..), Type(..), TauType(..),
7 getTyVar, getTyVar_maybe, isTyVarTy,
8 mkAppTy, mkAppTys, splitAppTy,
9 mkFunTy, mkFunTys, splitFunTy, getFunTy_maybe,
10 mkTyConTy, getTyCon_maybe, applyTyCon,
12 mkForAllTy, mkForAllTys, getForAllTy_maybe, splitForAllTy,
13 mkForAllUsageTy, getForAllUsageTy,
16 isPrimType, isUnboxedType, typePrimRep,
18 RhoType(..), SigmaType(..), ThetaType(..),
21 mkSigmaTy, splitSigmaTy,
23 maybeAppTyCon, getAppTyCon,
24 maybeAppDataTyCon, getAppDataTyCon,
27 matchTy, matchTys, eqTy, eqSimpleTy, eqSimpleTheta,
29 instantiateTy, instantiateTauTy, instantiateUsage,
34 tyVarsOfType, tyVarsOfTypes, getTypeKind
40 import IdLoop -- for paranoia checking
41 import TyLoop -- for paranoia checking
42 import PrelLoop -- for paranoia checking
45 import Class ( getClassSig, getClassOpLocalType, GenClass{-instances-} )
46 import Kind ( mkBoxedTypeKind, resultKind )
47 import TyCon ( mkFunTyCon, mkTupleTyCon, isFunTyCon, isPrimTyCon, isDataTyCon, tyConArity,
48 tyConKind, tyConDataCons, getSynTyConDefn, TyCon )
49 import TyVar ( getTyVarKind, GenTyVar{-instances-}, GenTyVarSet(..),
50 emptyTyVarSet, unionTyVarSets, minusTyVarSet,
51 unitTyVarSet, nullTyVarEnv, lookupTyVarEnv,
52 addOneToTyVarEnv, TyVarEnv(..) )
53 import Usage ( usageOmega, GenUsage, Usage(..), UVar(..), UVarEnv(..),
54 nullUVarEnv, addOneToUVarEnv, lookupUVarEnv, eqUVar,
58 import PrimRep ( PrimRep(..) )
59 import Util ( thenCmp, zipEqual, panic, panic#, assertPanic,
68 type Type = GenType TyVar UVar -- Used after typechecker
70 data GenType tyvar uvar -- Parameterised over type and usage variables
77 | TyConTy -- Constants of a specified kind
79 (GenUsage uvar) -- Usage gives uvar of the full application,
80 -- iff the full application is of kind Type
81 -- c.f. the Usage field in TyVars
83 | SynTy -- Synonyms must be saturated, and contain their expansion
84 TyCon -- Must be a SynTyCon
86 (GenType tyvar uvar) -- Expansion!
90 (GenType tyvar uvar) -- TypeKind
93 uvar -- Quantify over this
94 [uvar] -- Bounds; the quantified var must be
95 -- less than or equal to all these
98 -- Two special cases that save a *lot* of administrative
101 | FunTy -- BoxedTypeKind
102 (GenType tyvar uvar) -- Both args are of TypeKind
108 (GenType tyvar uvar) -- Arg has kind TypeKind
115 type ThetaType = [(Class, Type)]
116 type SigmaType = Type
122 Removes just the top level of any abbreviations.
125 expandTy :: Type -> Type -- Restricted to Type due to Dict expansion
127 expandTy (FunTy t1 t2 u) = AppTy (AppTy (TyConTy mkFunTyCon u) t1) t2
128 expandTy (SynTy _ _ t) = expandTy t
129 expandTy (DictTy clas ty u)
130 = case all_arg_tys of
132 [arg_ty] -> expandTy arg_ty -- just the <whatever> itself
134 -- The extra expandTy is to make sure that
135 -- the result isn't still a dict, which it might be
136 -- if the original guy was a dict with one superdict and
139 other -> ASSERT(not (null all_arg_tys))
140 foldl AppTy (TyConTy (mkTupleTyCon (length all_arg_tys)) u) all_arg_tys
143 -- Note: length of all_arg_tys can be 0 if the class is
144 -- _CCallable, _CReturnable (and anything else
145 -- *really weird* that the user writes).
147 (tyvar, super_classes, ops) = getClassSig clas
148 super_dict_tys = map mk_super_ty super_classes
149 class_op_tys = map mk_op_ty ops
150 all_arg_tys = super_dict_tys ++ class_op_tys
151 mk_super_ty sc = DictTy sc ty usageOmega
152 mk_op_ty op = instantiateTy [(tyvar,ty)] (getClassOpLocalType op)
157 Simple construction and analysis functions
158 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
160 mkTyVarTy :: t -> GenType t u
161 mkTyVarTys :: [t] -> [GenType t y]
163 mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
165 getTyVar :: String -> GenType t u -> t
166 getTyVar msg (TyVarTy tv) = tv
167 getTyVar msg (SynTy _ _ t) = getTyVar msg t
168 getTyVar msg other = panic ("getTyVar: " ++ msg)
170 getTyVar_maybe :: GenType t u -> Maybe t
171 getTyVar_maybe (TyVarTy tv) = Just tv
172 getTyVar_maybe (SynTy _ _ t) = getTyVar_maybe t
173 getTyVar_maybe other = Nothing
175 isTyVarTy :: GenType t u -> Bool
176 isTyVarTy (TyVarTy tv) = True
177 isTyVarTy (SynTy _ _ t) = isTyVarTy t
178 isTyVarTy other = False
184 mkAppTys :: GenType t u -> [GenType t u] -> GenType t u
185 mkAppTys t ts = foldl AppTy t ts
187 splitAppTy :: GenType t u -> (GenType t u, [GenType t u])
188 splitAppTy t = go t []
190 go (AppTy t arg) ts = go t (arg:ts)
191 go (FunTy fun arg u) ts = (TyConTy mkFunTyCon u, fun:arg:ts)
192 go (SynTy _ _ t) ts = go t ts
197 -- NB mkFunTy, mkFunTys puts in Omega usages, for now at least
198 mkFunTy arg res = FunTy arg res usageOmega
200 mkFunTys :: [GenType t u] -> GenType t u -> GenType t u
201 mkFunTys ts t = foldr (\ f a -> FunTy f a usageOmega) t ts
203 getFunTy_maybe :: GenType t u -> Maybe (GenType t u, GenType t u)
204 getFunTy_maybe (FunTy arg result _) = Just (arg,result)
205 getFunTy_maybe (AppTy (AppTy (TyConTy tycon _) arg) res)
206 | isFunTyCon tycon = Just (arg, res)
207 getFunTy_maybe (SynTy _ _ t) = getFunTy_maybe t
208 getFunTy_maybe other = Nothing
210 splitFunTy :: GenType t u -> ([GenType t u], GenType t u)
211 splitFunTy t = go t []
213 go (FunTy arg res _) ts = go res (arg:ts)
214 go (AppTy (AppTy (TyConTy tycon _) arg) res) ts
224 -- NB applyTyCon puts in usageOmega, for now at least
225 mkTyConTy tycon = TyConTy tycon usageOmega
227 applyTyCon :: TyCon -> [GenType t u] -> GenType t u
228 applyTyCon tycon tys = foldl AppTy (TyConTy tycon usageOmega) tys
230 getTyCon_maybe :: GenType t u -> Maybe TyCon
231 getTyCon_maybe (TyConTy tycon _) = Just tycon
232 getTyCon_maybe (SynTy _ _ t) = getTyCon_maybe t
233 getTyCon_maybe other_ty = Nothing
237 mkSynTy syn_tycon tys
238 = SynTy syn_tycon tys (instantiateTauTy (zipEqual tyvars tys) body)
240 (tyvars, body) = getSynTyConDefn syn_tycon
246 isTauTy :: GenType t u -> Bool
247 isTauTy (TyVarTy v) = True
248 isTauTy (TyConTy _ _) = True
249 isTauTy (AppTy a b) = isTauTy a && isTauTy b
250 isTauTy (FunTy a b _) = isTauTy a && isTauTy b
251 isTauTy (SynTy _ _ ty) = isTauTy ty
252 isTauTy other = False
257 NB mkRhoTy and mkDictTy put in usageOmega, for now at least
260 mkDictTy :: Class -> GenType t u -> GenType t u
261 mkDictTy clas ty = DictTy clas ty usageOmega
263 mkRhoTy :: [(Class, GenType t u)] -> GenType t u -> GenType t u
265 foldr (\(c,t) r -> FunTy (DictTy c t usageOmega) r usageOmega) ty theta
267 splitRhoTy :: GenType t u -> ([(Class,GenType t u)], GenType t u)
271 go (FunTy (DictTy c t _) r _) ts = go r ((c,t):ts)
272 go (AppTy (AppTy (TyConTy tycon _) (DictTy c t _)) r) ts
275 go (SynTy _ _ t) ts = go t ts
276 go t ts = (reverse ts, t)
283 mkForAllTy = ForAllTy
285 mkForAllTys :: [t] -> GenType t u -> GenType t u
286 mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
288 getForAllTy_maybe :: GenType t u -> Maybe (t,GenType t u)
289 getForAllTy_maybe (SynTy _ _ t) = getForAllTy_maybe t
290 getForAllTy_maybe (ForAllTy tyvar t) = Just(tyvar,t)
291 getForAllTy_maybe _ = Nothing
293 splitForAllTy :: GenType t u-> ([t], GenType t u)
294 splitForAllTy t = go t []
296 go (ForAllTy tv t) tvs = go t (tv:tvs)
297 go (SynTy _ _ t) tvs = go t tvs
298 go t tvs = (reverse tvs, t)
302 mkForAllUsageTy :: u -> [u] -> GenType t u -> GenType t u
303 mkForAllUsageTy = ForAllUsageTy
305 getForAllUsageTy :: GenType t u -> Maybe (u,[u],GenType t u)
306 getForAllUsageTy (ForAllUsageTy uvar bounds t) = Just(uvar,bounds,t)
307 getForAllUsageTy (SynTy _ _ t) = getForAllUsageTy t
308 getForAllUsageTy _ = Nothing
311 Applied tycons (includes FunTyCons)
312 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
315 :: GenType tyvar uvar
316 -> Maybe (TyCon, -- the type constructor
317 [GenType tyvar uvar]) -- types to which it is applied
320 = case (getTyCon_maybe app_ty) of
322 Just tycon -> Just (tycon, arg_tys)
324 (app_ty, arg_tys) = splitAppTy ty
328 :: GenType tyvar uvar
329 -> (TyCon, -- the type constructor
330 [GenType tyvar uvar]) -- types to which it is applied
333 = case maybeAppTyCon ty of
336 Nothing -> panic "Type.getAppTyCon" -- (ppr PprShowAll ty)
340 Applied data tycons (give back constrs)
341 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
344 :: GenType tyvar uvar
345 -> Maybe (TyCon, -- the type constructor
346 [GenType tyvar uvar], -- types to which it is applied
347 [Id]) -- its family of data-constructors
350 = case (getTyCon_maybe app_ty) of
351 Just tycon | isDataTyCon tycon &&
352 tyConArity tycon == length arg_tys
353 -- Must be saturated for ty to be a data type
354 -> Just (tycon, arg_tys, tyConDataCons tycon)
358 (app_ty, arg_tys) = splitAppTy ty
362 :: GenType tyvar uvar
363 -> (TyCon, -- the type constructor
364 [GenType tyvar uvar], -- types to which it is applied
365 [Id]) -- its family of data-constructors
368 = case maybeAppDataTyCon ty of
371 Nothing -> panic "Type.getAppDataTyCon" -- (ppr PprShowAll ty)
375 maybeBoxedPrimType :: Type -> Maybe (Id, Type)
377 maybeBoxedPrimType ty
378 = case (maybeAppDataTyCon ty) of -- Data type,
379 Just (tycon, tys_applied, [data_con]) -- with exactly one constructor
380 -> case (getInstantiatedDataConSig data_con tys_applied) of
381 (_, [data_con_arg_ty], _) -- Applied to exactly one type,
382 | isPrimType data_con_arg_ty -- which is primitive
383 -> Just (data_con, data_con_arg_ty)
384 other_cases -> Nothing
385 other_cases -> Nothing
389 splitSigmaTy :: GenType t u -> ([t], [(Class,GenType t u)], GenType t u)
393 (tyvars,rho) = splitForAllTy ty
394 (theta,tau) = splitRhoTy rho
396 mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkRhoTy theta tau)
400 Finding the kind of a type
401 ~~~~~~~~~~~~~~~~~~~~~~~~~~
403 getTypeKind :: GenType (GenTyVar any) u -> Kind
404 getTypeKind (TyVarTy tyvar) = getTyVarKind tyvar
405 getTypeKind (TyConTy tycon usage) = tyConKind tycon
406 getTypeKind (SynTy _ _ ty) = getTypeKind ty
407 getTypeKind (FunTy fun arg _) = mkBoxedTypeKind
408 getTypeKind (DictTy clas arg _) = mkBoxedTypeKind
409 getTypeKind (AppTy fun arg) = resultKind (getTypeKind fun)
410 getTypeKind (ForAllTy _ _) = mkBoxedTypeKind
411 getTypeKind (ForAllUsageTy _ _ _) = mkBoxedTypeKind
415 Free variables of a type
416 ~~~~~~~~~~~~~~~~~~~~~~~~
418 tyVarsOfType :: GenType (GenTyVar flexi) uvar -> GenTyVarSet flexi
420 tyVarsOfType (TyVarTy tv) = unitTyVarSet tv
421 tyVarsOfType (TyConTy tycon usage) = emptyTyVarSet
422 tyVarsOfType (SynTy _ tys ty) = tyVarsOfTypes tys
423 tyVarsOfType (FunTy arg res _) = tyVarsOfType arg `unionTyVarSets` tyVarsOfType res
424 tyVarsOfType (AppTy fun arg) = tyVarsOfType fun `unionTyVarSets` tyVarsOfType arg
425 tyVarsOfType (DictTy clas ty _) = tyVarsOfType ty
426 tyVarsOfType (ForAllTy tyvar ty) = tyVarsOfType ty `minusTyVarSet` unitTyVarSet tyvar
427 tyVarsOfType (ForAllUsageTy _ _ ty) = tyVarsOfType ty
429 tyVarsOfTypes :: [GenType (GenTyVar flexi) uvar] -> GenTyVarSet flexi
430 tyVarsOfTypes tys = foldr (unionTyVarSets.tyVarsOfType) emptyTyVarSet tys
437 applyTy :: Eq t => GenType t u -> GenType t u -> GenType t u
438 applyTy (SynTy _ _ fun) arg = applyTy fun arg
439 applyTy (ForAllTy tv ty) arg = instantiateTy [(tv,arg)] ty
440 applyTy other arg = panic "applyTy"
442 instantiateTy :: Eq t => [(t, GenType t u)] -> GenType t u -> GenType t u
443 instantiateTy tenv ty
446 go (TyVarTy tv) = case [ty | (tv',ty) <- tenv, tv==tv'] of
449 go ty@(TyConTy tycon usage) = ty
450 go (SynTy tycon tys ty) = SynTy tycon (map go tys) (go ty)
451 go (FunTy arg res usage) = FunTy (go arg) (go res) usage
452 go (AppTy fun arg) = AppTy (go fun) (go arg)
453 go (DictTy clas ty usage) = DictTy clas (go ty) usage
454 go (ForAllTy tv ty) = ASSERT(null tv_bound)
457 tv_bound = [() | (tv',_) <- tenv, tv==tv']
459 go (ForAllUsageTy uvar bds ty) = ForAllUsageTy uvar bds (go ty)
462 -- instantiateTauTy works only (a) on types with no ForAlls,
463 -- and when (b) all the type variables are being instantiated
464 -- In return it is more polymorphic than instantiateTy
466 instantiateTauTy :: Eq t => [(t, GenType t' u)] -> GenType t u -> GenType t' u
467 instantiateTauTy tenv ty
470 go (TyVarTy tv) = case [ty | (tv',ty) <- tenv, tv==tv'] of
472 [] -> panic "instantiateTauTy"
473 go (TyConTy tycon usage) = TyConTy tycon usage
474 go (SynTy tycon tys ty) = SynTy tycon (map go tys) (go ty)
475 go (FunTy arg res usage) = FunTy (go arg) (go res) usage
476 go (AppTy fun arg) = AppTy (go fun) (go arg)
477 go (DictTy clas ty usage) = DictTy clas (go ty) usage
480 :: Ord3 u => [(u, GenType t u')] -> GenType t u -> GenType t u'
481 instantiateUsage = error "instantiateUsage: not implemented"
485 type TypeEnv = TyVarEnv Type
487 applyTypeEnvToTy :: TypeEnv -> SigmaType -> SigmaType
488 applyTypeEnvToTy tenv ty
489 = mapOverTyVars v_fn ty
491 v_fn v = case (lookupTyVarEnv tenv v) of
496 @mapOverTyVars@ is a local function which actually does the work. It
497 does no cloning or other checks for shadowing, so be careful when
498 calling this on types with Foralls in them.
501 mapOverTyVars :: (TyVar -> Type) -> Type -> Type
503 mapOverTyVars v_fn ty
505 mapper = mapOverTyVars v_fn
509 SynTy c as e -> SynTy c (map mapper as) (mapper e)
510 FunTy a r u -> FunTy (mapper a) (mapper r) u
511 AppTy f a -> AppTy (mapper f) (mapper a)
512 DictTy c t u -> DictTy c (mapper t) u
513 ForAllTy v t -> ForAllTy v (mapper t)
514 tc@(TyConTy _ _) -> tc
517 At present there are no unboxed non-primitive types, so
518 isUnboxedType is the same as isPrimType.
521 isPrimType, isUnboxedType :: GenType tyvar uvar -> Bool
523 isPrimType (AppTy ty _) = isPrimType ty
524 isPrimType (SynTy _ _ ty) = isPrimType ty
525 isPrimType (TyConTy tycon _) = isPrimTyCon tycon
528 isUnboxedType = isPrimType
531 This is *not* right: it is a placeholder (ToDo 96/03 WDP):
533 typePrimRep :: GenType tyvar uvar -> PrimRep
535 typePrimRep (SynTy _ _ ty) = typePrimRep ty
536 typePrimRep (TyConTy tc _) = if isPrimTyCon tc then panic "typePrimRep:PrimTyCon" else PtrRep
537 typePrimRep (AppTy ty _) = typePrimRep ty
538 typePrimRep _ = PtrRep -- the "default"
541 %************************************************************************
543 \subsection{Matching on types}
545 %************************************************************************
547 Matching is a {\em unidirectional} process, matching a type against a
548 template (which is just a type with type variables in it). The
549 matcher assumes that there are no repeated type variables in the
550 template, so that it simply returns a mapping of type variables to
551 types. It also fails on nested foralls.
553 @matchTys@ matches corresponding elements of a list of templates and
557 matchTy :: GenType t1 u1 -- Template
558 -> GenType t2 u2 -- Proposed instance of template
559 -> Maybe [(t1,GenType t2 u2)] -- Matching substitution
561 matchTys :: [GenType t1 u1] -- Templates
562 -> [GenType t2 u2] -- Proposed instance of template
563 -> Maybe [(t1,GenType t2 u2)] -- Matching substitution
565 matchTy ty1 ty2 = match [] [] ty1 ty2
566 matchTys tys1 tys2 = match' [] (zipEqual tys1 tys2)
569 @match@ is the main function.
572 match :: [(t1, GenType t2 u2)] -- r, the accumulating result
573 -> [(GenType t1 u1, GenType t2 u2)] -- w, the work list
574 -> GenType t1 u1 -> GenType t2 u2 -- Current match pair
575 -> Maybe [(t1, GenType t2 u2)]
577 match r w (TyVarTy v) ty = match' ((v,ty) : r) w
578 match r w (FunTy fun1 arg1 _) (FunTy fun2 arg2 _) = match r ((fun1,fun2):w) arg1 arg2
579 match r w (AppTy fun1 arg1) (AppTy fun2 arg2) = match r ((fun1,fun2):w) arg1 arg2
580 match r w (TyConTy con1 _) (TyConTy con2 _) | con1 == con2 = match' r w
581 match r w (DictTy clas1 ty1 _) (DictTy clas2 ty2 _) | clas1 == clas2 = match r w ty1 ty2
582 match r w (SynTy _ _ ty1) ty2 = match r w ty1 ty2
583 match r w ty1 (SynTy _ _ ty2) = match r w ty1 ty2
585 -- With type synonyms, we have to be careful for the exact
586 -- same reasons as in the unifier. Please see the
587 -- considerable commentary there before changing anything
591 match _ _ _ _ = Nothing
594 match' r ((ty1,ty2):w) = match r w ty1 ty2
597 %************************************************************************
599 \subsection{Equality on types}
601 %************************************************************************
603 The functions eqSimpleTy and eqSimpleTheta are polymorphic in the types t
604 and u, but ONLY WORK FOR SIMPLE TYPES (ie. they panic if they see
605 dictionaries or polymorphic types). The function eqTy has a more
606 specific type, but does the `right thing' for all types.
609 eqSimpleTheta :: (Eq t,Eq u) =>
610 [(Class,GenType t u)] -> [(Class,GenType t u)] -> Bool
612 eqSimpleTheta [] [] = True
613 eqSimpleTheta ((c1,t1):th1) ((c2,t2):th2) =
614 c1==c2 && t1 `eqSimpleTy` t2 && th1 `eqSimpleTheta` th2
615 eqSimpleTheta other1 other2 = False
619 eqSimpleTy :: (Eq t,Eq u) => GenType t u -> GenType t u -> Bool
621 (TyVarTy tv1) `eqSimpleTy` (TyVarTy tv2) =
623 (AppTy f1 a1) `eqSimpleTy` (AppTy f2 a2) =
624 f1 `eqSimpleTy` f2 && a1 `eqSimpleTy` a2
625 (TyConTy tc1 u1) `eqSimpleTy` (TyConTy tc2 u2) =
626 tc1 == tc2 && u1 == u2
628 (FunTy f1 a1 u1) `eqSimpleTy` (FunTy f2 a2 u2) =
629 f1 `eqSimpleTy` f2 && a1 `eqSimpleTy` a2 && u1 == u2
630 (FunTy f1 a1 u1) `eqSimpleTy` t2 =
631 -- Expand t1 just in case t2 matches that version
632 (AppTy (AppTy (TyConTy mkFunTyCon u1) f1) a1) `eqSimpleTy` t2
633 t1 `eqSimpleTy` (FunTy f2 a2 u2) =
634 -- Expand t2 just in case t1 matches that version
635 t1 `eqSimpleTy` (AppTy (AppTy (TyConTy mkFunTyCon u2) f2) a2)
637 (SynTy tc1 ts1 t1) `eqSimpleTy` (SynTy tc2 ts2 t2) =
638 (tc1 == tc2 && and (zipWith eqSimpleTy ts1 ts2) && length ts1 == length ts2)
639 || t1 `eqSimpleTy` t2
640 (SynTy _ _ t1) `eqSimpleTy` t2 =
641 t1 `eqSimpleTy` t2 -- Expand the abbrevation and try again
642 t1 `eqSimpleTy` (SynTy _ _ t2) =
643 t1 `eqSimpleTy` t2 -- Expand the abbrevation and try again
645 (DictTy _ _ _) `eqSimpleTy` _ = panic "eqSimpleTy: got DictTy"
646 _ `eqSimpleTy` (DictTy _ _ _) = panic "eqSimpleTy: got DictTy"
648 (ForAllTy _ _) `eqSimpleTy` _ = panic "eqSimpleTy: got ForAllTy"
649 _ `eqSimpleTy` (ForAllTy _ _) = panic "eqSimpleTy: got ForAllTy"
651 (ForAllUsageTy _ _ _) `eqSimpleTy` _ = panic "eqSimpleTy: got ForAllUsageTy"
652 _ `eqSimpleTy` (ForAllUsageTy _ _ _) = panic "eqSimpleTy: got ForAllUsageTy"
654 _ `eqSimpleTy` _ = False
657 Types are ordered so we can sort on types in the renamer etc. DNT: Since
658 this class is also used in CoreLint and other such places, we DO expand out
659 Fun/Syn/Dict types (if necessary).
662 eqTy :: Type -> Type -> Bool
665 eq nullTyVarEnv nullUVarEnv t1 t2
667 eq tve uve (TyVarTy tv1) (TyVarTy tv2) =
669 case (lookupTyVarEnv tve tv1) of
672 eq tve uve (AppTy f1 a1) (AppTy f2 a2) =
673 eq tve uve f1 f2 && eq tve uve a1 a2
674 eq tve uve (TyConTy tc1 u1) (TyConTy tc2 u2) =
675 tc1 == tc2 && eqUsage uve u1 u2
677 eq tve uve (FunTy f1 a1 u1) (FunTy f2 a2 u2) =
678 eq tve uve f1 f2 && eq tve uve a1 a2 && eqUsage uve u1 u2
679 eq tve uve (FunTy f1 a1 u1) t2 =
680 -- Expand t1 just in case t2 matches that version
681 eq tve uve (AppTy (AppTy (TyConTy mkFunTyCon u1) f1) a1) t2
682 eq tve uve t1 (FunTy f2 a2 u2) =
683 -- Expand t2 just in case t1 matches that version
684 eq tve uve t1 (AppTy (AppTy (TyConTy mkFunTyCon u2) f2) a2)
686 eq tve uve (DictTy c1 t1 u1) (DictTy c2 t2 u2) =
687 c1 == c2 && eq tve uve t1 t2 && eqUsage uve u1 u2
688 eq tve uve t1@(DictTy _ _ _) t2 =
689 eq tve uve (expandTy t1) t2 -- Expand the dictionary and try again
690 eq tve uve t1 t2@(DictTy _ _ _) =
691 eq tve uve t1 (expandTy t2) -- Expand the dictionary and try again
693 eq tve uve (SynTy tc1 ts1 t1) (SynTy tc2 ts2 t2) =
694 (tc1 == tc2 && and (zipWith (eq tve uve) ts1 ts2) && length ts1 == length ts2)
696 eq tve uve (SynTy _ _ t1) t2 =
697 eq tve uve t1 t2 -- Expand the abbrevation and try again
698 eq tve uve t1 (SynTy _ _ t2) =
699 eq tve uve t1 t2 -- Expand the abbrevation and try again
701 eq tve uve (ForAllTy tv1 t1) (ForAllTy tv2 t2) =
702 eq (addOneToTyVarEnv tve tv1 tv2) uve t1 t2
703 eq tve uve (ForAllUsageTy u1 b1 t1) (ForAllUsageTy u2 b2 t2) =
704 eqBounds uve b1 b2 && eq tve (addOneToUVarEnv uve u1 u2) t1 t2
708 eqBounds uve [] [] = True
709 eqBounds uve (u1:b1) (u2:b2) = eqUVar uve u1 u2 && eqBounds uve b1 b2
710 eqBounds uve _ _ = False