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