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         primIoDataCon,
  52         realWorldStateTy,
  53         return2GMPsTyCon,
  54         returnIntAndGMPTyCon,
  55         stTyCon,
  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
  91 -- friends:
  92 import PrelMods
  93 import TysPrim
  94
  95 -- others:
  96 import SpecEnv          ( SYN_IE(SpecEnv) )
  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                           mkFunTys, 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 pcDataCon :: Unique{-DataConKey-} -> Module -> FAST_STRING
 134           -> [TyVar] -> ThetaType -> [TauType] -> TyCon -> SpecEnv -> Id
 135 pcDataCon key mod str tyvars context arg_tys tycon specenv
 136   = mkDataCon (mkWiredInName key (OrigName mod str) ExportAll)
 137         [ NotMarkedStrict | a <- arg_tys ]
 138         [ {- no labelled fields -} ]
 139         tyvars context arg_tys tycon
 140         -- specenv
 141
 142 pcGenerateDataSpecs :: Type -> SpecEnv
 143 pcGenerateDataSpecs ty
 144   = pc_gen_specs False err err err ty
 145   where
 146     err = panic "PrelUtils:GenerateDataSpecs"
 147 \end{code}
 148
 149 %************************************************************************
 150 %*                                                                      *
 151 \subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)}
 152 %*                                                                      *
 153 %************************************************************************
 154
 155 \begin{code}
 156 charTy = mkTyConTy charTyCon
 157
 158 charTyCon = pcDataTyCon charTyConKey  pRELUDE  SLIT("Char") [] [charDataCon]
 159 charDataCon = pcDataCon charDataConKey pRELUDE SLIT("C#") [] [] [charPrimTy] charTyCon nullSpecEnv
 160
 161 stringTy = mkListTy charTy -- convenience only
 162 \end{code}
 163
 164 \begin{code}
 165 intTy = mkTyConTy intTyCon
 166
 167 intTyCon = pcDataTyCon intTyConKey pRELUDE SLIT("Int") [] [intDataCon]
 168 intDataCon = pcDataCon intDataConKey pRELUDE SLIT("I#") [] [] [intPrimTy] intTyCon nullSpecEnv
 169 \end{code}
 170
 171 \begin{code}
 172 wordTy = mkTyConTy wordTyCon
 173
 174 wordTyCon = pcDataTyCon wordTyConKey gHC__ SLIT("Word") [] [wordDataCon]
 175 wordDataCon = pcDataCon wordDataConKey gHC__ SLIT("W#") [] [] [wordPrimTy] wordTyCon nullSpecEnv
 176 \end{code}
 177
 178 \begin{code}
 179 addrTy = mkTyConTy addrTyCon
 180
 181 addrTyCon = pcDataTyCon addrTyConKey gHC__ SLIT("Addr") [] [addrDataCon]
 182 addrDataCon = pcDataCon addrDataConKey gHC__ SLIT("A#") [] [] [addrPrimTy] addrTyCon nullSpecEnv
 183 \end{code}
 184
 185 \begin{code}
 186 floatTy = mkTyConTy floatTyCon
 187
 188 floatTyCon = pcDataTyCon floatTyConKey pRELUDE SLIT("Float") [] [floatDataCon]
 189 floatDataCon = pcDataCon floatDataConKey pRELUDE SLIT("F#") [] [] [floatPrimTy] floatTyCon nullSpecEnv
 190 \end{code}
 191
 192 \begin{code}
 193 doubleTy = mkTyConTy doubleTyCon
 194
 195 doubleTyCon = pcDataTyCon doubleTyConKey pRELUDE SLIT("Double") [] [doubleDataCon]
 196 doubleDataCon = pcDataCon doubleDataConKey pRELUDE SLIT("D#") [] [] [doublePrimTy] doubleTyCon nullSpecEnv
 197 \end{code}
 198
 199 \begin{code}
 200 mkStateTy ty     = applyTyCon stateTyCon [ty]
 201 realWorldStateTy = mkStateTy realWorldTy -- a common use
 202
 203 stateTyCon = pcDataTyCon stateTyConKey gHC__ SLIT("State") alpha_tyvar [stateDataCon]
 204 stateDataCon
 205   = pcDataCon stateDataConKey gHC__ SLIT("S#")
 206         alpha_tyvar [] [mkStatePrimTy alphaTy] stateTyCon nullSpecEnv
 207 \end{code}
 208
 209 \begin{code}
 210 stablePtrTyCon
 211   = pcDataTyCon stablePtrTyConKey gHC__ SLIT("StablePtr")
 212         alpha_tyvar [stablePtrDataCon]
 213   where
 214     stablePtrDataCon
 215       = pcDataCon stablePtrDataConKey gHC__ SLIT("StablePtr")
 216             alpha_tyvar [] [mkStablePtrPrimTy alphaTy] stablePtrTyCon nullSpecEnv
 217 \end{code}
 218
 219 \begin{code}
 220 foreignObjTyCon
 221   = pcDataTyCon foreignObjTyConKey gHC__ SLIT("ForeignObj")
 222         [] [foreignObjDataCon]
 223   where
 224     foreignObjDataCon
 225       = pcDataCon foreignObjDataConKey gHC__ SLIT("ForeignObj")
 226             [] [] [foreignObjPrimTy] foreignObjTyCon nullSpecEnv
 227 \end{code}
 228
 229 %************************************************************************
 230 %*                                                                      *
 231 \subsection[TysWiredIn-Integer]{@Integer@ and its related ``pairing'' types}
 232 %*                                                                      *
 233 %************************************************************************
 234
 235 @Integer@ and its pals are not really primitive.  @Integer@ itself, first:
 236 \begin{code}
 237 integerTy :: GenType t u
 238 integerTy    = mkTyConTy integerTyCon
 239
 240 integerTyCon = pcDataTyCon integerTyConKey pRELUDE SLIT("Integer") [] [integerDataCon]
 241
 242 integerDataCon = pcDataCon integerDataConKey pRELUDE SLIT("J#")
 243                 [] [] [intPrimTy, intPrimTy, byteArrayPrimTy] integerTyCon nullSpecEnv
 244 \end{code}
 245
 246 And the other pairing types:
 247 \begin{code}
 248 return2GMPsTyCon = pcDataTyCon return2GMPsTyConKey
 249         gHC__ SLIT("Return2GMPs") [] [return2GMPsDataCon]
 250
 251 return2GMPsDataCon
 252   = pcDataCon return2GMPsDataConKey gHC__ SLIT("Return2GMPs") [] []
 253         [intPrimTy, intPrimTy, byteArrayPrimTy,
 254          intPrimTy, intPrimTy, byteArrayPrimTy] return2GMPsTyCon nullSpecEnv
 255
 256 returnIntAndGMPTyCon = pcDataTyCon returnIntAndGMPTyConKey
 257         gHC__ SLIT("ReturnIntAndGMP") [] [returnIntAndGMPDataCon]
 258
 259 returnIntAndGMPDataCon
 260   = pcDataCon returnIntAndGMPDataConKey gHC__ SLIT("ReturnIntAndGMP") [] []
 261         [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy] returnIntAndGMPTyCon nullSpecEnv
 262 \end{code}
 263
 264 %************************************************************************
 265 %*                                                                      *
 266 \subsection[TysWiredIn-state-pairing]{``State-pairing'' types}
 267 %*                                                                      *
 268 %************************************************************************
 269
 270 These boring types pair a \tr{State#} with another primitive type.
 271 They are not really primitive, so they are given here, not in
 272 \tr{TysPrim.lhs}.
 273
 274 We fish one of these \tr{StateAnd<blah>#} things with
 275 @getStatePairingConInfo@ (given a little way down).
 276
 277 \begin{code}
 278 stateAndPtrPrimTyCon
 279   = pcDataTyCon stateAndPtrPrimTyConKey gHC__ SLIT("StateAndPtr#")
 280                 alpha_beta_tyvars [stateAndPtrPrimDataCon]
 281 stateAndPtrPrimDataCon
 282   = pcDataCon stateAndPtrPrimDataConKey gHC__ SLIT("StateAndPtr#")
 283                 alpha_beta_tyvars [] [mkStatePrimTy alphaTy, betaTy]
 284                 stateAndPtrPrimTyCon nullSpecEnv
 285
 286 stateAndCharPrimTyCon
 287   = pcDataTyCon stateAndCharPrimTyConKey gHC__ SLIT("StateAndChar#")
 288                 alpha_tyvar [stateAndCharPrimDataCon]
 289 stateAndCharPrimDataCon
 290   = pcDataCon stateAndCharPrimDataConKey gHC__ SLIT("StateAndChar#")
 291                 alpha_tyvar [] [mkStatePrimTy alphaTy, charPrimTy]
 292                 stateAndCharPrimTyCon nullSpecEnv
 293
 294 stateAndIntPrimTyCon
 295   = pcDataTyCon stateAndIntPrimTyConKey gHC__ SLIT("StateAndInt#")
 296                 alpha_tyvar [stateAndIntPrimDataCon]
 297 stateAndIntPrimDataCon
 298   = pcDataCon stateAndIntPrimDataConKey gHC__ SLIT("StateAndInt#")
 299                 alpha_tyvar [] [mkStatePrimTy alphaTy, intPrimTy]
 300                 stateAndIntPrimTyCon nullSpecEnv
 301
 302 stateAndWordPrimTyCon
 303   = pcDataTyCon stateAndWordPrimTyConKey gHC__ SLIT("StateAndWord#")
 304                 alpha_tyvar [stateAndWordPrimDataCon]
 305 stateAndWordPrimDataCon
 306   = pcDataCon stateAndWordPrimDataConKey gHC__ SLIT("StateAndWord#")
 307                 alpha_tyvar [] [mkStatePrimTy alphaTy, wordPrimTy]
 308                 stateAndWordPrimTyCon nullSpecEnv
 309
 310 stateAndAddrPrimTyCon
 311   = pcDataTyCon stateAndAddrPrimTyConKey gHC__ SLIT("StateAndAddr#")
 312                 alpha_tyvar [stateAndAddrPrimDataCon]
 313 stateAndAddrPrimDataCon
 314   = pcDataCon stateAndAddrPrimDataConKey gHC__ SLIT("StateAndAddr#")
 315                 alpha_tyvar [] [mkStatePrimTy alphaTy, addrPrimTy]
 316                 stateAndAddrPrimTyCon nullSpecEnv
 317
 318 stateAndStablePtrPrimTyCon
 319   = pcDataTyCon stateAndStablePtrPrimTyConKey gHC__ SLIT("StateAndStablePtr#")
 320                 alpha_beta_tyvars [stateAndStablePtrPrimDataCon]
 321 stateAndStablePtrPrimDataCon
 322   = pcDataCon stateAndStablePtrPrimDataConKey gHC__ SLIT("StateAndStablePtr#")
 323                 alpha_beta_tyvars []
 324                 [mkStatePrimTy alphaTy, applyTyCon stablePtrPrimTyCon [betaTy]]
 325                 stateAndStablePtrPrimTyCon nullSpecEnv
 326
 327 stateAndForeignObjPrimTyCon
 328   = pcDataTyCon stateAndForeignObjPrimTyConKey gHC__ SLIT("StateAndForeignObj#")
 329                 alpha_tyvar [stateAndForeignObjPrimDataCon]
 330 stateAndForeignObjPrimDataCon
 331   = pcDataCon stateAndForeignObjPrimDataConKey gHC__ SLIT("StateAndForeignObj#")
 332                 alpha_tyvar []
 333                 [mkStatePrimTy alphaTy, applyTyCon foreignObjPrimTyCon []]
 334                 stateAndForeignObjPrimTyCon nullSpecEnv
 335
 336 stateAndFloatPrimTyCon
 337   = pcDataTyCon stateAndFloatPrimTyConKey gHC__ SLIT("StateAndFloat#")
 338                 alpha_tyvar [stateAndFloatPrimDataCon]
 339 stateAndFloatPrimDataCon
 340   = pcDataCon stateAndFloatPrimDataConKey gHC__ SLIT("StateAndFloat#")
 341                 alpha_tyvar [] [mkStatePrimTy alphaTy, floatPrimTy]
 342                 stateAndFloatPrimTyCon nullSpecEnv
 343
 344 stateAndDoublePrimTyCon
 345   = pcDataTyCon stateAndDoublePrimTyConKey gHC__ SLIT("StateAndDouble#")
 346                 alpha_tyvar [stateAndDoublePrimDataCon]
 347 stateAndDoublePrimDataCon
 348   = pcDataCon stateAndDoublePrimDataConKey gHC__ SLIT("StateAndDouble#")
 349                 alpha_tyvar [] [mkStatePrimTy alphaTy, doublePrimTy]
 350                 stateAndDoublePrimTyCon nullSpecEnv
 351 \end{code}
 352
 353 \begin{code}
 354 stateAndArrayPrimTyCon
 355   = pcDataTyCon stateAndArrayPrimTyConKey gHC__ SLIT("StateAndArray#")
 356                 alpha_beta_tyvars [stateAndArrayPrimDataCon]
 357 stateAndArrayPrimDataCon
 358   = pcDataCon stateAndArrayPrimDataConKey gHC__ SLIT("StateAndArray#")
 359                 alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkArrayPrimTy betaTy]
 360                 stateAndArrayPrimTyCon nullSpecEnv
 361
 362 stateAndMutableArrayPrimTyCon
 363   = pcDataTyCon stateAndMutableArrayPrimTyConKey gHC__ SLIT("StateAndMutableArray#")
 364                 alpha_beta_tyvars [stateAndMutableArrayPrimDataCon]
 365 stateAndMutableArrayPrimDataCon
 366   = pcDataCon stateAndMutableArrayPrimDataConKey gHC__ SLIT("StateAndMutableArray#")
 367                 alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkMutableArrayPrimTy alphaTy betaTy]
 368                 stateAndMutableArrayPrimTyCon nullSpecEnv
 369
 370 stateAndByteArrayPrimTyCon
 371   = pcDataTyCon stateAndByteArrayPrimTyConKey gHC__ SLIT("StateAndByteArray#")
 372                 alpha_tyvar [stateAndByteArrayPrimDataCon]
 373 stateAndByteArrayPrimDataCon
 374   = pcDataCon stateAndByteArrayPrimDataConKey gHC__ SLIT("StateAndByteArray#")
 375                 alpha_tyvar [] [mkStatePrimTy alphaTy, byteArrayPrimTy]
 376                 stateAndByteArrayPrimTyCon nullSpecEnv
 377
 378 stateAndMutableByteArrayPrimTyCon
 379   = pcDataTyCon stateAndMutableByteArrayPrimTyConKey gHC__ SLIT("StateAndMutableByteArray#")
 380                 alpha_tyvar [stateAndMutableByteArrayPrimDataCon]
 381 stateAndMutableByteArrayPrimDataCon
 382   = pcDataCon stateAndMutableByteArrayPrimDataConKey gHC__ SLIT("StateAndMutableByteArray#")
 383                 alpha_tyvar [] [mkStatePrimTy alphaTy, applyTyCon mutableByteArrayPrimTyCon alpha_ty]
 384                 stateAndMutableByteArrayPrimTyCon nullSpecEnv
 385
 386 stateAndSynchVarPrimTyCon
 387   = pcDataTyCon stateAndSynchVarPrimTyConKey gHC__ SLIT("StateAndSynchVar#")
 388                 alpha_beta_tyvars [stateAndSynchVarPrimDataCon]
 389 stateAndSynchVarPrimDataCon
 390   = pcDataCon stateAndSynchVarPrimDataConKey gHC__ SLIT("StateAndSynchVar#")
 391                 alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkSynchVarPrimTy alphaTy betaTy]
 392                 stateAndSynchVarPrimTyCon nullSpecEnv
 393 \end{code}
 394
 395 The ccall-desugaring mechanism uses this function to figure out how to
 396 rebox the result.  It's really a HACK, especially the part about
 397 how many types to drop from \tr{tys_applied}.
 398
 399 \begin{code}
 400 getStatePairingConInfo
 401         :: Type -- primitive type
 402         -> (Id,         -- state pair constructor for prim type
 403             Type)       -- type of state pair
 404
 405 getStatePairingConInfo prim_ty
 406   = case (maybeAppTyCon prim_ty) of
 407       Nothing -> panic "getStatePairingConInfo:1"
 408       Just (prim_tycon, tys_applied) ->
 409         let
 410             (pair_con, pair_tycon, num_tys) = assoc "getStatePairingConInfo" tbl prim_tycon
 411             pair_ty = applyTyCon pair_tycon (realWorldTy : drop num_tys tys_applied)
 412         in
 413         (pair_con, pair_ty)
 414   where
 415     tbl = [
 416         (charPrimTyCon, (stateAndCharPrimDataCon, stateAndCharPrimTyCon, 0)),
 417         (intPrimTyCon, (stateAndIntPrimDataCon, stateAndIntPrimTyCon, 0)),
 418         (wordPrimTyCon, (stateAndWordPrimDataCon, stateAndWordPrimTyCon, 0)),
 419         (addrPrimTyCon, (stateAndAddrPrimDataCon, stateAndAddrPrimTyCon, 0)),
 420         (stablePtrPrimTyCon, (stateAndStablePtrPrimDataCon, stateAndStablePtrPrimTyCon, 0)),
 421         (foreignObjPrimTyCon, (stateAndForeignObjPrimDataCon, stateAndForeignObjPrimTyCon, 0)),
 422         (floatPrimTyCon, (stateAndFloatPrimDataCon, stateAndFloatPrimTyCon, 0)),
 423         (doublePrimTyCon, (stateAndDoublePrimDataCon, stateAndDoublePrimTyCon, 0)),
 424         (arrayPrimTyCon, (stateAndArrayPrimDataCon, stateAndArrayPrimTyCon, 0)),
 425         (mutableArrayPrimTyCon, (stateAndMutableArrayPrimDataCon, stateAndMutableArrayPrimTyCon, 1)),
 426         (byteArrayPrimTyCon, (stateAndByteArrayPrimDataCon, stateAndByteArrayPrimTyCon, 0)),
 427         (mutableByteArrayPrimTyCon, (stateAndMutableByteArrayPrimDataCon, stateAndMutableByteArrayPrimTyCon, 1)),
 428         (synchVarPrimTyCon, (stateAndSynchVarPrimDataCon, stateAndSynchVarPrimTyCon, 1))
 429         -- (PtrPrimTyCon, (stateAndPtrPrimDataCon, stateAndPtrPrimTyCon, 0)),
 430         ]
 431 \end{code}
 432
 433 %************************************************************************
 434 %*                                                                      *
 435 \subsection[TysWiredIn-ST]{The basic @_ST@ state-transformer type}
 436 %*                                                                      *
 437 %************************************************************************
 438
 439 This is really just an ordinary synonym, except it is ABSTRACT.
 440
 441 \begin{code}
 442 mkStateTransformerTy s a = applyTyCon stTyCon [s, a]
 443
 444 stTyCon = pcNewTyCon stTyConKey gHC__ SLIT("ST") alpha_beta_tyvars [stDataCon]
 445   where
 446     ty = mkFunTys [mkStateTy alphaTy] (mkTupleTy 2 [betaTy, mkStateTy alphaTy])
 447
 448     stDataCon = pcDataCon stDataConKey gHC__ SLIT("ST")
 449                         alpha_beta_tyvars [] [ty] stTyCon nullSpecEnv
 450 \end{code}
 451
 452 %************************************************************************
 453 %*                                                                      *
 454 \subsection[TysWiredIn-IO]{The @PrimIO@ and @IO@ monadic-I/O types}
 455 %*                                                                      *
 456 %************************************************************************
 457
 458 \begin{code}
 459 mkPrimIoTy a = applyTyCon primIoTyCon [a]
 460
 461 primIoTyCon = pcNewTyCon primIoTyConKey gHC__ SLIT("PrimIO") alpha_tyvar [primIoDataCon]
 462
 463 primIoDataCon = pcDataCon primIoDataConKey gHC__ SLIT("PrimIO")
 464                     alpha_tyvar [] [ty] primIoTyCon nullSpecEnv
 465   where
 466     ty = mkFunTys [mkStateTy realWorldTy] (mkTupleTy 2 [alphaTy, mkStateTy realWorldTy])
 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 types:
 534 \begin{verbatim}
 535 data [] a = [] | a : (List a)
 536 data () = ()
 537 data (,) a b = (,,) a b
 538 ...
 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}