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         eqDataCon,
  29         falseDataCon,
  30         floatDataCon,
  31         floatTy,
  32         floatTyCon,
  33         getStatePairingConInfo,
  34         gtDataCon,
  35         intDataCon,
  36         intTy,
  37         intTyCon,
  38         integerTy,
  39         integerTyCon,
  40         integerDataCon,
  41         liftDataCon,
  42         liftTyCon,
  43         listTyCon,
  44         ltDataCon,
  45         mallocPtrTyCon,
  46         mkLiftTy,
  47         mkListTy,
  48         mkPrimIoTy,
  49         mkStateTransformerTy,
  50         mkTupleTy,
  51         nilDataCon,
  52         orderingTy,
  53         orderingTyCon,
  54         primIoTyCon,
  55         ratioDataCon,
  56         ratioTyCon,
  57         rationalTy,
  58         rationalTyCon,
  59         realWorldStateTy,
  60         return2GMPsTyCon,
  61         returnIntAndGMPTyCon,
  62         stTyCon,
  63         stablePtrTyCon,
  64         stateAndAddrPrimTyCon,
  65         stateAndArrayPrimTyCon,
  66         stateAndByteArrayPrimTyCon,
  67         stateAndCharPrimTyCon,
  68         stateAndDoublePrimTyCon,
  69         stateAndFloatPrimTyCon,
  70         stateAndIntPrimTyCon,
  71         stateAndMallocPtrPrimTyCon,
  72         stateAndMutableArrayPrimTyCon,
  73         stateAndMutableByteArrayPrimTyCon,
  74         stateAndPtrPrimTyCon,
  75         stateAndStablePtrPrimTyCon,
  76         stateAndSynchVarPrimTyCon,
  77         stateAndWordPrimTyCon,
  78         stateDataCon,
  79         stateTyCon,
  80         stringTy,
  81         stringTyCon,
  82         trueDataCon,
  83         unitTy,
  84         wordDataCon,
  85         wordTy,
  86         wordTyCon
  87
  88     ) where
  89
  90 --ToDo:rm
  91 --import Pretty
  92 --import Util
  93 --import PprType
  94 --import PprStyle
  95 --import Kind
  96
  97 import Ubiq
  98 import TyLoop           ( mkDataCon, StrictnessMark(..) )
  99
 100 -- friends:
 101 import PrelMods
 102 import TysPrim
 103
 104 -- others:
 105 import SpecEnv          ( SpecEnv(..) )
 106 import Kind             ( mkBoxedTypeKind, mkArrowKind )
 107 import Name             ( mkBuiltinName )
 108 import SrcLoc           ( mkBuiltinSrcLoc )
 109 import TyCon            ( mkDataTyCon, mkTupleTyCon, mkSynTyCon,
 110                           NewOrData(..), TyCon
 111                         )
 112 import Type             ( mkTyConTy, applyTyCon, mkSynTy, mkSigmaTy,
 113                           mkFunTys, maybeAppDataTyCon,
 114                           GenType(..), ThetaType(..), TauType(..) )
 115 import TyVar            ( tyVarKind, alphaTyVar, betaTyVar )
 116 import Unique
 117 import Util             ( assoc, panic )
 118
 119 nullSpecEnv =  error "TysWiredIn:nullSpecEnv =  "
 120 addOneToSpecEnv =  error "TysWiredIn:addOneToSpecEnv =  "
 121 pc_gen_specs = error "TysWiredIn:pc_gen_specs  "
 122 mkSpecInfo = error "TysWiredIn:SpecInfo"
 123
 124 pcDataTyCon :: Unique{-TyConKey-} -> Module -> FAST_STRING
 125             -> [TyVar] -> [Id] -> TyCon
 126 pcDataTyCon key mod str tyvars cons
 127   = mkDataTyCon (mkBuiltinName key mod str) tycon_kind
 128                 tyvars [{-no context-}] cons [{-no derivings-}]
 129                 DataType
 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 (mkBuiltinName key mod str)
 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_BUILTIN SLIT("Char") [] [charDataCon]
 159 charDataCon = pcDataCon charDataConKey pRELUDE_BUILTIN SLIT("C#") [] [] [charPrimTy] charTyCon nullSpecEnv
 160 \end{code}
 161
 162 \begin{code}
 163 intTy = mkTyConTy intTyCon
 164
 165 intTyCon = pcDataTyCon intTyConKey pRELUDE_BUILTIN SLIT("Int") [] [intDataCon]
 166 intDataCon = pcDataCon intDataConKey pRELUDE_BUILTIN SLIT("I#") [] [] [intPrimTy] intTyCon nullSpecEnv
 167 \end{code}
 168
 169 \begin{code}
 170 wordTy = mkTyConTy wordTyCon
 171
 172 wordTyCon = pcDataTyCon wordTyConKey pRELUDE_BUILTIN SLIT("_Word") [] [wordDataCon]
 173 wordDataCon = pcDataCon wordDataConKey pRELUDE_BUILTIN SLIT("W#") [] [] [wordPrimTy] wordTyCon nullSpecEnv
 174 \end{code}
 175
 176 \begin{code}
 177 addrTy = mkTyConTy addrTyCon
 178
 179 addrTyCon = pcDataTyCon addrTyConKey pRELUDE_BUILTIN SLIT("_Addr") [] [addrDataCon]
 180 addrDataCon = pcDataCon addrDataConKey pRELUDE_BUILTIN SLIT("A#") [] [] [addrPrimTy] addrTyCon nullSpecEnv
 181 \end{code}
 182
 183 \begin{code}
 184 floatTy = mkTyConTy floatTyCon
 185
 186 floatTyCon = pcDataTyCon floatTyConKey pRELUDE_BUILTIN SLIT("Float") [] [floatDataCon]
 187 floatDataCon = pcDataCon floatDataConKey pRELUDE_BUILTIN SLIT("F#") [] [] [floatPrimTy] floatTyCon nullSpecEnv
 188 \end{code}
 189
 190 \begin{code}
 191 doubleTy = mkTyConTy doubleTyCon
 192
 193 doubleTyCon = pcDataTyCon doubleTyConKey pRELUDE_BUILTIN SLIT("Double") [] [doubleDataCon]
 194 doubleDataCon = pcDataCon doubleDataConKey pRELUDE_BUILTIN 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 pRELUDE_BUILTIN SLIT("_State") [alphaTyVar] [stateDataCon]
 202 stateDataCon
 203   = pcDataCon stateDataConKey pRELUDE_BUILTIN SLIT("S#")
 204         [alphaTyVar] [] [mkStatePrimTy alphaTy] stateTyCon nullSpecEnv
 205 \end{code}
 206
 207 \begin{code}
 208 stablePtrTyCon
 209   = pcDataTyCon stablePtrTyConKey gLASGOW_MISC SLIT("_StablePtr")
 210         [alphaTyVar] [stablePtrDataCon]
 211   where
 212     stablePtrDataCon
 213       = pcDataCon stablePtrDataConKey gLASGOW_MISC SLIT("_StablePtr")
 214             [alphaTyVar] [] [applyTyCon stablePtrPrimTyCon [alphaTy]] stablePtrTyCon nullSpecEnv
 215 \end{code}
 216
 217 \begin{code}
 218 mallocPtrTyCon
 219   = pcDataTyCon mallocPtrTyConKey gLASGOW_MISC SLIT("_MallocPtr")
 220         [] [mallocPtrDataCon]
 221   where
 222     mallocPtrDataCon
 223       = pcDataCon mallocPtrDataConKey gLASGOW_MISC SLIT("_MallocPtr")
 224             [] [] [applyTyCon mallocPtrPrimTyCon []] mallocPtrTyCon 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_BUILTIN SLIT("Integer") [] [integerDataCon]
 239
 240 integerDataCon = pcDataCon integerDataConKey pRELUDE_BUILTIN 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         pRELUDE_BUILTIN SLIT("_Return2GMPs") [] [return2GMPsDataCon]
 248
 249 return2GMPsDataCon
 250   = pcDataCon return2GMPsDataConKey pRELUDE_BUILTIN SLIT("_Return2GMPs") [] []
 251         [intPrimTy, intPrimTy, byteArrayPrimTy,
 252          intPrimTy, intPrimTy, byteArrayPrimTy] return2GMPsTyCon nullSpecEnv
 253
 254 returnIntAndGMPTyCon = pcDataTyCon returnIntAndGMPTyConKey
 255         pRELUDE_BUILTIN SLIT("_ReturnIntAndGMP") [] [returnIntAndGMPDataCon]
 256
 257 returnIntAndGMPDataCon
 258   = pcDataCon returnIntAndGMPDataConKey pRELUDE_BUILTIN 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 pRELUDE_BUILTIN SLIT("StateAndPtr#")
 278                 [alphaTyVar, betaTyVar] [stateAndPtrPrimDataCon]
 279 stateAndPtrPrimDataCon
 280   = pcDataCon stateAndPtrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndPtr#")
 281                 [alphaTyVar, betaTyVar] [] [mkStatePrimTy alphaTy, betaTy]
 282                 stateAndPtrPrimTyCon nullSpecEnv
 283
 284 stateAndCharPrimTyCon
 285   = pcDataTyCon stateAndCharPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndChar#")
 286                 [alphaTyVar] [stateAndCharPrimDataCon]
 287 stateAndCharPrimDataCon
 288   = pcDataCon stateAndCharPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndChar#")
 289                 [alphaTyVar] [] [mkStatePrimTy alphaTy, charPrimTy]
 290                 stateAndCharPrimTyCon nullSpecEnv
 291
 292 stateAndIntPrimTyCon
 293   = pcDataTyCon stateAndIntPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndInt#")
 294                 [alphaTyVar] [stateAndIntPrimDataCon]
 295 stateAndIntPrimDataCon
 296   = pcDataCon stateAndIntPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndInt#")
 297                 [alphaTyVar] [] [mkStatePrimTy alphaTy, intPrimTy]
 298                 stateAndIntPrimTyCon nullSpecEnv
 299
 300 stateAndWordPrimTyCon
 301   = pcDataTyCon stateAndWordPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndWord#")
 302                 [alphaTyVar] [stateAndWordPrimDataCon]
 303 stateAndWordPrimDataCon
 304   = pcDataCon stateAndWordPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndWord#")
 305                 [alphaTyVar] [] [mkStatePrimTy alphaTy, wordPrimTy]
 306                 stateAndWordPrimTyCon nullSpecEnv
 307
 308 stateAndAddrPrimTyCon
 309   = pcDataTyCon stateAndAddrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndAddr#")
 310                 [alphaTyVar] [stateAndAddrPrimDataCon]
 311 stateAndAddrPrimDataCon
 312   = pcDataCon stateAndAddrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndAddr#")
 313                 [alphaTyVar] [] [mkStatePrimTy alphaTy, addrPrimTy]
 314                 stateAndAddrPrimTyCon nullSpecEnv
 315
 316 stateAndStablePtrPrimTyCon
 317   = pcDataTyCon stateAndStablePtrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndStablePtr#")
 318                 [alphaTyVar, betaTyVar] [stateAndStablePtrPrimDataCon]
 319 stateAndStablePtrPrimDataCon
 320   = pcDataCon stateAndStablePtrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndStablePtr#")
 321                 [alphaTyVar, betaTyVar] []
 322                 [mkStatePrimTy alphaTy, applyTyCon stablePtrPrimTyCon [betaTy]]
 323                 stateAndStablePtrPrimTyCon nullSpecEnv
 324
 325 stateAndMallocPtrPrimTyCon
 326   = pcDataTyCon stateAndMallocPtrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndMallocPtr#")
 327                 [alphaTyVar] [stateAndMallocPtrPrimDataCon]
 328 stateAndMallocPtrPrimDataCon
 329   = pcDataCon stateAndMallocPtrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndMallocPtr#")
 330                 [alphaTyVar] []
 331                 [mkStatePrimTy alphaTy, applyTyCon mallocPtrPrimTyCon []]
 332                 stateAndMallocPtrPrimTyCon nullSpecEnv
 333
 334 stateAndFloatPrimTyCon
 335   = pcDataTyCon stateAndFloatPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndFloat#")
 336                 [alphaTyVar] [stateAndFloatPrimDataCon]
 337 stateAndFloatPrimDataCon
 338   = pcDataCon stateAndFloatPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndFloat#")
 339                 [alphaTyVar] [] [mkStatePrimTy alphaTy, floatPrimTy]
 340                 stateAndFloatPrimTyCon nullSpecEnv
 341
 342 stateAndDoublePrimTyCon
 343   = pcDataTyCon stateAndDoublePrimTyConKey pRELUDE_BUILTIN SLIT("StateAndDouble#")
 344                 [alphaTyVar] [stateAndDoublePrimDataCon]
 345 stateAndDoublePrimDataCon
 346   = pcDataCon stateAndDoublePrimDataConKey pRELUDE_BUILTIN SLIT("StateAndDouble#")
 347                 [alphaTyVar] [] [mkStatePrimTy alphaTy, doublePrimTy]
 348                 stateAndDoublePrimTyCon nullSpecEnv
 349 \end{code}
 350
 351 \begin{code}
 352 stateAndArrayPrimTyCon
 353   = pcDataTyCon stateAndArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndArray#")
 354                 [alphaTyVar, betaTyVar] [stateAndArrayPrimDataCon]
 355 stateAndArrayPrimDataCon
 356   = pcDataCon stateAndArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndArray#")
 357                 [alphaTyVar, betaTyVar] [] [mkStatePrimTy alphaTy, mkArrayPrimTy betaTy]
 358                 stateAndArrayPrimTyCon nullSpecEnv
 359
 360 stateAndMutableArrayPrimTyCon
 361   = pcDataTyCon stateAndMutableArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndMutableArray#")
 362                 [alphaTyVar, betaTyVar] [stateAndMutableArrayPrimDataCon]
 363 stateAndMutableArrayPrimDataCon
 364   = pcDataCon stateAndMutableArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndMutableArray#")
 365                 [alphaTyVar, betaTyVar] [] [mkStatePrimTy alphaTy, mkMutableArrayPrimTy alphaTy betaTy]
 366                 stateAndMutableArrayPrimTyCon nullSpecEnv
 367
 368 stateAndByteArrayPrimTyCon
 369   = pcDataTyCon stateAndByteArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndByteArray#")
 370                 [alphaTyVar] [stateAndByteArrayPrimDataCon]
 371 stateAndByteArrayPrimDataCon
 372   = pcDataCon stateAndByteArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndByteArray#")
 373                 [alphaTyVar] [] [mkStatePrimTy alphaTy, byteArrayPrimTy]
 374                 stateAndByteArrayPrimTyCon nullSpecEnv
 375
 376 stateAndMutableByteArrayPrimTyCon
 377   = pcDataTyCon stateAndMutableByteArrayPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndMutableByteArray#")
 378                 [alphaTyVar] [stateAndMutableByteArrayPrimDataCon]
 379 stateAndMutableByteArrayPrimDataCon
 380   = pcDataCon stateAndMutableByteArrayPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndMutableByteArray#")
 381                 [alphaTyVar] [] [mkStatePrimTy alphaTy, applyTyCon mutableByteArrayPrimTyCon [alphaTy]]
 382                 stateAndMutableByteArrayPrimTyCon nullSpecEnv
 383
 384 stateAndSynchVarPrimTyCon
 385   = pcDataTyCon stateAndSynchVarPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndSynchVar#")
 386                 [alphaTyVar, betaTyVar] [stateAndSynchVarPrimDataCon]
 387 stateAndSynchVarPrimDataCon
 388   = pcDataCon stateAndSynchVarPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndSynchVar#")
 389                 [alphaTyVar, betaTyVar] [] [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 (maybeAppDataTyCon 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         (mallocPtrPrimTyCon, (stateAndMallocPtrPrimDataCon, stateAndMallocPtrPrimTyCon, 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 = mkSynTy stTyCon [s, a]
 441
 442 stTyCon
 443   = let
 444         ty = mkFunTys [mkStateTy alphaTy] (mkTupleTy 2 [betaTy, mkStateTy alphaTy])
 445     in
 446     mkSynTyCon
 447      (mkBuiltinName stTyConKey gLASGOW_ST SLIT("_ST"))
 448      (mkBoxedTypeKind `mkArrowKind` (mkBoxedTypeKind `mkArrowKind` mkBoxedTypeKind))
 449      2 [alphaTyVar, betaTyVar]
 450      ty
 451 \end{code}
 452
 453 %************************************************************************
 454 %*                                                                      *
 455 \subsection[TysWiredIn-IO]{The @PrimIO@ and @IO@ monadic-I/O types}
 456 %*                                                                      *
 457 %************************************************************************
 458
 459 @PrimIO@ and @IO@ really are just plain synonyms.
 460
 461 \begin{code}
 462 mkPrimIoTy a = mkSynTy primIoTyCon [a]
 463
 464 primIoTyCon
 465   = let
 466         ty = mkStateTransformerTy realWorldTy alphaTy
 467     in
 468 --  pprTrace "primIOTyCon:" (ppCat [pprType PprDebug ty, ppr PprDebug (typeKind ty)]) $
 469     mkSynTyCon
 470      (mkBuiltinName primIoTyConKey pRELUDE_PRIMIO SLIT("PrimIO"))
 471      (mkBoxedTypeKind `mkArrowKind` mkBoxedTypeKind)
 472      1 [alphaTyVar] ty
 473 \end{code}
 474
 475 %************************************************************************
 476 %*                                                                      *
 477 \subsection[TysWiredIn-Bool]{The @Bool@ type}
 478 %*                                                                      *
 479 %************************************************************************
 480
 481 An ordinary enumeration type, but deeply wired in.  There are no
 482 magical operations on @Bool@ (just the regular Prelude code).
 483
 484 {\em BEGIN IDLE SPECULATION BY SIMON}
 485
 486 This is not the only way to encode @Bool@.  A more obvious coding makes
 487 @Bool@ just a boxed up version of @Bool#@, like this:
 488 \begin{verbatim}
 489 type Bool# = Int#
 490 data Bool = MkBool Bool#
 491 \end{verbatim}
 492
 493 Unfortunately, this doesn't correspond to what the Report says @Bool@
 494 looks like!  Furthermore, we get slightly less efficient code (I
 495 think) with this coding. @gtInt@ would look like this:
 496
 497 \begin{verbatim}
 498 gtInt :: Int -> Int -> Bool
 499 gtInt x y = case x of I# x# ->
 500             case y of I# y# ->
 501             case (gtIntPrim x# y#) of
 502                 b# -> MkBool b#
 503 \end{verbatim}
 504
 505 Notice that the result of the @gtIntPrim@ comparison has to be turned
 506 into an integer (here called @b#@), and returned in a @MkBool@ box.
 507
 508 The @if@ expression would compile to this:
 509 \begin{verbatim}
 510 case (gtInt x y) of
 511   MkBool b# -> case b# of { 1# -> e1; 0# -> e2 }
 512 \end{verbatim}
 513
 514 I think this code is a little less efficient than the previous code,
 515 but I'm not certain.  At all events, corresponding with the Report is
 516 important.  The interesting thing is that the language is expressive
 517 enough to describe more than one alternative; and that a type doesn't
 518 necessarily need to be a straightforwardly boxed version of its
 519 primitive counterpart.
 520
 521 {\em END IDLE SPECULATION BY SIMON}
 522
 523 \begin{code}
 524 boolTy = mkTyConTy boolTyCon
 525
 526 boolTyCon = pcDataTyCon boolTyConKey pRELUDE_CORE SLIT("Bool") [] [falseDataCon, trueDataCon]
 527
 528 falseDataCon = pcDataCon falseDataConKey pRELUDE_CORE SLIT("False") [] [] [] boolTyCon nullSpecEnv
 529 trueDataCon  = pcDataCon trueDataConKey  pRELUDE_CORE SLIT("True")  [] [] [] boolTyCon nullSpecEnv
 530 \end{code}
 531
 532 %************************************************************************
 533 %*                                                                      *
 534 \subsection[TysWiredIn-Ordering]{The @Ordering@ type}
 535 %*                                                                      *
 536 %************************************************************************
 537
 538 \begin{code}
 539 ---------------------------------------------
 540 -- data Ordering = LT | EQ | GT deriving ()
 541 ---------------------------------------------
 542
 543 orderingTy = mkTyConTy orderingTyCon
 544
 545 orderingTyCon = pcDataTyCon orderingTyConKey pRELUDE_BUILTIN SLIT("Ordering") []
 546                             [ltDataCon, eqDataCon, gtDataCon]
 547
 548 ltDataCon  = pcDataCon ltDataConKey pRELUDE_BUILTIN SLIT("LT") [] [] [] orderingTyCon nullSpecEnv
 549 eqDataCon  = pcDataCon eqDataConKey pRELUDE_BUILTIN SLIT("EQ") [] [] [] orderingTyCon nullSpecEnv
 550 gtDataCon  = pcDataCon gtDataConKey pRELUDE_BUILTIN SLIT("GT") [] [] [] orderingTyCon nullSpecEnv
 551 \end{code}
 552
 553 %************************************************************************
 554 %*                                                                      *
 555 \subsection[TysWiredIn-List]{The @List@ type (incl ``build'' magic)}
 556 %*                                                                      *
 557 %************************************************************************
 558
 559 Special syntax, deeply wired in, but otherwise an ordinary algebraic
 560 data type:
 561 \begin{verbatim}
 562 data List a = Nil | a : (List a)
 563 ToDo: data [] a = [] | a : (List a)
 564 ToDo: data () = ()
 565       data (,,) a b c = (,,) a b c
 566 \end{verbatim}
 567
 568 \begin{code}
 569 mkListTy :: GenType t u -> GenType t u
 570 mkListTy ty = applyTyCon listTyCon [ty]
 571
 572 alphaListTy = mkSigmaTy [alphaTyVar] [] (applyTyCon listTyCon [alphaTy])
 573
 574 listTyCon = pcDataTyCon listTyConKey pRELUDE_BUILTIN SLIT("[]")
 575                         [alphaTyVar] [nilDataCon, consDataCon]
 576
 577 nilDataCon  = pcDataCon nilDataConKey  pRELUDE_BUILTIN SLIT("[]") [alphaTyVar] [] [] listTyCon
 578                 (pcGenerateDataSpecs alphaListTy)
 579 consDataCon = pcDataCon consDataConKey pRELUDE_BUILTIN SLIT(":")
 580                 [alphaTyVar] [] [alphaTy, applyTyCon listTyCon [alphaTy]] listTyCon
 581                 (pcGenerateDataSpecs alphaListTy)
 582 -- Interesting: polymorphic recursion would help here.
 583 -- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy
 584 -- gets the over-specific type (Type -> Type)
 585 \end{code}
 586
 587 %************************************************************************
 588 %*                                                                      *
 589 \subsection[TysWiredIn-Tuples]{The @Tuple@ types}
 590 %*                                                                      *
 591 %************************************************************************
 592
 593 The tuple types are definitely magic, because they form an infinite
 594 family.
 595
 596 \begin{itemize}
 597 \item
 598 They have a special family of type constructors, of type @TyCon@
 599 These contain the tycon arity, but don't require a Unique.
 600
 601 \item
 602 They have a special family of constructors, of type
 603 @Id@. Again these contain their arity but don't need a Unique.
 604
 605 \item
 606 There should be a magic way of generating the info tables and
 607 entry code for all tuples.
 608
 609 But at the moment we just compile a Haskell source
 610 file\srcloc{lib/prelude/...} containing declarations like:
 611 \begin{verbatim}
 612 data Tuple0             = Tup0
 613 data Tuple2  a b        = Tup2  a b
 614 data Tuple3  a b c      = Tup3  a b c
 615 data Tuple4  a b c d    = Tup4  a b c d
 616 ...
 617 \end{verbatim}
 618 The print-names associated with the magic @Id@s for tuple constructors
 619 ``just happen'' to be the same as those generated by these
 620 declarations.
 621
 622 \item
 623 The instance environment should have a magic way to know
 624 that each tuple type is an instances of classes @Eq@, @Ix@, @Ord@ and
 625 so on. \ToDo{Not implemented yet.}
 626
 627 \item
 628 There should also be a way to generate the appropriate code for each
 629 of these instances, but (like the info tables and entry code) it is
 630 done by enumeration\srcloc{lib/prelude/InTup?.hs}.
 631 \end{itemize}
 632
 633 \begin{code}
 634 mkTupleTy :: Int -> [GenType t u] -> GenType t u
 635
 636 mkTupleTy arity tys = applyTyCon (mkTupleTyCon arity) tys
 637
 638 unitTy    = mkTupleTy 0 []
 639 \end{code}
 640
 641 %************************************************************************
 642 %*                                                                      *
 643 \subsection[TysWiredIn-Ratios]{@Ratio@ and @Rational@}
 644 %*                                                                      *
 645 %************************************************************************
 646
 647 ToDo: make this (mostly) go away.
 648
 649 \begin{code}
 650 rationalTy :: GenType t u
 651
 652 mkRatioTy ty = applyTyCon ratioTyCon [ty]
 653 rationalTy   = mkRatioTy integerTy
 654
 655 ratioTyCon = pcDataTyCon ratioTyConKey pRELUDE_RATIO SLIT("Ratio") [alphaTyVar] [ratioDataCon]
 656
 657 ratioDataCon = pcDataCon ratioDataConKey pRELUDE_RATIO SLIT(":%")
 658                 [alphaTyVar] [{-(integralClass,alphaTy)-}] [alphaTy, alphaTy] ratioTyCon nullSpecEnv
 659         -- context omitted to match lib/prelude/ defn of "data Ratio ..."
 660
 661 rationalTyCon
 662   = mkSynTyCon
 663       (mkBuiltinName rationalTyConKey pRELUDE_RATIO SLIT("Rational"))
 664       mkBoxedTypeKind
 665       0 [] rationalTy -- == mkRatioTy integerTy
 666 \end{code}
 667
 668 %************************************************************************
 669 %*                                                                      *
 670 \subsection[TysWiredIn-_Lift]{@_Lift@ type: to support array indexing}
 671 %*                                                                      *
 672 %************************************************************************
 673
 674 Again, deeply turgid: \tr{data _Lift a = _Lift a}.
 675
 676 \begin{code}
 677 mkLiftTy ty = applyTyCon liftTyCon [ty]
 678
 679 {-
 680 mkLiftTy ty
 681   = mkSigmaTy tvs theta (applyTyCon liftTyCon [tau])
 682   where
 683     (tvs, theta, tau) = splitSigmaTy ty
 684
 685 isLiftTy ty
 686   = case maybeAppDataTyCon tau of
 687       Just (tycon, tys, _) -> tycon == liftTyCon
 688       Nothing -> False
 689   where
 690     (tvs, theta, tau) = splitSigmaTy ty
 691 -}
 692
 693
 694 alphaLiftTy = mkSigmaTy [alphaTyVar] [] (applyTyCon liftTyCon [alphaTy])
 695
 696 liftTyCon
 697   = pcDataTyCon liftTyConKey pRELUDE_BUILTIN SLIT("_Lift") [alphaTyVar] [liftDataCon]
 698
 699 liftDataCon
 700   = pcDataCon liftDataConKey pRELUDE_BUILTIN SLIT("_Lift")
 701                 [alphaTyVar] [] [alphaTy] liftTyCon
 702                 ((pcGenerateDataSpecs alphaLiftTy) `addOneToSpecEnv`
 703                  (mkSpecInfo [Just realWorldStatePrimTy] 0 bottom))
 704   where
 705     bottom = panic "liftDataCon:State# _RealWorld"
 706 \end{code}
 707
 708
 709 %************************************************************************
 710 %*                                                                      *
 711 \subsection[TysWiredIn-for-convenience]{Types wired in for convenience (e.g., @String@)}
 712 %*                                                                      *
 713 %************************************************************************
 714
 715 \begin{code}
 716 stringTy = mkListTy charTy
 717
 718 stringTyCon
 719  = mkSynTyCon
 720      (mkBuiltinName stringTyConKey pRELUDE_CORE SLIT("String"))
 721      mkBoxedTypeKind
 722      0 [] stringTy
 723 \end{code}