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