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         cmpTagTy,
  25         cmpTagTyCon,
  26         consDataCon,
  27         doubleDataCon,
  28         doubleTy,
  29         doubleTyCon,
  30         eqPrimDataCon,
  31         falseDataCon,
  32         floatDataCon,
  33         floatTy,
  34         floatTyCon,
  35         getStatePairingConInfo,
  36         gtPrimDataCon,
  37         intDataCon,
  38         intTy,
  39         intTyCon,
  40         integerTy,
  41         integerTyCon,
  42         liftDataCon,
  43         liftTyCon,
  44         listTyCon,
  45         ltPrimDataCon,
  46         mallocPtrTyCon,
  47         mkLiftTy,
  48         mkListTy,
  49         mkPrimIoTy,
  50         mkStateTransformerTy,
  51         mkTupleTy,
  52         nilDataCon,
  53         primIoTyCon,
  54         ratioDataCon,
  55         ratioTyCon,
  56         rationalTy,
  57         rationalTyCon,
  58         realWorldStateTy,
  59         return2GMPsTyCon,
  60         returnIntAndGMPTyCon,
  61         stTyCon,
  62         stablePtrTyCon,
  63         stateAndAddrPrimTyCon,
  64         stateAndArrayPrimTyCon,
  65         stateAndByteArrayPrimTyCon,
  66         stateAndCharPrimTyCon,
  67         stateAndDoublePrimTyCon,
  68         stateAndFloatPrimTyCon,
  69         stateAndIntPrimTyCon,
  70         stateAndMallocPtrPrimTyCon,
  71         stateAndMutableArrayPrimTyCon,
  72         stateAndMutableByteArrayPrimTyCon,
  73         stateAndPtrPrimTyCon,
  74         stateAndStablePtrPrimTyCon,
  75         stateAndSynchVarPrimTyCon,
  76         stateAndWordPrimTyCon,
  77         stateDataCon,
  78         stateTyCon,
  79         stringTy,
  80         stringTyCon,
  81         trueDataCon,
  82         unitTy,
  83         wordDataCon,
  84         wordTy,
  85         wordTyCon
  86     ) where
  87
  88 import Pretty           --ToDo:rm debugging only
  89
  90 import PrelFuns         -- help functions, types and things
  91 import TysPrim
  92
  93 import AbsUniType       ( applyTyCon, mkTupleTyCon, mkSynonymTyCon,
  94                           getUniDataTyCon_maybe, mkSigmaTy, TyCon
  95                           , pprUniType --ToDo: rm debugging only
  96                           IF_ATTACK_PRAGMAS(COMMA cmpTyCon)
  97                         )
  98 import IdInfo
  99 import Maybes           ( Maybe(..) )
 100 import Unique
 101 import Util
 102 \end{code}
 103
 104 %************************************************************************
 105 %*                                                                      *
 106 \subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)}
 107 %*                                                                      *
 108 %************************************************************************
 109
 110 \begin{code}
 111 charTy = UniData charTyCon []
 112
 113 charTyCon = pcDataTyCon charTyConKey pRELUDE_BUILTIN SLIT("Char") [] [charDataCon]
 114 charDataCon = pcDataCon charDataConKey pRELUDE_BUILTIN SLIT("C#") [] [] [charPrimTy] charTyCon nullSpecEnv
 115 \end{code}
 116
 117 \begin{code}
 118 intTy = UniData intTyCon []
 119
 120 intTyCon = pcDataTyCon intTyConKey pRELUDE_BUILTIN SLIT("Int") [] [intDataCon]
 121 intDataCon = pcDataCon intDataConKey pRELUDE_BUILTIN SLIT("I#") [] [] [intPrimTy] intTyCon nullSpecEnv
 122 \end{code}
 123
 124 \begin{code}
 125 wordTy = UniData wordTyCon []
 126
 127 wordTyCon = pcDataTyCon wordTyConKey pRELUDE_BUILTIN SLIT("_Word") [] [wordDataCon]
 128 wordDataCon = pcDataCon wordDataConKey pRELUDE_BUILTIN SLIT("W#") [] [] [wordPrimTy] wordTyCon nullSpecEnv
 129 \end{code}
 130
 131 \begin{code}
 132 addrTy = UniData addrTyCon []
 133
 134 addrTyCon = pcDataTyCon addrTyConKey pRELUDE_BUILTIN SLIT("_Addr") [] [addrDataCon]
 135 addrDataCon = pcDataCon addrDataConKey pRELUDE_BUILTIN SLIT("A#") [] [] [addrPrimTy] addrTyCon nullSpecEnv
 136 \end{code}
 137
 138 \begin{code}
 139 floatTy = UniData floatTyCon []
 140
 141 floatTyCon = pcDataTyCon floatTyConKey pRELUDE_BUILTIN SLIT("Float") [] [floatDataCon]
 142 floatDataCon = pcDataCon floatDataConKey pRELUDE_BUILTIN SLIT("F#") [] [] [floatPrimTy] floatTyCon nullSpecEnv
 143 \end{code}
 144
 145 \begin{code}
 146 doubleTy = UniData doubleTyCon []
 147
 148 doubleTyCon = pcDataTyCon doubleTyConKey pRELUDE_BUILTIN SLIT("Double") [] [doubleDataCon]
 149 doubleDataCon = pcDataCon doubleDataConKey pRELUDE_BUILTIN SLIT("D#") [] [] [doublePrimTy] doubleTyCon nullSpecEnv
 150 \end{code}
 151
 152 \begin{code}
 153 mkStateTy ty     = applyTyCon stateTyCon [ty]
 154 realWorldStateTy = mkStateTy realWorldTy -- a common use
 155
 156 stateTyCon = pcDataTyCon stateTyConKey pRELUDE_BUILTIN SLIT("_State") [alpha_tv] [stateDataCon]
 157 stateDataCon
 158   = pcDataCon stateDataConKey pRELUDE_BUILTIN SLIT("S#")
 159         [alpha_tv] [] [mkStatePrimTy alpha] stateTyCon nullSpecEnv
 160 \end{code}
 161
 162 \begin{code}
 163 {- OLD:
 164 byteArrayTyCon
 165   = pcDataTyCon byteArrayTyConKey pRELUDE_ARRAY SLIT("_ByteArray")
 166         [alpha_tv] [byteArrayDataCon]
 167
 168 byteArrayDataCon
 169   = pcDataCon byteArrayDataConKey pRELUDE_ARRAY SLIT("_ByteArray")
 170         [alpha_tv] []
 171         [mkTupleTy 2 [alpha, alpha], byteArrayPrimTy]
 172         byteArrayTyCon nullSpecEnv
 173 -}
 174 \end{code}
 175
 176 \begin{code}
 177 {- OLD:
 178 mutableArrayTyCon
 179   = pcDataTyCon mutableArrayTyConKey gLASGOW_ST SLIT("_MutableArray")
 180         [alpha_tv, beta_tv, gamma_tv] [mutableArrayDataCon]
 181   where
 182     mutableArrayDataCon
 183       = pcDataCon mutableArrayDataConKey gLASGOW_ST SLIT("_MutableArray")
 184             [alpha_tv, beta_tv, gamma_tv] []
 185             [mkTupleTy 2 [beta, beta], applyTyCon mutableArrayPrimTyCon [alpha, gamma]]
 186             mutableArrayTyCon nullSpecEnv
 187 -}
 188 \end{code}
 189
 190 \begin{code}
 191 {-
 192 mutableByteArrayTyCon
 193   = pcDataTyCon mutableByteArrayTyConKey gLASGOW_ST SLIT("_MutableByteArray")
 194         [alpha_tv, beta_tv] [mutableByteArrayDataCon]
 195
 196 mutableByteArrayDataCon
 197   = pcDataCon mutableByteArrayDataConKey gLASGOW_ST SLIT("_MutableByteArray")
 198         [alpha_tv, beta_tv] []
 199         [mkTupleTy 2 [beta, beta], mkMutableByteArrayPrimTy alpha]
 200         mutableByteArrayTyCon nullSpecEnv
 201 -}
 202 \end{code}
 203
 204 \begin{code}
 205 stablePtrTyCon
 206   = pcDataTyCon stablePtrTyConKey gLASGOW_MISC SLIT("_StablePtr")
 207         [alpha_tv] [stablePtrDataCon]
 208   where
 209     stablePtrDataCon
 210       = pcDataCon stablePtrDataConKey gLASGOW_MISC SLIT("_StablePtr")
 211             [alpha_tv] [] [applyTyCon stablePtrPrimTyCon [alpha]] stablePtrTyCon nullSpecEnv
 212 \end{code}
 213
 214 \begin{code}
 215 mallocPtrTyCon
 216   = pcDataTyCon mallocPtrTyConKey gLASGOW_MISC SLIT("_MallocPtr")
 217         [] [mallocPtrDataCon]
 218   where
 219     mallocPtrDataCon
 220       = pcDataCon mallocPtrDataConKey gLASGOW_MISC SLIT("_MallocPtr")
 221             [] [] [applyTyCon mallocPtrPrimTyCon []] mallocPtrTyCon nullSpecEnv
 222 \end{code}
 223
 224 %************************************************************************
 225 %*                                                                      *
 226 \subsection[TysWiredIn-Integer]{@Integer@ and its related ``pairing'' types}
 227 %*                                                                      *
 228 %************************************************************************
 229
 230 @Integer@ and its pals are not really primitive.  @Integer@ itself, first:
 231 \begin{code}
 232 integerTy :: UniType
 233 integerTy    = UniData integerTyCon []
 234
 235 integerTyCon = pcDataTyCon integerTyConKey pRELUDE_BUILTIN SLIT("Integer") [] [integerDataCon]
 236
 237 #ifndef DPH
 238 integerDataCon = pcDataCon integerDataConKey pRELUDE_BUILTIN SLIT("J#")
 239                 [] [] [intPrimTy, intPrimTy, byteArrayPrimTy] integerTyCon nullSpecEnv
 240 #else
 241 -- DPH: For the time being we implement Integers in the same way as Ints.
 242 integerDataCon = pcDataCon integerDataConKey pRELUDE_BUILTIN SLIT("J#")
 243                 [] [] [intPrimTy] integerTyCon nullSpecEnv
 244 #endif {- Data Parallel Haskell -}
 245 \end{code}
 246
 247 And the other pairing types:
 248 \begin{code}
 249 return2GMPsTyCon = pcDataTyCon return2GMPsTyConKey
 250         pRELUDE_BUILTIN SLIT("_Return2GMPs") [] [return2GMPsDataCon]
 251
 252 return2GMPsDataCon
 253   = pcDataCon return2GMPsDataConKey pRELUDE_BUILTIN SLIT("_Return2GMPs") [] []
 254         [intPrimTy, intPrimTy, byteArrayPrimTy,
 255          intPrimTy, intPrimTy, byteArrayPrimTy] return2GMPsTyCon nullSpecEnv
 256
 257 returnIntAndGMPTyCon = pcDataTyCon returnIntAndGMPTyConKey
 258         pRELUDE_BUILTIN SLIT("_ReturnIntAndGMP") [] [returnIntAndGMPDataCon]
 259
 260 returnIntAndGMPDataCon
 261   = pcDataCon returnIntAndGMPDataConKey pRELUDE_BUILTIN SLIT("_ReturnIntAndGMP") [] []
 262         [intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy] returnIntAndGMPTyCon nullSpecEnv
 263 \end{code}
 264
 265 %************************************************************************
 266 %*                                                                      *
 267 \subsection[TysWiredIn-state-pairing]{``State-pairing'' types}
 268 %*                                                                      *
 269 %************************************************************************
 270
 271 These boring types pair a \tr{State#} with another primitive type.
 272 They are not really primitive, so they are given here, not in
 273 \tr{TysPrim.lhs}.
 274
 275 We fish one of these \tr{StateAnd<blah>#} things with
 276 @getStatePairingConInfo@ (given a little way down).
 277
 278 \begin{code}
 279 stateAndPtrPrimTyCon
 280   = pcDataTyCon stateAndPtrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndPtr#")
 281                 [alpha_tv, beta_tv] [stateAndPtrPrimDataCon]
 282 stateAndPtrPrimDataCon
 283   = pcDataCon stateAndPtrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndPtr#")
 284                 [alpha_tv, beta_tv] [] [mkStatePrimTy alpha, beta]
 285                 stateAndPtrPrimTyCon nullSpecEnv
 286
 287 stateAndCharPrimTyCon
 288   = pcDataTyCon stateAndCharPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndChar#")
 289                 [alpha_tv] [stateAndCharPrimDataCon]
 290 stateAndCharPrimDataCon
 291   = pcDataCon stateAndCharPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndChar#")
 292                 [alpha_tv] [] [mkStatePrimTy alpha, charPrimTy]
 293                 stateAndCharPrimTyCon nullSpecEnv
 294
 295 stateAndIntPrimTyCon
 296   = pcDataTyCon stateAndIntPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndInt#")
 297                 [alpha_tv] [stateAndIntPrimDataCon]
 298 stateAndIntPrimDataCon
 299   = pcDataCon stateAndIntPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndInt#")
 300                 [alpha_tv] [] [mkStatePrimTy alpha, intPrimTy]
 301                 stateAndIntPrimTyCon nullSpecEnv
 302
 303 stateAndWordPrimTyCon
 304   = pcDataTyCon stateAndWordPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndWord#")
 305                 [alpha_tv] [stateAndWordPrimDataCon]
 306 stateAndWordPrimDataCon
 307   = pcDataCon stateAndWordPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndWord#")
 308                 [alpha_tv] [] [mkStatePrimTy alpha, wordPrimTy]
 309                 stateAndWordPrimTyCon nullSpecEnv
 310
 311 stateAndAddrPrimTyCon
 312   = pcDataTyCon stateAndAddrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndAddr#")
 313                 [alpha_tv] [stateAndAddrPrimDataCon]
 314 stateAndAddrPrimDataCon
 315   = pcDataCon stateAndAddrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndAddr#")
 316                 [alpha_tv] [] [mkStatePrimTy alpha, addrPrimTy]
 317                 stateAndAddrPrimTyCon nullSpecEnv
 318
 319 stateAndStablePtrPrimTyCon
 320   = pcDataTyCon stateAndStablePtrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndStablePtr#")
 321                 [alpha_tv, beta_tv] [stateAndStablePtrPrimDataCon]
 322 stateAndStablePtrPrimDataCon
 323   = pcDataCon stateAndStablePtrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndStablePtr#")
 324                 [alpha_tv, beta_tv] []
 325                 [mkStatePrimTy alpha, applyTyCon stablePtrPrimTyCon [beta]]
 326                 stateAndStablePtrPrimTyCon nullSpecEnv
 327
 328 stateAndMallocPtrPrimTyCon
 329   = pcDataTyCon stateAndMallocPtrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndMallocPtr#")
 330                 [alpha_tv] [stateAndMallocPtrPrimDataCon]
 331 stateAndMallocPtrPrimDataCon
 332   = pcDataCon stateAndMallocPtrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndMallocPtr#")
 333                 [alpha_tv] []
 334                 [mkStatePrimTy alpha, applyTyCon mallocPtrPrimTyCon []]
 335                 stateAndMallocPtrPrimTyCon nullSpecEnv
 336
 337 stateAndFloatPrimTyCon
 338   = pcDataTyCon stateAndFloatPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndFloat#")
 339                 [alpha_tv] [stateAndFloatPrimDataCon]
 340 stateAndFloatPrimDataCon
 341   = pcDataCon stateAndFloatPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndFloat#")
 342                 [alpha_tv] [] [mkStatePrimTy alpha, floatPrimTy]
 343                 stateAndFloatPrimTyCon nullSpecEnv
 344
 345 stateAndDoublePrimTyCon
 346   = pcDataTyCon stateAndDoublePrimTyConKey pRELUDE_BUILTIN SLIT("StateAndDouble#")
 347                 [alpha_tv] [stateAndDoublePrimDataCon]
 348 stateAndDoublePrimDataCon
 349   = pcDataCon stateAndDoublePrimDataConKey pRELUDE_BUILTIN SLIT("StateAndDouble#")
 350                 [alpha_tv] [] [mkStatePrimTy alpha, doublePrimTy]
 351                 stateAndDoublePrimTyCon nullSpecEnv
 352 \end{code}
 353
 354 \begin{code}
 355 stateAndArrayPrimTyCon
 356   = pcDataTyCon stateAndArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndArray#")
 357                 [alpha_tv, beta_tv] [stateAndArrayPrimDataCon]
 358 stateAndArrayPrimDataCon
 359   = pcDataCon stateAndArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndArray#")
 360                 [alpha_tv, beta_tv] [] [mkStatePrimTy alpha, mkArrayPrimTy beta]
 361                 stateAndArrayPrimTyCon nullSpecEnv
 362
 363 stateAndMutableArrayPrimTyCon
 364   = pcDataTyCon stateAndMutableArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndMutableArray#")
 365                 [alpha_tv, beta_tv] [stateAndMutableArrayPrimDataCon]
 366 stateAndMutableArrayPrimDataCon
 367   = pcDataCon stateAndMutableArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndMutableArray#")
 368                 [alpha_tv, beta_tv] [] [mkStatePrimTy alpha, mkMutableArrayPrimTy alpha beta]
 369                 stateAndMutableArrayPrimTyCon nullSpecEnv
 370
 371 stateAndByteArrayPrimTyCon
 372   = pcDataTyCon stateAndByteArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndByteArray#")
 373                 [alpha_tv] [stateAndByteArrayPrimDataCon]
 374 stateAndByteArrayPrimDataCon
 375   = pcDataCon stateAndByteArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndByteArray#")
 376                 [alpha_tv] [] [mkStatePrimTy alpha, byteArrayPrimTy]
 377                 stateAndByteArrayPrimTyCon nullSpecEnv
 378
 379 stateAndMutableByteArrayPrimTyCon
 380   = pcDataTyCon stateAndMutableByteArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndMutableByteArray#")
 381                 [alpha_tv] [stateAndMutableByteArrayPrimDataCon]
 382 stateAndMutableByteArrayPrimDataCon
 383   = pcDataCon stateAndMutableByteArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndMutableByteArray#")
 384                 [alpha_tv] [] [mkStatePrimTy alpha, applyTyCon mutableByteArrayPrimTyCon [alpha]]
 385                 stateAndMutableByteArrayPrimTyCon nullSpecEnv
 386
 387 stateAndSynchVarPrimTyCon
 388   = pcDataTyCon stateAndSynchVarPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndSynchVar#")
 389                 [alpha_tv, beta_tv] [stateAndSynchVarPrimDataCon]
 390 stateAndSynchVarPrimDataCon
 391   = pcDataCon stateAndSynchVarPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndSynchVar#")
 392                 [alpha_tv, beta_tv] [] [mkStatePrimTy alpha, mkSynchVarPrimTy alpha beta]
 393                 stateAndSynchVarPrimTyCon nullSpecEnv
 394 \end{code}
 395
 396 The ccall-desugaring mechanism uses this function to figure out how to
 397 rebox the result.  It's really a HACK, especially the part about
 398 how many types to drop from \tr{tys_applied}.
 399
 400 \begin{code}
 401 getStatePairingConInfo
 402         :: UniType      -- primitive type
 403         -> (Id,         -- state pair constructor for prim type
 404             UniType)    -- type of state pair
 405
 406 getStatePairingConInfo prim_ty
 407   = case (getUniDataTyCon_maybe prim_ty) of
 408       Nothing -> panic "getStatePairingConInfo:1"
 409       Just (prim_tycon, tys_applied, _) ->
 410         let
 411             (pair_con, pair_tycon, num_tys) = assoc "getStatePairingConInfo" tbl prim_tycon
 412             pair_ty = applyTyCon pair_tycon (realWorldTy : drop num_tys tys_applied)
 413         in
 414         (pair_con, pair_ty)
 415   where
 416     tbl = [
 417         (charPrimTyCon, (stateAndCharPrimDataCon, stateAndCharPrimTyCon, 0)),
 418         (intPrimTyCon, (stateAndIntPrimDataCon, stateAndIntPrimTyCon, 0)),
 419         (wordPrimTyCon, (stateAndWordPrimDataCon, stateAndWordPrimTyCon, 0)),
 420         (addrPrimTyCon, (stateAndAddrPrimDataCon, stateAndAddrPrimTyCon, 0)),
 421         (stablePtrPrimTyCon, (stateAndStablePtrPrimDataCon, stateAndStablePtrPrimTyCon, 0)),
 422         (mallocPtrPrimTyCon, (stateAndMallocPtrPrimDataCon, stateAndMallocPtrPrimTyCon, 0)),
 423         (floatPrimTyCon, (stateAndFloatPrimDataCon, stateAndFloatPrimTyCon, 0)),
 424         (doublePrimTyCon, (stateAndDoublePrimDataCon, stateAndDoublePrimTyCon, 0)),
 425         (arrayPrimTyCon, (stateAndArrayPrimDataCon, stateAndArrayPrimTyCon, 0)),
 426         (mutableArrayPrimTyCon, (stateAndMutableArrayPrimDataCon, stateAndMutableArrayPrimTyCon, 1)),
 427         (byteArrayPrimTyCon, (stateAndByteArrayPrimDataCon, stateAndByteArrayPrimTyCon, 0)),
 428         (mutableByteArrayPrimTyCon, (stateAndMutableByteArrayPrimDataCon, stateAndMutableByteArrayPrimTyCon, 1)),
 429         (synchVarPrimTyCon, (stateAndSynchVarPrimDataCon, stateAndSynchVarPrimTyCon, 1))
 430         -- (PtrPrimTyCon, (stateAndPtrPrimDataCon, stateAndPtrPrimTyCon, 0)),
 431         ]
 432 \end{code}
 433
 434 %************************************************************************
 435 %*                                                                      *
 436 \subsection[TysWiredIn-ST]{The basic @_ST@ state-transformer type}
 437 %*                                                                      *
 438 %************************************************************************
 439
 440 This is really just an ordinary synonym, except it is ABSTRACT.
 441
 442 \begin{code}
 443 mkStateTransformerTy s a = applyTyCon stTyCon [s, a]
 444
 445 stTyCon
 446   = mkSynonymTyCon
 447      stTyConKey
 448      (mkPreludeCoreName gLASGOW_ST SLIT("_ST"))
 449      2
 450      [alpha_tv, beta_tv]
 451      (mkStateTy alpha `UniFun` mkTupleTy 2 [beta, mkStateTy alpha])
 452      True -- ToDo: make... *** ABSTRACT ***
 453 \end{code}
 454
 455 %************************************************************************
 456 %*                                                                      *
 457 \subsection[TysWiredIn-IO]{The @PrimIO@ and @IO@ monadic-I/O types}
 458 %*                                                                      *
 459 %************************************************************************
 460
 461 @PrimIO@ and @IO@ really are just a plain synonyms.
 462
 463 \begin{code}
 464 mkPrimIoTy a = applyTyCon primIoTyCon [a]
 465
 466 primIoTyCon
 467   = mkSynonymTyCon
 468      primIoTyConKey
 469      (mkPreludeCoreName pRELUDE_PRIMIO SLIT("PrimIO"))
 470      1
 471      [alpha_tv]
 472      (mkStateTransformerTy realWorldTy alpha)
 473      True -- need not be abstract
 474 \end{code}
 475
 476 %************************************************************************
 477 %*                                                                      *
 478 \subsection[TysWiredIn-Bool]{The @Bool@ type}
 479 %*                                                                      *
 480 %************************************************************************
 481
 482 An ordinary enumeration type, but deeply wired in.  There are no
 483 magical operations on @Bool@ (just the regular Prelude code).
 484
 485 {\em BEGIN IDLE SPECULATION BY SIMON}
 486
 487 This is not the only way to encode @Bool@.  A more obvious coding makes
 488 @Bool@ just a boxed up version of @Bool#@, like this:
 489 \begin{verbatim}
 490 type Bool# = Int#
 491 data Bool = MkBool Bool#
 492 \end{verbatim}
 493
 494 Unfortunately, this doesn't correspond to what the Report says @Bool@
 495 looks like!  Furthermore, we get slightly less efficient code (I
 496 think) with this coding. @gtInt@ would look like this:
 497
 498 \begin{verbatim}
 499 gtInt :: Int -> Int -> Bool
 500 gtInt x y = case x of I# x# ->
 501             case y of I# y# ->
 502             case (gtIntPrim x# y#) of
 503                 b# -> MkBool b#
 504 \end{verbatim}
 505
 506 Notice that the result of the @gtIntPrim@ comparison has to be turned
 507 into an integer (here called @b#@), and returned in a @MkBool@ box.
 508
 509 The @if@ expression would compile to this:
 510 \begin{verbatim}
 511 case (gtInt x y) of
 512   MkBool b# -> case b# of { 1# -> e1; 0# -> e2 }
 513 \end{verbatim}
 514
 515 I think this code is a little less efficient than the previous code,
 516 but I'm not certain.  At all events, corresponding with the Report is
 517 important.  The interesting thing is that the language is expressive
 518 enough to describe more than one alternative; and that a type doesn't
 519 necessarily need to be a straightforwardly boxed version of its
 520 primitive counterpart.
 521
 522 {\em END IDLE SPECULATION BY SIMON}
 523
 524 \begin{code}
 525 boolTy = UniData boolTyCon []
 526
 527 boolTyCon = pcDataTyCon boolTyConKey pRELUDE_CORE SLIT("Bool") [] [falseDataCon, trueDataCon]
 528
 529 falseDataCon = pcDataCon falseDataConKey pRELUDE_CORE SLIT("False") [] [] [] boolTyCon nullSpecEnv
 530 trueDataCon  = pcDataCon trueDataConKey  pRELUDE_CORE SLIT("True")  [] [] [] boolTyCon nullSpecEnv
 531 \end{code}
 532
 533 %************************************************************************
 534 %*                                                                      *
 535 \subsection[TysWiredIn-CMP-TAG]{The @CMP_TAG#@ type (for fast `derived' comparisons)}
 536 %*                                                                      *
 537 %************************************************************************
 538
 539 \begin{code}
 540 ---------------------------------------------
 541 -- data _CMP_TAG = _LT | _EQ | _GT deriving ()
 542 ---------------------------------------------
 543
 544 cmpTagTy = UniData cmpTagTyCon []
 545
 546 cmpTagTyCon = pcDataTyCon cmpTagTyConKey pRELUDE_BUILTIN SLIT("_CMP_TAG") []
 547                 [ltPrimDataCon, eqPrimDataCon, gtPrimDataCon]
 548
 549 ltPrimDataCon  = pcDataCon ltTagDataConKey pRELUDE_BUILTIN SLIT("_LT") [] [] [] cmpTagTyCon nullSpecEnv
 550 eqPrimDataCon  = pcDataCon eqTagDataConKey pRELUDE_BUILTIN SLIT("_EQ") [] [] [] cmpTagTyCon nullSpecEnv
 551 gtPrimDataCon  = pcDataCon gtTagDataConKey pRELUDE_BUILTIN SLIT("_GT") [] [] [] cmpTagTyCon nullSpecEnv
 552 \end{code}
 553
 554 %************************************************************************
 555 %*                                                                      *
 556 \subsection[TysWiredIn-List]{The @List@ type (incl ``build'' magic)}
 557 %*                                                                      *
 558 %************************************************************************
 559
 560 Special syntax, deeply wired in, but otherwise an ordinary algebraic
 561 data type:
 562 \begin{verbatim}
 563 data List a = Nil | a : (List a)
 564 \end{verbatim}
 565
 566 \begin{code}
 567 mkListTy :: UniType -> UniType
 568 mkListTy ty = UniData listTyCon [ty]
 569
 570 alphaListTy = mkSigmaTy [alpha_tv] [] (mkListTy alpha)
 571
 572 listTyCon = pcDataTyCon listTyConKey pRELUDE_BUILTIN SLIT("List") [alpha_tv] [nilDataCon, consDataCon]
 573
 574 nilDataCon  = pcDataCon nilDataConKey  pRELUDE_BUILTIN SLIT("Nil") [alpha_tv] [] [] listTyCon
 575                 (pcGenerateDataSpecs alphaListTy)
 576 consDataCon = pcDataCon consDataConKey pRELUDE_BUILTIN SLIT(":")
 577                 [alpha_tv] [] [alpha, mkListTy alpha] listTyCon
 578                 (pcGenerateDataSpecs alphaListTy)
 579 \end{code}
 580
 581 This is the @_Build@ data constructor, it does {\em not} appear inside
 582 listTyCon.  It has this type: \tr{((a -> b -> b) -> b -> b) -> [a]}.
 583 \begin{code}
 584 {- NOT USED:
 585 buildDataCon
 586   = pcDataCon buildDataConKey  pRELUDE_BUILTIN "Build"
 587         [alpha_tv] [] [
 588                 mkSigmaTy [beta_tv] []
 589                         ((alpha `UniFun` (beta `UniFun` beta))
 590                         `UniFun` (beta
 591                         `UniFun` beta))] listTyCon nullSpecEnv
 592 -}
 593 \end{code}
 594
 595 %************************************************************************
 596 %*                                                                      *
 597 \subsection[TysWiredIn-Tuples]{The @Tuple@ types}
 598 %*                                                                      *
 599 %************************************************************************
 600
 601 The tuple types are definitely magic, because they form an infinite
 602 family.
 603
 604 \begin{itemize}
 605 \item
 606 They have a special family of type constructors, of type
 607 @TyCon@\srcloc{uniType/TyCon.lhs}.
 608 These contain the tycon arity, but don't require a Unique.
 609
 610 \item
 611 They have a special family of constructors, of type
 612 @Id@\srcloc{basicTypes/Id.lhs}.  Again these contain their arity but
 613 don't need a Unique.
 614
 615 \item
 616 There should be a magic way of generating the info tables and
 617 entry code for all tuples.
 618
 619 But at the moment we just compile a Haskell source
 620 file\srcloc{lib/prelude/...} containing declarations like:
 621 \begin{verbatim}
 622 data Tuple0             = Tup0
 623 data Tuple2  a b        = Tup2  a b
 624 data Tuple3  a b c      = Tup3  a b c
 625 data Tuple4  a b c d    = Tup4  a b c d
 626 ...
 627 \end{verbatim}
 628 The print-names associated with the magic @Id@s for tuple constructors
 629 ``just happen'' to be the same as those generated by these
 630 declarations.
 631
 632 \item
 633 The instance environment should have a magic way to know
 634 that each tuple type is an instances of classes @Eq@, @Ix@, @Ord@ and
 635 so on. \ToDo{Not implemented yet.}
 636
 637 \item
 638 There should also be a way to generate the appropriate code for each
 639 of these instances, but (like the info tables and entry code) it is
 640 done by enumeration\srcloc{lib/prelude/InTup?.hs}.
 641 \end{itemize}
 642
 643 \begin{code}
 644 mkTupleTy :: Int -> [UniType] -> UniType
 645
 646 mkTupleTy arity tys = applyTyCon (mkTupleTyCon arity) tys
 647
 648 unitTy = mkTupleTy 0 []
 649 \end{code}
 650
 651 %************************************************************************
 652 %*                                                                      *
 653 \subsection[TysWiredIn-Ratios]{@Ratio@ and @Rational@}
 654 %*                                                                      *
 655 %************************************************************************
 656
 657 ToDo: make this (mostly) go away.
 658
 659 \begin{code}
 660 rationalTy :: UniType
 661
 662 mkRatioTy ty = UniData ratioTyCon [ty]
 663 rationalTy   = mkRatioTy integerTy
 664
 665 ratioTyCon = pcDataTyCon ratioTyConKey pRELUDE_RATIO SLIT("Ratio") [alpha_tv] [ratioDataCon]
 666
 667 ratioDataCon = pcDataCon ratioDataConKey pRELUDE_RATIO SLIT(":%")
 668                 [alpha_tv] [{-(integralClass,alpha)-}] [alpha, alpha] ratioTyCon nullSpecEnv
 669         -- context omitted to match lib/prelude/ defn of "data Ratio ..."
 670
 671 rationalTyCon
 672   = mkSynonymTyCon
 673       rationalTyConKey
 674       (mkPreludeCoreName pRELUDE_RATIO SLIT("Rational"))
 675       0  -- arity
 676       [] -- tyvars
 677       rationalTy -- == mkRatioTy integerTy
 678       True -- unabstract
 679 \end{code}
 680
 681 %************************************************************************
 682 %*                                                                      *
 683 \subsection[TysWiredIn-_Lift]{@_Lift@ type: to support array indexing}
 684 %*                                                                      *
 685 %************************************************************************
 686
 687 Again, deeply turgid: \tr{data _Lift a = _Lift a}.
 688
 689 \begin{code}
 690 mkLiftTy ty = applyTyCon liftTyCon [ty]
 691
 692 {-
 693 mkLiftTy ty
 694   = mkSigmaTy tvs theta (UniData liftTyCon [tau])
 695   where
 696     (tvs, theta, tau) = splitType ty
 697
 698 isLiftTy ty
 699   = case getUniDataTyCon_maybe tau of
 700       Just (tycon, tys, _) -> tycon == liftTyCon
 701       Nothing -> False
 702   where
 703     (tvs, theta, tau) = splitType ty
 704 -}
 705
 706
 707 alphaLiftTy = mkSigmaTy [alpha_tv] [] (UniData liftTyCon [alpha])
 708
 709 liftTyCon
 710   = pcDataTyCon liftTyConKey pRELUDE_BUILTIN SLIT("_Lift") [alpha_tv] [liftDataCon]
 711
 712 liftDataCon
 713   = pcDataCon liftDataConKey pRELUDE_BUILTIN SLIT("_Lift")
 714                 [alpha_tv] [] [alpha] liftTyCon
 715                 ((pcGenerateDataSpecs alphaLiftTy) `addOneToSpecEnv`
 716                  (SpecInfo [Just realWorldStatePrimTy] 0 bottom))
 717   where
 718     bottom = panic "liftDataCon:State# _RealWorld"
 719 \end{code}
 720
 721
 722 %************************************************************************
 723 %*                                                                      *
 724 \subsection[TysWiredIn-for-convenience]{Types wired in for convenience (e.g., @String@)}
 725 %*                                                                      *
 726 %************************************************************************
 727
 728 \begin{code}
 729 stringTy = mkListTy charTy
 730
 731 stringTyCon
 732  = mkSynonymTyCon
 733      stringTyConKey
 734      (mkPreludeCoreName pRELUDE_CORE SLIT("String"))
 735      0
 736      []   -- type variables
 737      stringTy
 738      True -- unabstract
 739 \end{code}
 740
 741 \begin{code}
 742 {- UNUSED:
 743 packedStringTy = applyTyCon packedStringTyCon []
 744
 745 packedStringTyCon
 746   = pcDataTyCon packedStringTyConKey pRELUDE_PS SLIT("_PackedString") []
 747         [psDataCon, cpsDataCon]
 748
 749 psDataCon
 750   = pcDataCon psDataConKey pRELUDE_PS SLIT("_PS")
 751                 [] [] [intPrimTy, byteArrayPrimTy] packedStringTyCon
 752
 753 cpsDataCon
 754   = pcDataCon cpsDataConKey pRELUDE_PS SLIT("_CPS")
 755                 [] [] [addrPrimTy] packedStringTyCon
 756 -}
 757 \end{code}