ghc/compiler/uniType/UniType.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[UniType]{The UniType data type}
   5
   6 The module @AbsUniType@ is the normal interface to this datatype.
   7 This interface is for ``Friends Only.''
   8
   9 \begin{code}
  10 #include "HsVersions.h"
  11
  12 module UniType (
  13         UniType(..),    -- not abstract; usually grabbed through AbsUniType
  14
  15         -- USEFUL SYNONYMS
  16         SigmaType(..), RhoType(..), TauType(..),
  17         ThetaType(..),                  -- synonym for [(Class,UniType)]
  18         InstTyEnv(..),
  19
  20         -- CONSTRUCTION
  21         mkTyVarTy, mkTyVarTemplateTy, mkDictTy,
  22         -- use applyTyCon to make UniDatas, UniSyns
  23         mkRhoTy, mkForallTy, mkSigmaTy, -- ToDo: perhaps nuke one?
  24
  25         -- QUANTIFICATION & INSTANTIATION
  26         quantifyTy,
  27         instantiateTy,  instantiateTauTy,  instantiateThetaTy,
  28
  29         -- COMPARISON
  30         cmpUniType,
  31
  32         -- PRE-BUILT TYPES (for Prelude)
  33         alpha, beta, gamma, delta, epsilon,                     -- these have templates in them
  34         alpha_ty, beta_ty, gamma_ty, delta_ty, epsilon_ty,      -- these have tyvars in them
  35
  36         -- to make the interface self-sufficient...
  37         Class, TyCon, TyVar, TyVarTemplate, Maybe
  38    ) where
  39
  40 IMPORT_Trace            -- ToDo:rm (debugging only)
  41
  42 #if USE_ATTACK_PRAGMAS
  43 import Class            ( cmpClass, getClassSig, Class(..), ClassOp(..) )
  44 #else
  45 import Class            ( cmpClass, getClassSig, Class, ClassOp )
  46 #endif
  47 import Maybes           ( assocMaybe, Maybe(..) )
  48 import Outputable       -- the output class, etc.
  49 import Pretty
  50 import TyCon            ( cmpTyCon, TyCon, Arity(..) )
  51 import TyVar            -- various things
  52 import UniTyFuns        ( pprUniType, unDictifyTy
  53                           IF_ATTACK_PRAGMAS(COMMA pprTyCon)
  54                         )
  55 import Util
  56 \end{code}
  57
  58 %************************************************************************
  59 %*                                                                      *
  60 \subsection[UniType-basics]{Basics of the @UniType@ datatype}
  61 %*                                                                      *
  62 %************************************************************************
  63
  64 \begin{code}
  65 data UniType
  66   =
  67     -- The free variables of a UniType are always TyVars.
  68     UniTyVar    TyVar
  69
  70   | UniFun      UniType -- Function type
  71                 UniType
  72
  73   | UniData             -- Application of a non SynonymTyCon
  74                 TyCon           -- Must NOT be a SynonymTyCon
  75                 [UniType]       -- Arguments to the type constructor
  76
  77   | UniSyn              -- Application of a SynonymTyCon
  78                 TyCon           -- Must be a SynonymTyCon
  79                 [UniType]       -- Arguments to the type constructor
  80                 UniType         -- Expanded version (merely cached here)
  81
  82   | UniDict     Class
  83                 UniType
  84
  85   -- The next two are to do with universal quantification
  86
  87   -- TyVarTemplates only need be unique within a single UniType;
  88   -- because they are always bound by an enclosing UniForall.
  89   | UniTyVarTemplate
  90                 TyVarTemplate
  91
  92   | UniForall   TyVarTemplate
  93                 UniType
  94 \end{code}
  95
  96 Universal quantification is over @TyVarTemplate@s.  A type containing
  97 a @UniTyVarTemplate@ always has either an enclosing @UniForall@ which
  98 binds it, or a ``nearby'' binding @TyVarTemplate@.  The only example
  99 of the latter is that a @ClassOp@ will have a free occurrence of the
 100 @TyVarTemplate@ which is held in the @Class@ object.
 101
 102 @UniTyVarTemplate@s are never encountered during unification.
 103
 104 The reasons for this huff and puff over template variables are:
 105 \begin{enumerate}
 106 \item
 107 It's nice to be able to identify them in the code.
 108 \item
 109 It saves worry about accidental capture when instantiating types,
 110 because the types with which the template variables are being
 111 instantiated never themselves contain @UniTyVarTemplates@.
 112 \end{enumerate}
 113
 114 Note: if not @do_properly@, then we treat @UniTyVarTemplates@ as
 115 ``wildcards;'' we use this {\em only} when comparing types in STG
 116 land.  It is the responsibility of the caller to strip the
 117 @UniForalls@ off the front.
 118
 119 \begin{code}
 120 cmpUniType do_properly ty1 ty2
 121   = cmp_ty [] ty1 ty2
 122   where
 123     cmp_ty equivs (UniTyVar tv1) (UniTyVar  tv2) = tv1 `cmpTyVar` tv2
 124
 125     cmp_ty equivs (UniFun a1 b1) (UniFun a2 b2)
 126       = case cmp_ty equivs a1 a2 of { EQ_ -> cmp_ty equivs b1 b2; other -> other }
 127
 128     cmp_ty equivs (UniData tc1 tys1) (UniData tc2 tys2)
 129       = case cmpTyCon tc1 tc2 of { EQ_ -> cmp_ty_lists equivs tys1 tys2; other -> other }
 130
 131     cmp_ty equivs (UniForall tv1 ty1) (UniForall tv2 ty2)
 132       = cmp_ty ((tv1,tv2) : equivs) ty1 ty2
 133 \end{code}
 134
 135 Now we deal with the Dict/Dict case.  If the two classes are the same
 136 then all is straightforward.  If not, the two dicts will usually
 137 differ, but (rarely) we could still be looking at two equal
 138 dictionaries!  For example,
 139
 140      class Foo a => Baz a where
 141
 142 That is, Foo is the only superclass of Baz, and Baz has no methods.
 143 Then a Baz dictionary will be represented simply by a Foo dictionary!
 144
 145 We could sort this out by unDictifying, but that seems like a
 146 sledgehammer to crack a (rather rare) nut.  Instead we ``de-synonym''
 147 each class, by looking to see if it is one of these odd guys which has
 148 no ops and just one superclass (if so, do the same to this
 149 superclass), and then compare the results.
 150
 151 \begin{code}
 152     cmp_ty equivs (UniDict c1 ty1) (UniDict c2 ty2)
 153       = case cmpClass c1 c2 of
 154           EQ_   -> cmp_ty equivs ty1 ty2
 155           other -> case cmpClass (super_ify c1) (super_ify c2) of
 156                         EQ_   -> cmp_ty equivs ty1 ty2
 157                         other -> other
 158       where
 159         super_ify :: Class -> Class     -- Iff the arg is a class with just one
 160                                         -- superclass and no operations, then
 161                                         -- return super_ify of the superclass,
 162                                         -- otherwise just return the original
 163         super_ify clas
 164           = case getClassSig clas of
 165               (_, [super_clas], [{-no ops-}]) -> super_ify super_clas
 166               other                           -> clas
 167 \end{code}
 168
 169 Back to more straightforward things.
 170
 171 \begin{code}
 172     cmp_ty equivs (UniTyVarTemplate tv1) (UniTyVarTemplate tv2)
 173       | not do_properly -- STG case: tyvar templates are ``wildcards''
 174       = EQ_
 175
 176       | otherwise -- compare properly
 177       = case (tv1 `cmp_tv_tmpl` tv2) of
 178           EQ_ -> EQ_
 179           _   -> -- tv1 should Jolly Well be in the equivalents list
 180                  case assocMaybe equivs tv1 of
 181                    Just xx -> xx `cmp_tv_tmpl` tv2
 182                    Nothing ->
 183 #if defined(DEBUG)
 184                               case (pprPanic "cmpUniType:failed assoc:" (ppCat [ppr PprDebug tv1, ppr PprDebug tv2, ppr PprDebug ty1, ppr PprDebug ty2, ppr PprDebug equivs])) of
 185 #else
 186                               case (panic "cmpUniType:failed assoc") of
 187 #endif
 188                                 s -> -- never get here (BUG)
 189                                      cmp_ty equivs s s
 190
 191     cmp_ty equivs a@(UniDict _ _) b  = cmp_ty equivs (unDictifyTy a) b
 192     cmp_ty equivs a b@(UniDict _ _)  = cmp_ty equivs a (unDictifyTy b)
 193
 194     cmp_ty equivs (UniSyn _ _ expand) b = cmp_ty equivs expand b
 195     cmp_ty equivs a (UniSyn _ _ expand) = cmp_ty equivs a expand
 196
 197     -- more special cases for STG case
 198     cmp_ty equivs (UniTyVarTemplate _) b | not do_properly = EQ_
 199     cmp_ty equivs a (UniTyVarTemplate _) | not do_properly = EQ_
 200
 201     cmp_ty equivs other_1 other_2
 202       = let tag1 = tag other_1
 203             tag2 = tag other_2
 204         in
 205         if tag1 _LT_ tag2 then LT_ else GT_
 206       where
 207         tag (UniTyVar _)         = (ILIT(1) :: FAST_INT)
 208         tag (UniFun _ _)         = ILIT(2)
 209         tag (UniData _ _)        = ILIT(3)
 210         tag (UniDict _ _)        = ILIT(4)
 211         tag (UniForall _ _)      = ILIT(5)
 212         tag (UniTyVarTemplate _) = ILIT(6)
 213         tag (UniSyn _ _ _)       = ILIT(7)
 214
 215     cmp_tv_tmpl :: TyVarTemplate -> TyVarTemplate -> TAG_
 216     cmp_tv_tmpl tv1 tv2
 217       = if tv1 == tv2 then EQ_ else if tv1 < tv2 then LT_ else GT_
 218
 219     cmp_ty_lists equivs []     []     = EQ_
 220     cmp_ty_lists equivs (x:xs) []     = GT_
 221     cmp_ty_lists equivs []     (y:ys) = LT_
 222     cmp_ty_lists equivs (x:xs) (y:ys)
 223       = case cmp_ty equivs x y of { EQ_ -> cmp_ty_lists equivs xs ys; other -> other }
 224 \end{code}
 225
 226 \begin{code}
 227 instance Eq  UniType where
 228     a == b = case cmpUniType True{-properly-} a b of { EQ_ -> True;   _ -> False }
 229     a /= b = case cmpUniType True{-properly-} a b of { EQ_ -> False;  _ -> True  }
 230 \end{code}
 231
 232 Useful synonyms:
 233
 234 \begin{code}
 235 type SigmaType  = UniType
 236 type RhoType    = UniType               -- No UniForall, UniTyVarTemplate
 237 type TauType    = UniType               -- No UniDict constructors either
 238 type ThetaType  = [(Class, TauType)]    -- No UniForalls in the UniTypes
 239
 240 type InstTyEnv = [(TyVarTemplate, TauType)]     -- Used for instantiating types
 241 \end{code}
 242
 243 Using @UniType@, a @SigmaType@ such as (Eq a) => a -> [a]
 244 is written as
 245 \begin{verbatim}
 246 UniForall TyVarTemplate
 247       (UniFun (UniDict Class (UniTyVarTemplate TyVarTemplate))
 248               (UniFun (UniTyVarTemplate TyVarTemplate)
 249                       (UniData TyCon [(UniTyVar TyVarTemplate)])))
 250 \end{verbatim}
 251
 252 NB: @mkFunTy@ comes from the prelude.
 253
 254 \begin{code}
 255 mkTyVarTy         = UniTyVar
 256 mkTyVarTemplateTy = UniTyVarTemplate
 257 mkDictTy          = UniDict
 258 -- use applyTyCon to make UniDatas and UniSyns
 259
 260 alpha = UniTyVarTemplate alpha_tv
 261 beta  = UniTyVarTemplate beta_tv
 262 gamma = UniTyVarTemplate gamma_tv
 263 delta = UniTyVarTemplate delta_tv
 264 epsilon = UniTyVarTemplate epsilon_tv
 265
 266 alpha_ty = UniTyVar alpha_tyvar
 267 beta_ty  = UniTyVar beta_tyvar
 268 gamma_ty = UniTyVar gamma_tyvar
 269 delta_ty = UniTyVar delta_tyvar
 270 epsilon_ty = UniTyVar epsilon_tyvar
 271
 272 mkRhoTy :: ThetaType -> TauType -> RhoType
 273 mkRhoTy theta tau
 274   = foldr mk_dict tau theta
 275   where
 276     mk_dict (clas,ty) ty_body = UniFun (UniDict clas ty) ty_body
 277
 278 mkForallTy [] ty = ty
 279 mkForallTy tyvars ty = foldr UniForall ty tyvars
 280
 281 mkSigmaTy :: [TyVarTemplate] -> ThetaType -> TauType -> SigmaType
 282 mkSigmaTy tyvars theta tau = foldr UniForall (mkRhoTy theta tau) tyvars
 283 \end{code}
 284
 285 @quantifyTy@ takes @TyVars@ (not templates) and a  @SigmaType@, and quantifies
 286 over them.  It makes new template type variables, and substitutes for the
 287 original variables in the body.
 288
 289 \begin{code}
 290 quantifyTy :: [TyVar] -> SigmaType -> ([TyVarTemplate], SigmaType)
 291
 292 quantifyTy [] ty = ([], ty)     -- Simple, common case
 293
 294 quantifyTy tyvars ty
 295  = (templates, foldr UniForall (quant ty) templates)
 296  where
 297    templates = mkTemplateTyVars tyvars
 298    env       = tyvars `zip` (map UniTyVarTemplate templates)
 299
 300    quant :: SigmaType -> SigmaType      -- Rename the quantified type variables
 301                                         -- to their template equivalents
 302
 303    quant old_ty@(UniTyVar v)  = case (assocMaybe env v) of
 304                                   Nothing -> old_ty     -- We may not be quantifying
 305                                                         -- over all the type vars!
 306                                   Just ty -> ty
 307
 308    quant ty@(UniTyVarTemplate v) = ty
 309    quant ty@(UniData con [])  = ty
 310    quant (UniData con tys)    = UniData con (map quant tys)
 311    quant (UniSyn con tys ty)  = UniSyn con (map quant tys) (quant ty)
 312    quant (UniFun ty1 ty2)     = UniFun (quant ty1) (quant ty2)
 313    quant (UniDict clas ty)    = UniDict clas (quant ty)
 314
 315    quant (UniForall tv ty)    =
 316 #ifdef DEBUG
 317                                 -- Paranoia check here; shouldn't happen
 318                                 if tv `elem` templates then
 319                                         panic "quantifyTy"
 320                                 else
 321 #endif
 322                                         UniForall tv (quant ty)
 323 \end{code}
 324
 325 @instantiateTy@ is the inverse.  It instantiates the free @TyVarTemplates@
 326 of a type.  We assume that no inner Foralls bind one of the variables
 327 being instantiated.
 328
 329 \begin{code}
 330 instantiateTy    :: InstTyEnv -> UniType -> UniType
 331
 332 instantiateTy [] ty = ty        -- Simple, common case
 333
 334 instantiateTy env ty
 335   = inst ty
 336   where
 337     inst ty@(UniTyVar v)      = ty
 338     inst ty@(UniData con [])  = ty
 339     inst (UniData con tys)    = UniData con (map inst tys)
 340     inst (UniFun ty1 ty2)     = UniFun (inst ty1) (inst ty2)
 341     inst (UniSyn con tys ty)  = UniSyn  con (map inst tys) (inst ty)
 342     inst (UniDict clas ty)    = UniDict clas (inst ty)
 343     inst (UniForall v ty)     = UniForall v (inst ty)
 344
 345     inst old_ty@(UniTyVarTemplate v) = case (assocMaybe env v) of
 346                                          Nothing -> old_ty  -- May partially instantiate
 347                                          Just ty -> ty
 348 \end{code}
 349 The case mentioned in the comment (ie when the template isn't in the envt)
 350 occurs when we instantiate a class op type before instantiating with the class
 351 variable itself.
 352 \begin{code}
 353 instantiateTauTy :: InstTyEnv -> TauType -> TauType
 354 instantiateTauTy tenv ty = instantiateTy tenv ty
 355
 356 instantiateThetaTy :: InstTyEnv -> ThetaType -> ThetaType
 357 instantiateThetaTy tenv theta
 358  = [(clas,instantiateTauTy tenv ty) | (clas,ty) <- theta]
 359 \end{code}
 360
 361 %************************************************************************
 362 %*                                                                      *
 363 \subsection[UniType-instances]{Instance declarations for @UniType@}
 364 %*                                                                      *
 365 %************************************************************************
 366
 367 \begin{code}
 368 instance Outputable UniType where
 369     ppr = pprUniType
 370 \end{code}