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