ghc/compiler/prelude/TysWiredIn.lhs

   1 %
   2 % (c) The GRASP Project, Glasgow University, 1994-1995
   3 %
   4 \section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types}
   5
   6 This module is about types that can be defined in Haskell, but which
   7 must be wired into the compiler nonetheless.
   8
   9 This module tracks the ``state interface'' document, ``GHC prelude:
  10 types and operations.''
  11
  12 \begin{code}
  13 #include "HsVersions.h"
  14
  15 module TysWiredIn (
  16         addrDataCon,
  17         addrTy,
  18         addrTyCon,
  19         boolTy,
  20         boolTyCon,
  21         charDataCon,
  22         charTy,
  23         charTyCon,
  24         consDataCon,
  25         doubleDataCon,
  26         doubleTy,
  27         doubleTyCon,
  28         eqDataCon,
  29         falseDataCon,
  30         floatDataCon,
  31         floatTy,
  32         floatTyCon,
  33         getStatePairingConInfo,
  34         gtDataCon,
  35         intDataCon,
  36         intTy,
  37         intTyCon,
  38         integerTy,
  39         integerTyCon,
  40         integerDataCon,
  41         liftDataCon,
  42         liftTyCon,
  43         listTyCon,
  44         ltDataCon,
  45         foreignObjTyCon,
  46         mkLiftTy,
  47         mkListTy,
  48         mkPrimIoTy,
  49         mkStateTransformerTy,
  50         mkTupleTy,
  51         nilDataCon,
  52         orderingTy,
  53         orderingTyCon,
  54         primIoTyCon,
  55         ratioDataCon,
  56         ratioTyCon,
  57         rationalTy,
  58         rationalTyCon,
  59         realWorldStateTy,
  60         return2GMPsTyCon,
  61         returnIntAndGMPTyCon,
  62         stTyCon,
  63         stablePtrTyCon,
  64         stateAndAddrPrimTyCon,
  65         stateAndArrayPrimTyCon,
  66         stateAndByteArrayPrimTyCon,
  67         stateAndCharPrimTyCon,
  68         stateAndDoublePrimTyCon,
  69         stateAndFloatPrimTyCon,
  70         stateAndIntPrimTyCon,
  71         stateAndForeignObjPrimTyCon,
  72         stateAndMutableArrayPrimTyCon,
  73         stateAndMutableByteArrayPrimTyCon,
  74         stateAndPtrPrimTyCon,
  75         stateAndStablePtrPrimTyCon,
  76         stateAndSynchVarPrimTyCon,
  77         stateAndWordPrimTyCon,
  78         stateDataCon,
  79         stateTyCon,
  80         stringTy,
  81         stringTyCon,
  82         trueDataCon,
  83         unitTy,
  84         voidTy, voidTyCon,
  85         wordDataCon,
  86         wordTy,
  87         wordTyCon
  88
  89     ) where
  90
  91 --ToDo:rm
  92 --import Pretty
  93 --import Util
  94 --import PprType
  95 --import PprStyle
  96 --import Kind
  97
  98 import Ubiq
  99 import TyLoop           ( mkDataCon, StrictnessMark(..) )
 100
 101 -- friends:
 102 import PrelMods
 103 import TysPrim
 104
 105 -- others:
 106 import SpecEnv          ( SpecEnv(..) )
 107 import Kind             ( mkBoxedTypeKind, mkArrowKind )
 108 import Name             ( mkBuiltinName )
 109 import SrcLoc           ( mkBuiltinSrcLoc )
 110 import TyCon            ( mkDataTyCon, mkTupleTyCon, mkSynTyCon,
 111                           NewOrData(..), TyCon
 112                         )
 113 import Type             ( mkTyConTy, applyTyCon, mkSynTy, mkSigmaTy,
 114                           mkFunTys, maybeAppDataTyConExpandingDicts,
 115                           GenType(..), ThetaType(..), TauType(..) )
 116 import TyVar            ( tyVarKind, alphaTyVar, betaTyVar )
 117 import Unique
 118 import Util             ( assoc, panic )
 119
 120 nullSpecEnv =  error "TysWiredIn:nullSpecEnv =  "
 121 addOneToSpecEnv =  error "TysWiredIn:addOneToSpecEnv =  "
 122 pc_gen_specs = error "TysWiredIn:pc_gen_specs  "
 123 mkSpecInfo = error "TysWiredIn:SpecInfo"
 124
 125 pcDataTyCon :: Unique{-TyConKey-} -> Module -> FAST_STRING
 126             -> [TyVar] -> [Id] -> TyCon
 127 pcDataTyCon key mod str tyvars cons
 128   = mkDataTyCon (mkBuiltinName key mod str) tycon_kind
 129                 tyvars [{-no context-}] cons [{-no derivings-}]
 130                 DataType
 131   where
 132     tycon_kind = foldr (mkArrowKind . tyVarKind) mkBoxedTypeKind tyvars
 133
 134 pcDataCon :: Unique{-DataConKey-} -> Module -> FAST_STRING
 135           -> [TyVar] -> ThetaType -> [TauType] -> TyCon -> SpecEnv -> Id
 136 pcDataCon key mod str tyvars context arg_tys tycon specenv
 137   = mkDataCon (mkBuiltinName key mod str)
 138         [ NotMarkedStrict | a <- arg_tys ]
 139         [ {- no labelled fields -} ]
 140         tyvars context arg_tys tycon
 141         -- specenv
 142
 143 pcGenerateDataSpecs :: Type -> SpecEnv
 144 pcGenerateDataSpecs ty
 145   = pc_gen_specs False err err err ty
 146   where
 147     err = panic "PrelUtils:GenerateDataSpecs"
 148 \end{code}
 149
 150 %************************************************************************
 151 %*                                                                      *
 152 \subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)}
 153 %*                                                                      *
 154 %************************************************************************
 155
 156 \begin{code}
 157 -- The Void type is represented as a data type with no constructors
 158 voidTy = mkTyConTy voidTyCon
 159
 160 voidTyCon = pcDataTyCon voidTyConKey pRELUDE_BUILTIN SLIT("Void") [] []
 161 \end{code}
 162
 163 \begin{code}
 164 charTy = mkTyConTy charTyCon
 165
 166 charTyCon = pcDataTyCon charTyConKey pRELUDE_BUILTIN SLIT("Char") [] [charDataCon]
 167 charDataCon = pcDataCon charDataConKey pRELUDE_BUILTIN SLIT("C#") [] [] [charPrimTy] charTyCon nullSpecEnv
 168 \end{code}
 169
 170 \begin{code}
 171 intTy = mkTyConTy intTyCon
 172
 173 intTyCon = pcDataTyCon intTyConKey pRELUDE_BUILTIN SLIT("Int") [] [intDataCon]
 174 intDataCon = pcDataCon intDataConKey pRELUDE_BUILTIN SLIT("I#") [] [] [intPrimTy] intTyCon nullSpecEnv
 175 \end{code}
 176
 177 \begin{code}
 178 wordTy = mkTyConTy wordTyCon
 179
 180 wordTyCon = pcDataTyCon wordTyConKey pRELUDE_BUILTIN SLIT("_Word") [] [wordDataCon]
 181 wordDataCon = pcDataCon wordDataConKey pRELUDE_BUILTIN SLIT("W#") [] [] [wordPrimTy] wordTyCon nullSpecEnv
 182 \end{code}
 183
 184 \begin{code}
 185 addrTy = mkTyConTy addrTyCon
 186
 187 addrTyCon = pcDataTyCon addrTyConKey pRELUDE_BUILTIN SLIT("_Addr") [] [addrDataCon]
 188 addrDataCon = pcDataCon addrDataConKey pRELUDE_BUILTIN SLIT("A#") [] [] [addrPrimTy] addrTyCon nullSpecEnv
 189 \end{code}
 190
 191 \begin{code}
 192 floatTy = mkTyConTy floatTyCon
 193
 194 floatTyCon = pcDataTyCon floatTyConKey pRELUDE_BUILTIN SLIT("Float") [] [floatDataCon]
 195 floatDataCon = pcDataCon floatDataConKey pRELUDE_BUILTIN SLIT("F#") [] [] [floatPrimTy] floatTyCon nullSpecEnv
 196 \end{code}
 197
 198 \begin{code}
 199 doubleTy = mkTyConTy doubleTyCon
 200
 201 doubleTyCon = pcDataTyCon doubleTyConKey pRELUDE_BUILTIN SLIT("Double") [] [doubleDataCon]
 202 doubleDataCon = pcDataCon doubleDataConKey pRELUDE_BUILTIN SLIT("D#") [] [] [doublePrimTy] doubleTyCon nullSpecEnv
 203 \end{code}
 204
 205 \begin{code}
 206 mkStateTy ty     = applyTyCon stateTyCon [ty]
 207 realWorldStateTy = mkStateTy realWorldTy -- a common use
 208
 209 stateTyCon = pcDataTyCon stateTyConKey pRELUDE_BUILTIN SLIT("_State") [alphaTyVar] [stateDataCon]
 210 stateDataCon
 211   = pcDataCon stateDataConKey pRELUDE_BUILTIN SLIT("S#")
 212         [alphaTyVar] [] [mkStatePrimTy alphaTy] stateTyCon nullSpecEnv
 213 \end{code}
 214
 215 \begin{code}
 216 stablePtrTyCon
 217   = pcDataTyCon stablePtrTyConKey gLASGOW_MISC SLIT("_StablePtr")
 218         [alphaTyVar] [stablePtrDataCon]
 219   where
 220     stablePtrDataCon
 221       = pcDataCon stablePtrDataConKey gLASGOW_MISC SLIT("_StablePtr")
 222             [alphaTyVar] [] [mkStablePtrPrimTy alphaTy] stablePtrTyCon nullSpecEnv
 223 \end{code}
 224
 225 \begin{code}
 226 foreignObjTyCon
 227   = pcDataTyCon foreignObjTyConKey gLASGOW_MISC SLIT("_ForeignObj")
 228         [] [foreignObjDataCon]
 229   where
 230     foreignObjDataCon
 231       = pcDataCon foreignObjDataConKey gLASGOW_MISC SLIT("_ForeignObj")
 232             [] [] [foreignObjPrimTy] foreignObjTyCon nullSpecEnv
 233 \end{code}
 234
 235 %************************************************************************
 236 %*                                                                      *
 237 \subsection[TysWiredIn-Integer]{@Integer@ and its related ``pairing'' types}
 238 %*                                                                      *
 239 %************************************************************************
 240
 241 @Integer@ and its pals are not really primitive.  @Integer@ itself, first:
 242 \begin{code}
 243 integerTy :: GenType t u
 244 integerTy    = mkTyConTy integerTyCon
 245
 246 integerTyCon = pcDataTyCon integerTyConKey pRELUDE_BUILTIN SLIT("Integer") [] [integerDataCon]
 247
 248 integerDataCon = pcDataCon integerDataConKey pRELUDE_BUILTIN SLIT("J#")
 249                 [] [] [intPrimTy, intPrimTy, byteArrayPrimTy] integerTyCon nullSpecEnv
 250 \end{code}
 251
 252 And the other pairing types:
 253 \begin{code}
 254 return2GMPsTyCon = pcDataTyCon return2GMPsTyConKey
 255         pRELUDE_BUILTIN SLIT("_Return2GMPs") [] [return2GMPsDataCon]
 256
 257 return2GMPsDataCon
 258   = pcDataCon return2GMPsDataConKey pRELUDE_BUILTIN SLIT("_Return2GMPs") [] []
 259         [intPrimTy, intPrimTy, byteArrayPrimTy,
 260          intPrimTy, intPrimTy, byteArrayPrimTy] return2GMPsTyCon nullSpecEnv
 261
 262 returnIntAndGMPTyCon = pcDataTyCon returnIntAndGMPTyConKey
 263         pRELUDE_BUILTIN SLIT("_ReturnIntAndGMP") [] [returnIntAndGMPDataCon]
 264
 265 returnIntAndGMPDataCon
 266   = pcDataCon returnIntAndGMPDataConKey pRELUDE_BUILTIN SLIT("_ReturnIntAndGMP") [] []
 267         [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy] returnIntAndGMPTyCon nullSpecEnv
 268 \end{code}
 269
 270 %************************************************************************
 271 %*                                                                      *
 272 \subsection[TysWiredIn-state-pairing]{``State-pairing'' types}
 273 %*                                                                      *
 274 %************************************************************************
 275
 276 These boring types pair a \tr{State#} with another primitive type.
 277 They are not really primitive, so they are given here, not in
 278 \tr{TysPrim.lhs}.
 279
 280 We fish one of these \tr{StateAnd<blah>#} things with
 281 @getStatePairingConInfo@ (given a little way down).
 282
 283 \begin{code}
 284 stateAndPtrPrimTyCon
 285   = pcDataTyCon stateAndPtrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndPtr#")
 286                 [alphaTyVar, betaTyVar] [stateAndPtrPrimDataCon]
 287 stateAndPtrPrimDataCon
 288   = pcDataCon stateAndPtrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndPtr#")
 289                 [alphaTyVar, betaTyVar] [] [mkStatePrimTy alphaTy, betaTy]
 290                 stateAndPtrPrimTyCon nullSpecEnv
 291
 292 stateAndCharPrimTyCon
 293   = pcDataTyCon stateAndCharPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndChar#")
 294                 [alphaTyVar] [stateAndCharPrimDataCon]
 295 stateAndCharPrimDataCon
 296   = pcDataCon stateAndCharPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndChar#")
 297                 [alphaTyVar] [] [mkStatePrimTy alphaTy, charPrimTy]
 298                 stateAndCharPrimTyCon nullSpecEnv
 299
 300 stateAndIntPrimTyCon
 301   = pcDataTyCon stateAndIntPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndInt#")
 302                 [alphaTyVar] [stateAndIntPrimDataCon]
 303 stateAndIntPrimDataCon
 304   = pcDataCon stateAndIntPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndInt#")
 305                 [alphaTyVar] [] [mkStatePrimTy alphaTy, intPrimTy]
 306                 stateAndIntPrimTyCon nullSpecEnv
 307
 308 stateAndWordPrimTyCon
 309   = pcDataTyCon stateAndWordPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndWord#")
 310                 [alphaTyVar] [stateAndWordPrimDataCon]
 311 stateAndWordPrimDataCon
 312   = pcDataCon stateAndWordPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndWord#")
 313                 [alphaTyVar] [] [mkStatePrimTy alphaTy, wordPrimTy]
 314                 stateAndWordPrimTyCon nullSpecEnv
 315
 316 stateAndAddrPrimTyCon
 317   = pcDataTyCon stateAndAddrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndAddr#")
 318                 [alphaTyVar] [stateAndAddrPrimDataCon]
 319 stateAndAddrPrimDataCon
 320   = pcDataCon stateAndAddrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndAddr#")
 321                 [alphaTyVar] [] [mkStatePrimTy alphaTy, addrPrimTy]
 322                 stateAndAddrPrimTyCon nullSpecEnv
 323
 324 stateAndStablePtrPrimTyCon
 325   = pcDataTyCon stateAndStablePtrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndStablePtr#")
 326                 [alphaTyVar, betaTyVar] [stateAndStablePtrPrimDataCon]
 327 stateAndStablePtrPrimDataCon
 328   = pcDataCon stateAndStablePtrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndStablePtr#")
 329                 [alphaTyVar, betaTyVar] []
 330                 [mkStatePrimTy alphaTy, applyTyCon stablePtrPrimTyCon [betaTy]]
 331                 stateAndStablePtrPrimTyCon nullSpecEnv
 332
 333 stateAndForeignObjPrimTyCon
 334   = pcDataTyCon stateAndForeignObjPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndForeignObj#")
 335                 [alphaTyVar] [stateAndForeignObjPrimDataCon]
 336 stateAndForeignObjPrimDataCon
 337   = pcDataCon stateAndForeignObjPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndForeignObj#")
 338                 [alphaTyVar] []
 339                 [mkStatePrimTy alphaTy, applyTyCon foreignObjPrimTyCon []]
 340                 stateAndForeignObjPrimTyCon nullSpecEnv
 341
 342 stateAndFloatPrimTyCon
 343   = pcDataTyCon stateAndFloatPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndFloat#")
 344                 [alphaTyVar] [stateAndFloatPrimDataCon]
 345 stateAndFloatPrimDataCon
 346   = pcDataCon stateAndFloatPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndFloat#")
 347                 [alphaTyVar] [] [mkStatePrimTy alphaTy, floatPrimTy]
 348                 stateAndFloatPrimTyCon nullSpecEnv
 349
 350 stateAndDoublePrimTyCon
 351   = pcDataTyCon stateAndDoublePrimTyConKey pRELUDE_BUILTIN SLIT("StateAndDouble#")
 352                 [alphaTyVar] [stateAndDoublePrimDataCon]
 353 stateAndDoublePrimDataCon
 354   = pcDataCon stateAndDoublePrimDataConKey pRELUDE_BUILTIN SLIT("StateAndDouble#")
 355                 [alphaTyVar] [] [mkStatePrimTy alphaTy, doublePrimTy]
 356                 stateAndDoublePrimTyCon nullSpecEnv
 357 \end{code}
 358
 359 \begin{code}
 360 stateAndArrayPrimTyCon
 361   = pcDataTyCon stateAndArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndArray#")
 362                 [alphaTyVar, betaTyVar] [stateAndArrayPrimDataCon]
 363 stateAndArrayPrimDataCon
 364   = pcDataCon stateAndArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndArray#")
 365                 [alphaTyVar, betaTyVar] [] [mkStatePrimTy alphaTy, mkArrayPrimTy betaTy]
 366                 stateAndArrayPrimTyCon nullSpecEnv
 367
 368 stateAndMutableArrayPrimTyCon
 369   = pcDataTyCon stateAndMutableArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndMutableArray#")
 370                 [alphaTyVar, betaTyVar] [stateAndMutableArrayPrimDataCon]
 371 stateAndMutableArrayPrimDataCon
 372   = pcDataCon stateAndMutableArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndMutableArray#")
 373                 [alphaTyVar, betaTyVar] [] [mkStatePrimTy alphaTy, mkMutableArrayPrimTy alphaTy betaTy]
 374                 stateAndMutableArrayPrimTyCon nullSpecEnv
 375
 376 stateAndByteArrayPrimTyCon
 377   = pcDataTyCon stateAndByteArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndByteArray#")
 378                 [alphaTyVar] [stateAndByteArrayPrimDataCon]
 379 stateAndByteArrayPrimDataCon
 380   = pcDataCon stateAndByteArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndByteArray#")
 381                 [alphaTyVar] [] [mkStatePrimTy alphaTy, byteArrayPrimTy]
 382                 stateAndByteArrayPrimTyCon nullSpecEnv
 383
 384 stateAndMutableByteArrayPrimTyCon
 385   = pcDataTyCon stateAndMutableByteArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndMutableByteArray#")
 386                 [alphaTyVar] [stateAndMutableByteArrayPrimDataCon]
 387 stateAndMutableByteArrayPrimDataCon
 388   = pcDataCon stateAndMutableByteArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndMutableByteArray#")
 389                 [alphaTyVar] [] [mkStatePrimTy alphaTy, applyTyCon mutableByteArrayPrimTyCon [alphaTy]]
 390                 stateAndMutableByteArrayPrimTyCon nullSpecEnv
 391
 392 stateAndSynchVarPrimTyCon
 393   = pcDataTyCon stateAndSynchVarPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndSynchVar#")
 394                 [alphaTyVar, betaTyVar] [stateAndSynchVarPrimDataCon]
 395 stateAndSynchVarPrimDataCon
 396   = pcDataCon stateAndSynchVarPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndSynchVar#")
 397                 [alphaTyVar, betaTyVar] [] [mkStatePrimTy alphaTy, mkSynchVarPrimTy alphaTy betaTy]
 398                 stateAndSynchVarPrimTyCon nullSpecEnv
 399 \end{code}
 400
 401 The ccall-desugaring mechanism uses this function to figure out how to
 402 rebox the result.  It's really a HACK, especially the part about
 403 how many types to drop from \tr{tys_applied}.
 404
 405 \begin{code}
 406 getStatePairingConInfo
 407         :: Type -- primitive type
 408         -> (Id,         -- state pair constructor for prim type
 409             Type)       -- type of state pair
 410
 411 getStatePairingConInfo prim_ty
 412   = case (maybeAppDataTyConExpandingDicts prim_ty) of
 413       Nothing -> panic "getStatePairingConInfo:1"
 414       Just (prim_tycon, tys_applied, _) ->
 415         let
 416             (pair_con, pair_tycon, num_tys) = assoc "getStatePairingConInfo" tbl prim_tycon
 417             pair_ty = applyTyCon pair_tycon (realWorldTy : drop num_tys tys_applied)
 418         in
 419         (pair_con, pair_ty)
 420   where
 421     tbl = [
 422         (charPrimTyCon, (stateAndCharPrimDataCon, stateAndCharPrimTyCon, 0)),
 423         (intPrimTyCon, (stateAndIntPrimDataCon, stateAndIntPrimTyCon, 0)),
 424         (wordPrimTyCon, (stateAndWordPrimDataCon, stateAndWordPrimTyCon, 0)),
 425         (addrPrimTyCon, (stateAndAddrPrimDataCon, stateAndAddrPrimTyCon, 0)),
 426         (stablePtrPrimTyCon, (stateAndStablePtrPrimDataCon, stateAndStablePtrPrimTyCon, 0)),
 427         (foreignObjPrimTyCon, (stateAndForeignObjPrimDataCon, stateAndForeignObjPrimTyCon, 0)),
 428         (floatPrimTyCon, (stateAndFloatPrimDataCon, stateAndFloatPrimTyCon, 0)),
 429         (doublePrimTyCon, (stateAndDoublePrimDataCon, stateAndDoublePrimTyCon, 0)),
 430         (arrayPrimTyCon, (stateAndArrayPrimDataCon, stateAndArrayPrimTyCon, 0)),
 431         (mutableArrayPrimTyCon, (stateAndMutableArrayPrimDataCon, stateAndMutableArrayPrimTyCon, 1)),
 432         (byteArrayPrimTyCon, (stateAndByteArrayPrimDataCon, stateAndByteArrayPrimTyCon, 0)),
 433         (mutableByteArrayPrimTyCon, (stateAndMutableByteArrayPrimDataCon, stateAndMutableByteArrayPrimTyCon, 1)),
 434         (synchVarPrimTyCon, (stateAndSynchVarPrimDataCon, stateAndSynchVarPrimTyCon, 1))
 435         -- (PtrPrimTyCon, (stateAndPtrPrimDataCon, stateAndPtrPrimTyCon, 0)),
 436         ]
 437 \end{code}
 438
 439 %************************************************************************
 440 %*                                                                      *
 441 \subsection[TysWiredIn-ST]{The basic @_ST@ state-transformer type}
 442 %*                                                                      *
 443 %************************************************************************
 444
 445 This is really just an ordinary synonym, except it is ABSTRACT.
 446
 447 \begin{code}
 448 mkStateTransformerTy s a = mkSynTy stTyCon [s, a]
 449
 450 stTyCon
 451   = let
 452         ty = mkFunTys [mkStateTy alphaTy] (mkTupleTy 2 [betaTy, mkStateTy alphaTy])
 453     in
 454     mkSynTyCon
 455      (mkBuiltinName stTyConKey gLASGOW_ST SLIT("_ST"))
 456      (mkBoxedTypeKind `mkArrowKind` (mkBoxedTypeKind `mkArrowKind` mkBoxedTypeKind))
 457      2 [alphaTyVar, betaTyVar]
 458      ty
 459 \end{code}
 460
 461 %************************************************************************
 462 %*                                                                      *
 463 \subsection[TysWiredIn-IO]{The @PrimIO@ and @IO@ monadic-I/O types}
 464 %*                                                                      *
 465 %************************************************************************
 466
 467 @PrimIO@ and @IO@ really are just plain synonyms.
 468
 469 \begin{code}
 470 mkPrimIoTy a = mkSynTy primIoTyCon [a]
 471
 472 primIoTyCon
 473   = let
 474         ty = mkStateTransformerTy realWorldTy alphaTy
 475     in
 476 --  pprTrace "primIOTyCon:" (ppCat [pprType PprDebug ty, ppr PprDebug (typeKind ty)]) $
 477     mkSynTyCon
 478      (mkBuiltinName primIoTyConKey pRELUDE_PRIMIO SLIT("PrimIO"))
 479      (mkBoxedTypeKind `mkArrowKind` mkBoxedTypeKind)
 480      1 [alphaTyVar] ty
 481 \end{code}
 482
 483 %************************************************************************
 484 %*                                                                      *
 485 \subsection[TysWiredIn-Bool]{The @Bool@ type}
 486 %*                                                                      *
 487 %************************************************************************
 488
 489 An ordinary enumeration type, but deeply wired in.  There are no
 490 magical operations on @Bool@ (just the regular Prelude code).
 491
 492 {\em BEGIN IDLE SPECULATION BY SIMON}
 493
 494 This is not the only way to encode @Bool@.  A more obvious coding makes
 495 @Bool@ just a boxed up version of @Bool#@, like this:
 496 \begin{verbatim}
 497 type Bool# = Int#
 498 data Bool = MkBool Bool#
 499 \end{verbatim}
 500
 501 Unfortunately, this doesn't correspond to what the Report says @Bool@
 502 looks like!  Furthermore, we get slightly less efficient code (I
 503 think) with this coding. @gtInt@ would look like this:
 504
 505 \begin{verbatim}
 506 gtInt :: Int -> Int -> Bool
 507 gtInt x y = case x of I# x# ->
 508             case y of I# y# ->
 509             case (gtIntPrim x# y#) of
 510                 b# -> MkBool b#
 511 \end{verbatim}
 512
 513 Notice that the result of the @gtIntPrim@ comparison has to be turned
 514 into an integer (here called @b#@), and returned in a @MkBool@ box.
 515
 516 The @if@ expression would compile to this:
 517 \begin{verbatim}
 518 case (gtInt x y) of
 519   MkBool b# -> case b# of { 1# -> e1; 0# -> e2 }
 520 \end{verbatim}
 521
 522 I think this code is a little less efficient than the previous code,
 523 but I'm not certain.  At all events, corresponding with the Report is
 524 important.  The interesting thing is that the language is expressive
 525 enough to describe more than one alternative; and that a type doesn't
 526 necessarily need to be a straightforwardly boxed version of its
 527 primitive counterpart.
 528
 529 {\em END IDLE SPECULATION BY SIMON}
 530
 531 \begin{code}
 532 boolTy = mkTyConTy boolTyCon
 533
 534 boolTyCon = pcDataTyCon boolTyConKey pRELUDE SLIT("Bool") [] [falseDataCon, trueDataCon]
 535
 536 falseDataCon = pcDataCon falseDataConKey pRELUDE SLIT("False") [] [] [] boolTyCon nullSpecEnv
 537 trueDataCon  = pcDataCon trueDataConKey  pRELUDE SLIT("True")  [] [] [] boolTyCon nullSpecEnv
 538 \end{code}
 539
 540 %************************************************************************
 541 %*                                                                      *
 542 \subsection[TysWiredIn-Ordering]{The @Ordering@ type}
 543 %*                                                                      *
 544 %************************************************************************
 545
 546 \begin{code}
 547 ---------------------------------------------
 548 -- data Ordering = LT | EQ | GT deriving ()
 549 ---------------------------------------------
 550
 551 orderingTy = mkTyConTy orderingTyCon
 552
 553 orderingTyCon = pcDataTyCon orderingTyConKey pRELUDE_BUILTIN SLIT("Ordering") []
 554                             [ltDataCon, eqDataCon, gtDataCon]
 555
 556 ltDataCon  = pcDataCon ltDataConKey pRELUDE_BUILTIN SLIT("LT") [] [] [] orderingTyCon nullSpecEnv
 557 eqDataCon  = pcDataCon eqDataConKey pRELUDE_BUILTIN SLIT("EQ") [] [] [] orderingTyCon nullSpecEnv
 558 gtDataCon  = pcDataCon gtDataConKey pRELUDE_BUILTIN SLIT("GT") [] [] [] orderingTyCon nullSpecEnv
 559 \end{code}
 560
 561 %************************************************************************
 562 %*                                                                      *
 563 \subsection[TysWiredIn-List]{The @List@ type (incl ``build'' magic)}
 564 %*                                                                      *
 565 %************************************************************************
 566
 567 Special syntax, deeply wired in, but otherwise an ordinary algebraic
 568 data type:
 569 \begin{verbatim}
 570 data List a = Nil | a : (List a)
 571 ToDo: data [] a = [] | a : (List a)
 572 ToDo: data () = ()
 573       data (,,) a b c = (,,) a b c
 574 \end{verbatim}
 575
 576 \begin{code}
 577 mkListTy :: GenType t u -> GenType t u
 578 mkListTy ty = applyTyCon listTyCon [ty]
 579
 580 alphaListTy = mkSigmaTy [alphaTyVar] [] (applyTyCon listTyCon [alphaTy])
 581
 582 listTyCon = pcDataTyCon listTyConKey pRELUDE_BUILTIN SLIT("[]")
 583                         [alphaTyVar] [nilDataCon, consDataCon]
 584
 585 nilDataCon  = pcDataCon nilDataConKey  pRELUDE_BUILTIN SLIT("[]") [alphaTyVar] [] [] listTyCon
 586                 (pcGenerateDataSpecs alphaListTy)
 587 consDataCon = pcDataCon consDataConKey pRELUDE_BUILTIN SLIT(":")
 588                 [alphaTyVar] [] [alphaTy, applyTyCon listTyCon [alphaTy]] listTyCon
 589                 (pcGenerateDataSpecs alphaListTy)
 590 -- Interesting: polymorphic recursion would help here.
 591 -- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy
 592 -- gets the over-specific type (Type -> Type)
 593 \end{code}
 594
 595 %************************************************************************
 596 %*                                                                      *
 597 \subsection[TysWiredIn-Tuples]{The @Tuple@ types}
 598 %*                                                                      *
 599 %************************************************************************
 600
 601 The tuple types are definitely magic, because they form an infinite
 602 family.
 603
 604 \begin{itemize}
 605 \item
 606 They have a special family of type constructors, of type @TyCon@
 607 These contain the tycon arity, but don't require a Unique.
 608
 609 \item
 610 They have a special family of constructors, of type
 611 @Id@. Again these contain their arity but don't need a Unique.
 612
 613 \item
 614 There should be a magic way of generating the info tables and
 615 entry code for all tuples.
 616
 617 But at the moment we just compile a Haskell source
 618 file\srcloc{lib/prelude/...} containing declarations like:
 619 \begin{verbatim}
 620 data Tuple0             = Tup0
 621 data Tuple2  a b        = Tup2  a b
 622 data Tuple3  a b c      = Tup3  a b c
 623 data Tuple4  a b c d    = Tup4  a b c d
 624 ...
 625 \end{verbatim}
 626 The print-names associated with the magic @Id@s for tuple constructors
 627 ``just happen'' to be the same as those generated by these
 628 declarations.
 629
 630 \item
 631 The instance environment should have a magic way to know
 632 that each tuple type is an instances of classes @Eq@, @Ix@, @Ord@ and
 633 so on. \ToDo{Not implemented yet.}
 634
 635 \item
 636 There should also be a way to generate the appropriate code for each
 637 of these instances, but (like the info tables and entry code) it is
 638 done by enumeration\srcloc{lib/prelude/InTup?.hs}.
 639 \end{itemize}
 640
 641 \begin{code}
 642 mkTupleTy :: Int -> [GenType t u] -> GenType t u
 643
 644 mkTupleTy arity tys = applyTyCon (mkTupleTyCon arity) tys
 645
 646 unitTy    = mkTupleTy 0 []
 647 \end{code}
 648
 649 %************************************************************************
 650 %*                                                                      *
 651 \subsection[TysWiredIn-Ratios]{@Ratio@ and @Rational@}
 652 %*                                                                      *
 653 %************************************************************************
 654
 655 ToDo: make this (mostly) go away.
 656
 657 \begin{code}
 658 rationalTy :: GenType t u
 659
 660 mkRatioTy ty = applyTyCon ratioTyCon [ty]
 661 rationalTy   = mkRatioTy integerTy
 662
 663 ratioTyCon = pcDataTyCon ratioTyConKey rATIO SLIT("Ratio") [alphaTyVar] [ratioDataCon]
 664
 665 ratioDataCon = pcDataCon ratioDataConKey rATIO SLIT(":%")
 666                 [alphaTyVar] [{-(integralClass,alphaTy)-}] [alphaTy, alphaTy] ratioTyCon nullSpecEnv
 667         -- context omitted to match lib/prelude/ defn of "data Ratio ..."
 668
 669 rationalTyCon
 670   = mkSynTyCon
 671       (mkBuiltinName rationalTyConKey rATIO SLIT("Rational"))
 672       mkBoxedTypeKind
 673       0 [] rationalTy -- == mkRatioTy integerTy
 674 \end{code}
 675
 676 %************************************************************************
 677 %*                                                                      *
 678 \subsection[TysWiredIn-_Lift]{@_Lift@ type: to support array indexing}
 679 %*                                                                      *
 680 %************************************************************************
 681
 682 Again, deeply turgid: \tr{data _Lift a = _Lift a}.
 683
 684 \begin{code}
 685 mkLiftTy ty = applyTyCon liftTyCon [ty]
 686
 687 {-
 688 mkLiftTy ty
 689   = mkSigmaTy tvs theta (applyTyCon liftTyCon [tau])
 690   where
 691     (tvs, theta, tau) = splitSigmaTy ty
 692
 693 isLiftTy ty
 694   = case (maybeAppDataTyConExpandingDicts tau) of
 695       Just (tycon, tys, _) -> tycon == liftTyCon
 696       Nothing -> False
 697   where
 698     (tvs, theta, tau) = splitSigmaTy ty
 699 -}
 700
 701
 702 alphaLiftTy = mkSigmaTy [alphaTyVar] [] (applyTyCon liftTyCon [alphaTy])
 703
 704 liftTyCon
 705   = pcDataTyCon liftTyConKey pRELUDE_BUILTIN SLIT("_Lift") [alphaTyVar] [liftDataCon]
 706
 707 liftDataCon
 708   = pcDataCon liftDataConKey pRELUDE_BUILTIN SLIT("_Lift")
 709                 [alphaTyVar] [] [alphaTy] liftTyCon
 710                 ((pcGenerateDataSpecs alphaLiftTy) `addOneToSpecEnv`
 711                  (mkSpecInfo [Just realWorldStatePrimTy] 0 bottom))
 712   where
 713     bottom = panic "liftDataCon:State# _RealWorld"
 714 \end{code}
 715
 716
 717 %************************************************************************
 718 %*                                                                      *
 719 \subsection[TysWiredIn-for-convenience]{Types wired in for convenience (e.g., @String@)}
 720 %*                                                                      *
 721 %************************************************************************
 722
 723 \begin{code}
 724 stringTy = mkListTy charTy
 725
 726 stringTyCon
 727  = mkSynTyCon
 728      (mkBuiltinName stringTyConKey pRELUDE SLIT("String"))
 729      mkBoxedTypeKind
 730      0 [] stringTy
 731 \end{code}