ghc/compiler/uniType/TyVar.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[TyVar]{Type variables}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module TyVar (
  10         TyVar(..),      -- non-abstract for unifier's benefit
  11         TyVarTemplate,
  12
  13         mkUserTyVar, mkPolySysTyVar, mkOpenSysTyVar,
  14 --UNUSED: mkPrimSysTyVar, isPrimTyVar,
  15
  16 --      getTyVarUnique,
  17
  18         cmpTyVar, eqTyVar, ltTyVar,  -- used a lot!
  19
  20         mkUserTyVarTemplate, mkSysTyVarTemplate, mkTemplateTyVars,
  21
  22         cloneTyVarFromTemplate,
  23         cloneTyVar,
  24         instantiateTyVarTemplates,
  25
  26         -- a supply of template tyvars
  27         alphaTyVars,
  28         alpha_tv, beta_tv, gamma_tv, delta_tv, epsilon_tv,               -- templates
  29         alpha_tyvar, beta_tyvar, gamma_tyvar, delta_tyvar, epsilon_tyvar,-- real tyvars
  30
  31         -- so the module is self-contained...
  32         ShortName
  33     ) where
  34
  35 import NameTypes        ( ShortName )
  36 import Outputable       -- class for printing, forcing
  37 import Pretty           -- pretty-printing utilities
  38 import SrcLoc           ( SrcLoc, mkUnknownSrcLoc )
  39 import Unique
  40 import UniType          ( mkTyVarTy, TauType(..), InstTyEnv(..), UniType
  41                           IF_ATTACK_PRAGMAS(COMMA cmpUniType)
  42                         )
  43 import Util
  44
  45 #ifndef __GLASGOW_HASKELL__
  46 {-hide import from mkdependHS-}
  47 import
  48         Word
  49 #endif
  50 \end{code}
  51
  52 %************************************************************************
  53 %*                                                                      *
  54 \subsection[TyVar-basics]{@TyVar@ type and basic operations}
  55 %*                                                                      *
  56 %************************************************************************
  57
  58 We distinguish system from user type variables so that the unifier can
  59 bias in terms of replacing system with user ones rather than vice
  60 versa.
  61
  62 \begin{code}
  63 data TyVar
  64   = PrimSysTyVar        -- Can only be unified with a primitive type
  65         Unique  -- Cannot be generalised
  66                         -- Introduced by ccalls
  67
  68   | PolySysTyVar        -- Can only be unified with a boxed type
  69         Unique  -- Can be generalised
  70                         -- Introduced when a polymorphic type is instantiated
  71
  72   | OpenSysTyVar        -- Can unify with any type at all
  73         Unique  -- Can be generalised, but remember that the resulting
  74                         -- polymorphic type will be instantiated with PolySysTyVars
  75                         -- Introduced by lambda bindings
  76
  77   | UserTyVar           -- This is exactly like PolySysTyVar except that it
  78         Unique  -- has a name attached, derived from something the user typed
  79         ShortName
  80
  81 -- **** NB: Unboxed but non-primitive things (which don't exist at all at present)
  82 --          are not catered for by the above scheme.
  83
  84 mkPolySysTyVar = PolySysTyVar
  85 mkUserTyVar    = UserTyVar
  86 mkOpenSysTyVar = OpenSysTyVar
  87 --UNUSED:mkPrimSysTyVar = PrimSysTyVar
  88
  89 {-UNUSED
  90 isPrimTyVar (PrimSysTyVar _) = True
  91 isPrimTyVar other            = False
  92 -}
  93
  94 -- Make a tyvar from a template, given also a unique
  95 cloneTyVarFromTemplate :: TyVarTemplate -> Unique -> TyVar
  96 cloneTyVarFromTemplate (SysTyVarTemplate  _ _) uniq = PolySysTyVar uniq
  97 cloneTyVarFromTemplate (UserTyVarTemplate _ n) uniq = UserTyVar    uniq n
  98
  99 instantiateTyVarTemplates
 100         ::  [TyVarTemplate]
 101         ->  [Unique]
 102         -> (InstTyEnv,  -- Old-to-new assoc list
 103             [TyVar],    -- New type vars
 104             [TauType])  -- New type vars wrapped in a UniTyVar
 105 instantiateTyVarTemplates tv_tmpls uniqs
 106   = --pprTrace "instTyVarTemplates:" (ppr PprDebug new_tys)
 107     (tv_tmpls `zipEqual` new_tys, new_tyvars, new_tys)
 108   where
 109     new_tyvars = zipWith cloneTyVarFromTemplate tv_tmpls uniqs
 110     new_tys    = map mkTyVarTy new_tyvars
 111
 112 getTyVarUnique :: TyVar -> Unique
 113 getTyVarUnique (PolySysTyVar  u) = u
 114 getTyVarUnique (PrimSysTyVar  u) = u
 115 getTyVarUnique (OpenSysTyVar  u) = u
 116 getTyVarUnique (UserTyVar   u _) = u
 117 \end{code}
 118
 119 Make a new TyVar ``just like'' another one, but w/ a new @Unique@.
 120 Used when cloning big lambdas.  his is only required after
 121 typechecking so the @TyVarUnique@ is just a normal @Unique@.
 122
 123 \begin{code}
 124 cloneTyVar :: TyVar -> Unique -> TyVar
 125
 126 cloneTyVar (PolySysTyVar  _) uniq = PolySysTyVar uniq
 127 cloneTyVar (PrimSysTyVar  _) uniq = PrimSysTyVar uniq
 128 cloneTyVar (OpenSysTyVar  _) uniq = OpenSysTyVar uniq
 129 cloneTyVar (UserTyVar _   n) uniq = UserTyVar    uniq n
 130 \end{code}
 131
 132 %************************************************************************
 133 %*                                                                      *
 134 \subsection[TyVar-template]{The @TyVarTemplate@ type}
 135 %*                                                                      *
 136 %************************************************************************
 137
 138 A @TyVarTemplate@ is a type variable which is used by @UniForall@ to
 139 universally quantify a type.  It only occurs in a {\em binding}
 140 position in a @UniForall@, not (for example) in a @TyLam@ or
 141 @AbsBinds@.  Every occurrence of a @TyVarTemplate@ in a @UniType@ is
 142 bound by an enclosing @UniForall@, with the sole exception that the
 143 type in a @ClassOp@ has a free @TyVarTemplate@ which is the class type
 144 variable; it is found in the corresponding @Class@ object.
 145
 146 \begin{code}
 147 data TyVarTemplate
 148   = SysTyVarTemplate  Unique FAST_STRING
 149   | UserTyVarTemplate Unique ShortName
 150
 151 mkSysTyVarTemplate  = SysTyVarTemplate
 152 mkUserTyVarTemplate = UserTyVarTemplate
 153
 154 getTyVarTemplateUnique (SysTyVarTemplate  u _) = u
 155 getTyVarTemplateUnique (UserTyVarTemplate u _) = u
 156 \end{code}
 157
 158 \begin{code}
 159 alpha_tv, beta_tv, gamma_tv, delta_tv, epsilon_tv :: TyVarTemplate
 160 alpha_tv   = SysTyVarTemplate (mkBuiltinUnique 1) SLIT("a")
 161 beta_tv    = SysTyVarTemplate (mkBuiltinUnique 2) SLIT("b")
 162 gamma_tv   = SysTyVarTemplate (mkBuiltinUnique 3) SLIT("c")
 163 delta_tv   = SysTyVarTemplate (mkBuiltinUnique 4) SLIT("d")
 164 epsilon_tv = SysTyVarTemplate (mkBuiltinUnique 5) SLIT("e")
 165
 166 alpha_tyvar, beta_tyvar, gamma_tyvar, delta_tyvar, epsilon_tyvar :: TyVar
 167 alpha_tyvar   = PolySysTyVar (mkBuiltinUnique 1)
 168 beta_tyvar    = PolySysTyVar (mkBuiltinUnique 2)
 169 gamma_tyvar   = PolySysTyVar (mkBuiltinUnique 3)
 170 delta_tyvar   = PolySysTyVar (mkBuiltinUnique 4)
 171 epsilon_tyvar = PolySysTyVar (mkBuiltinUnique 5)
 172
 173 -- these are used in tuple magic (see TyCon.lhs and Id.lhs)
 174 alphaTyVars :: [TyVarTemplate]
 175 alphaTyVars = alphas_from (10::Int) tyVarStrings
 176     where
 177       alphas_from :: Int -> [FAST_STRING] -> [TyVarTemplate]
 178       alphas_from n (s:ss)
 179         = SysTyVarTemplate (mkBuiltinUnique n) s : (alphas_from (n+1) ss)
 180
 181 tyVarStrings :: [FAST_STRING]
 182 tyVarStrings
 183   =  letter_strs {- a..y -} ++ number_strs {- z0 ... zN -}
 184   where
 185     letter_strs = [ _PK_ [c]           | c <- ['d' .. 'y'] ]
 186     number_strs = [ _PK_ ('z': show n) | n <- ([0   .. ] :: [Int]) ]
 187 \end{code}
 188
 189 @mkTemplateTyVars@ creates new template type variables, giving them
 190 the same name and unique as the type variable given to it.  (The name
 191 is for documentation purposes; the unique could just as well be
 192 fresh.)
 193
 194 \begin{code}
 195 mkTemplateTyVars :: [TyVar] -> [TyVarTemplate]
 196
 197 mkTemplateTyVars tyvars
 198   = zipWith mk_tmpl tyvars tyVarStrings
 199   where
 200     mk_tmpl (UserTyVar u name) str = UserTyVarTemplate u name
 201     mk_tmpl (PolySysTyVar u)   str = SysTyVarTemplate  u str
 202     mk_tmpl (OpenSysTyVar u)   str = SysTyVarTemplate  u str
 203 \end{code}
 204
 205 %************************************************************************
 206 %*                                                                      *
 207 \subsection[TyVar-instances]{Instance declarations for @TyVar@}
 208 %*                                                                      *
 209 %************************************************************************
 210
 211 @TyVars@s are compared by comparing their @Unique@s.  (Often!)
 212 \begin{code}
 213 cmpTyVar (PolySysTyVar  u1) (PolySysTyVar  u2) = u1 `cmpUnique` u2
 214 cmpTyVar (PrimSysTyVar  u1) (PrimSysTyVar  u2) = u1 `cmpUnique` u2
 215 cmpTyVar (OpenSysTyVar  u1) (OpenSysTyVar  u2) = u1 `cmpUnique` u2
 216 cmpTyVar (UserTyVar   u1 _) (UserTyVar   u2 _) = u1 `cmpUnique` u2
 217 cmpTyVar other_1            other_2
 218   = let tag1 = tag other_1
 219         tag2 = tag other_2
 220     in
 221     if tag1 _LT_ tag2 then LT_ else GT_
 222   where
 223     tag (PolySysTyVar  _) = (ILIT(1) :: FAST_INT)
 224     tag (PrimSysTyVar  _) = ILIT(2)
 225     tag (OpenSysTyVar  _) = ILIT(3)
 226     tag (UserTyVar   _ _) = ILIT(4)
 227 \end{code}
 228
 229 \begin{code}
 230 eqTyVar a b = case cmpTyVar a b of { EQ_ -> True;  _   -> False }
 231 ltTyVar a b = case cmpTyVar a b of { LT_ -> True;  EQ_ -> False; GT__ -> False }
 232
 233 instance Eq TyVar where
 234     a == b = case cmpTyVar a b of { EQ_ -> True;   _ -> False }
 235     a /= b = case cmpTyVar a b of { EQ_ -> False;  _ -> True  }
 236
 237 instance Ord TyVar where
 238     a <= b = case cmpTyVar a b of { LT_ -> True;  EQ_ -> True;  GT__ -> False }
 239     a <  b = case cmpTyVar a b of { LT_ -> True;  EQ_ -> False; GT__ -> False }
 240     a >= b = case cmpTyVar a b of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
 241     a >  b = case cmpTyVar a b of { LT_ -> False; EQ_ -> False; GT__ -> True  }
 242 #ifdef __GLASGOW_HASKELL__
 243     _tagCmp a b = case cmpTyVar a b of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
 244 #endif
 245 \end{code}
 246 (@Ord@ for @TyVars@ is needed for the @sortLt@ in @TcSimplify@.)
 247
 248 \begin{code}
 249 instance NamedThing TyVar where
 250     getExportFlag       tyvar           = NotExported
 251     isLocallyDefined    tyvar           = True
 252
 253     getOrigName         (UserTyVar _ n) = (panic "NamedThing.TyVar.getOrigName(UserTyVar)",
 254                                            getLocalName n)
 255     getOrigName         tyvar           = (panic "NamedThing.TyVar.getOrigName(SysTyVar)",
 256                                            _PK_ ('t' : (_UNPK_ (showUnique (getTyVarUnique tyvar)))))
 257
 258     getOccurrenceName   (UserTyVar _ n) = getOccurrenceName n
 259     getOccurrenceName   tyvar           = _PK_ ('t' : (_UNPK_ (showUnique (getTyVarUnique tyvar))))
 260
 261     getInformingModules  tyvar          = panic "getInformingModule:TyVar"
 262
 263     getSrcLoc           (UserTyVar _ n) = getSrcLoc n
 264     getSrcLoc           _               = mkUnknownSrcLoc
 265
 266     getTheUnique        tyvar           = getTyVarUnique tyvar
 267
 268     fromPreludeCore     _               = False
 269 \end{code}
 270
 271 \begin{code}
 272 instance Outputable TyVar where
 273     ppr sty (PolySysTyVar  u)  = ppr_tyvar sty (ppChar 't')   u
 274     ppr sty (PrimSysTyVar  u)  = ppr_tyvar sty (ppChar 'p')   u
 275     ppr sty (OpenSysTyVar  u)  = ppr_tyvar sty (ppChar 'o')   u
 276     ppr sty (UserTyVar u name) = ppr_tyvar sty (ppr sty name) u
 277
 278 ppr_tyvar sty name u
 279   = case sty of
 280       --OLD: PprForUser -> name
 281       PprDebug       -> pprUnique10 u
 282       PprUnfolding _ -> pprUnique10 u
 283       _              -> ppBesides [name, ppChar '.', pprUnique10 u]
 284 \end{code}
 285
 286 %************************************************************************
 287 %*                                                                      *
 288 \subsection[TyVarTemplate-instances]{Instance declarations for @TyVarTemplates@}
 289 %*                                                                      *
 290 %************************************************************************
 291
 292 \begin{code}
 293 instance Eq TyVarTemplate where
 294     a == b = getTyVarTemplateUnique a == getTyVarTemplateUnique b
 295     a /= b = getTyVarTemplateUnique a /= getTyVarTemplateUnique b
 296 \end{code}
 297
 298 \begin{code}
 299 instance Ord TyVarTemplate where
 300     a <= b = getTyVarTemplateUnique a <= getTyVarTemplateUnique b
 301     a <  b = getTyVarTemplateUnique a <  getTyVarTemplateUnique b
 302     a >= b = getTyVarTemplateUnique a >= getTyVarTemplateUnique b
 303     a >  b = getTyVarTemplateUnique a >  getTyVarTemplateUnique b
 304 #ifdef __GLASGOW_HASKELL__
 305     _tagCmp a b = case cmpUnique (getTyVarTemplateUnique a) (getTyVarTemplateUnique b)
 306                     of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
 307 #endif
 308 \end{code}
 309
 310 \begin{code}
 311 instance NamedThing TyVarTemplate where
 312     getExportFlag       tyvar           = NotExported
 313     isLocallyDefined    tyvar           = True
 314
 315     getOrigName         (UserTyVarTemplate _ n) = (panic "NamedThing.TyVar.getOrigName(UserTyVarTemplate)",
 316                                            getLocalName n)
 317     getOrigName         tyvar           = (panic "NamedThing.TyVar.getOrigName(SysTyVarTemplate)",
 318                                            _PK_ ('t' : (_UNPK_ (showUnique (getTyVarTemplateUnique tyvar)))))
 319
 320     getOccurrenceName   (UserTyVarTemplate _ n) = getOccurrenceName n
 321     getOccurrenceName   tyvar           = _PK_ ('t' : (_UNPK_ (showUnique (getTyVarTemplateUnique tyvar))))
 322
 323     getInformingModules tyvar           = panic "getInformingModule:TyVarTemplate"
 324
 325     getSrcLoc           (UserTyVarTemplate _ n) = getSrcLoc n
 326     getSrcLoc           _               = mkUnknownSrcLoc
 327
 328     getTheUnique        tyvar           = getTyVarTemplateUnique tyvar
 329
 330     fromPreludeCore     _               = False
 331 \end{code}
 332
 333 \begin{code}
 334 instance Outputable TyVarTemplate where
 335     ppr sty (SysTyVarTemplate  u name)
 336       = case sty of
 337 --OLD:    PprForUser -> ppPStr name
 338           _          -> ppBesides [ppPStr name, ppChar '$', pprUnique10 u]
 339
 340     ppr sty (UserTyVarTemplate u name)
 341       = case sty of
 342 --OLD:    PprForUser -> ppr sty name
 343           _          -> ppBesides [ppr sty name, ppChar '$', pprUnique10 u]
 344 \end{code}