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