utils/ext-core/Prims.hs

   1 {- This module really should be auto-generated from the master primops.txt file.
   2    It is roughly correct (but may be slightly incomplete) wrt/ GHC5.02. -}
   3
   4 module Prims where
   5
   6 import Core
   7 import Env
   8 import Check
   9
  10 initialEnv :: Menv
  11 initialEnv = efromlist [(primMname,primEnv),
  12                      ("PrelErr",errorEnv)]
  13
  14 primEnv :: Envs
  15 primEnv = Envs {tcenv_=efromlist primTcs,
  16                 tsenv_=eempty,
  17                 cenv_=efromlist primDcs,
  18                 venv_=efromlist primVals}
  19
  20 errorEnv :: Envs
  21 errorEnv = Envs {tcenv_=eempty,
  22                  tsenv_=eempty,
  23                  cenv_=eempty,
  24                  venv_=efromlist errorVals}
  25
  26 {- Components of static environment -}
  27
  28 primTcs :: [(Tcon,Kind)]
  29 primTcs =
  30         map (\ ((m,tc),k) -> (tc,k))
  31         ([(tcArrow,ktArrow),
  32          (tcAddrzh,ktAddrzh),
  33          (tcCharzh,ktCharzh),
  34          (tcDoublezh,ktDoublezh),
  35          (tcFloatzh,ktFloatzh),
  36          (tcIntzh,ktIntzh),
  37          (tcInt32zh,ktInt32zh),
  38          (tcInt64zh,ktInt64zh),
  39          (tcWordzh,ktWordzh),
  40          (tcWord32zh,ktWord32zh),
  41          (tcWord64zh,ktWord64zh),
  42          (tcRealWorld, ktRealWorld),
  43          (tcStatezh, ktStatezh),
  44          (tcArrayzh,ktArrayzh),
  45          (tcByteArrayzh,ktByteArrayzh),
  46          (tcMutableArrayzh,ktMutableArrayzh),
  47          (tcMutableByteArrayzh,ktMutableByteArrayzh),
  48          (tcMutVarzh,ktMutVarzh),
  49          (tcMVarzh,ktMVarzh),
  50          (tcWeakzh,ktWeakzh),
  51          (tcForeignObjzh, ktForeignObjzh),
  52          (tcStablePtrzh, ktStablePtrzh),
  53          (tcThreadIdzh, ktThreadIdzh),
  54          (tcZCTCCallable, ktZCTCCallable),
  55          (tcZCTCReturnable, ktZCTCReturnable)]
  56        ++ [(tcUtuple n, ktUtuple n) | n <- [1..maxUtuple]])
  57
  58
  59 primDcs :: [(Dcon,Ty)]
  60 primDcs = map (\ ((m,c),t) -> (c,t))
  61               [(dcUtuple n, dcUtupleTy n) | n <- [1..maxUtuple]]
  62
  63 primVals :: [(Var,Ty)]
  64 primVals =
  65         opsAddrzh ++
  66         opsCharzh ++
  67         opsDoublezh ++
  68         opsFloatzh ++
  69         opsIntzh ++
  70         opsInt32zh ++
  71         opsInt64zh ++
  72         opsIntegerzh ++
  73         opsWordzh ++
  74         opsWord32zh ++
  75         opsWord64zh ++
  76         opsSized ++
  77         opsArray ++
  78         opsMutVarzh ++
  79         opsState ++
  80         opsExn ++
  81         opsMVar ++
  82         opsWeak ++
  83         opsForeignObjzh ++
  84         opsStablePtrzh ++
  85         opsConc ++
  86         opsMisc
  87
  88
  89 dcUtuples :: [(Qual Dcon,Ty)]
  90 dcUtuples = map ( \n -> (dcUtuple n, typ n)) [1..100]
  91      where typ n = foldr ( \tv t -> Tforall (tv,Kopen) t)
  92                                 (foldr ( \tv t -> tArrow (Tvar tv) t)
  93                                              (tUtuple (map Tvar tvs)) tvs) tvs
  94                       where tvs = map ( \i -> ("a" ++ (show i))) [1..n]
  95
  96
  97 {- Addrzh -}
  98
  99 tcAddrzh = (primMname,"Addrzh")
 100 tAddrzh = Tcon tcAddrzh
 101 ktAddrzh = Kunlifted
 102
 103 opsAddrzh = [
 104  ("gtAddrzh",tcompare tAddrzh),
 105  ("geAddrzh",tcompare tAddrzh),
 106  ("eqAddrzh",tcompare tAddrzh),
 107  ("neAddrzh",tcompare tAddrzh),
 108  ("ltAddrzh",tcompare tAddrzh),
 109  ("leAddrzh",tcompare tAddrzh),
 110  ("nullAddrzh", tAddrzh),
 111  ("plusAddrzh", tArrow tAddrzh (tArrow tIntzh tAddrzh)),
 112  ("minusAddrzh", tArrow tAddrzh (tArrow tAddrzh tIntzh)),
 113  ("remAddrzh", tArrow tAddrzh (tArrow tIntzh tIntzh))]
 114
 115 {- Charzh -}
 116
 117 tcCharzh = (primMname,"Charzh")
 118 tCharzh = Tcon tcCharzh
 119 ktCharzh = Kunlifted
 120
 121 opsCharzh = [
 122  ("gtCharzh", tcompare tCharzh),
 123  ("geCharzh", tcompare tCharzh),
 124  ("eqCharzh", tcompare tCharzh),
 125  ("neCharzh", tcompare tCharzh),
 126  ("ltCharzh", tcompare tCharzh),
 127  ("leCharzh", tcompare tCharzh),
 128  ("ordzh",    tArrow tCharzh tIntzh)]
 129
 130
 131 {- Doublezh -}
 132
 133 tcDoublezh = (primMname, "Doublezh")
 134 tDoublezh = Tcon tcDoublezh
 135 ktDoublezh = Kunlifted
 136
 137 opsDoublezh = [
 138  ("zgzhzh", tcompare tDoublezh),
 139  ("zgzezhzh", tcompare tDoublezh),
 140  ("zezezhzh", tcompare tDoublezh),
 141  ("zszezhzh", tcompare tDoublezh),
 142  ("zlzhzh", tcompare tDoublezh),
 143  ("zlzezhzh", tcompare tDoublezh),
 144  ("zpzhzh", tdyadic tDoublezh),
 145  ("zmzhzh", tdyadic tDoublezh),
 146  ("ztzhzh", tdyadic tDoublezh),
 147  ("zszhzh", tdyadic tDoublezh),
 148  ("negateDoublezh", tmonadic tDoublezh),
 149  ("double2Intzh", tArrow tDoublezh tIntzh),
 150  ("double2Floatzh", tArrow tDoublezh tFloatzh),
 151  ("expDoublezh", tmonadic tDoublezh),
 152  ("logDoublezh", tmonadic tDoublezh),
 153  ("sqrtDoublezh", tmonadic tDoublezh),
 154  ("sinDoublezh", tmonadic tDoublezh),
 155  ("cosDoublezh", tmonadic tDoublezh),
 156  ("tanDoublezh", tmonadic tDoublezh),
 157  ("asinDoublezh", tmonadic tDoublezh),
 158  ("acosDoublezh", tmonadic tDoublezh),
 159  ("atanDoublezh", tmonadic tDoublezh),
 160  ("sinhDoublezh", tmonadic tDoublezh),
 161  ("coshDoublezh", tmonadic tDoublezh),
 162  ("tanhDoublezh", tmonadic tDoublezh),
 163  ("ztztzhzh", tdyadic tDoublezh),
 164  ("decodeDoublezh", tArrow tDoublezh (tUtuple[tIntzh,tIntzh,tByteArrayzh]))]
 165
 166
 167 {- Floatzh -}
 168
 169 tcFloatzh = (primMname, "Floatzh")
 170 tFloatzh = Tcon tcFloatzh
 171 ktFloatzh = Kunlifted
 172
 173 opsFloatzh = [
 174  ("gtFloatzh", tcompare tFloatzh),
 175  ("geFloatzh", tcompare tFloatzh),
 176  ("eqFloatzh", tcompare tFloatzh),
 177  ("neFloatzh", tcompare tFloatzh),
 178  ("ltFloatzh", tcompare tFloatzh),
 179  ("leFloatzh", tcompare tFloatzh),
 180  ("plusFloatzh", tdyadic tFloatzh),
 181  ("minusFloatzh", tdyadic tFloatzh),
 182  ("timesFloatzh", tdyadic tFloatzh),
 183  ("divideFloatzh", tdyadic tFloatzh),
 184  ("negateFloatzh", tmonadic tFloatzh),
 185  ("float2Intzh", tArrow tFloatzh tIntzh),
 186  ("expFloatzh", tmonadic tFloatzh),
 187  ("logFloatzh", tmonadic tFloatzh),
 188  ("sqrtFloatzh", tmonadic tFloatzh),
 189  ("sinFloatzh", tmonadic tFloatzh),
 190  ("cosFloatzh", tmonadic tFloatzh),
 191  ("tanFloatzh", tmonadic tFloatzh),
 192  ("asinFloatzh", tmonadic tFloatzh),
 193  ("acosFloatzh", tmonadic tFloatzh),
 194  ("atanFloatzh", tmonadic tFloatzh),
 195  ("sinhFloatzh", tmonadic tFloatzh),
 196  ("coshFloatzh", tmonadic tFloatzh),
 197  ("tanhFloatzh", tmonadic tFloatzh),
 198  ("powerFloatzh", tdyadic tFloatzh),
 199  ("float2Doublezh", tArrow tFloatzh tDoublezh),
 200  ("decodeFloatzh", tArrow tFloatzh (tUtuple[tIntzh,tIntzh,tByteArrayzh]))]
 201
 202
 203 {- Intzh -}
 204
 205 tcIntzh = (primMname,"Intzh")
 206 tIntzh = Tcon tcIntzh
 207 ktIntzh = Kunlifted
 208
 209 opsIntzh = [
 210  ("zpzh", tdyadic tIntzh),
 211  ("zmzh", tdyadic tIntzh),
 212  ("ztzh", tdyadic tIntzh),
 213  ("quotIntzh", tdyadic tIntzh),
 214  ("remIntzh", tdyadic tIntzh),
 215  ("gcdIntzh", tdyadic tIntzh),
 216  ("negateIntzh", tmonadic tIntzh),
 217  ("addIntCzh", tArrow tIntzh (tArrow tIntzh (tUtuple [tIntzh, tIntzh]))),
 218  ("subIntCzh", tArrow tIntzh (tArrow tIntzh (tUtuple [tIntzh, tIntzh]))),
 219  ("mulIntCzh", tArrow tIntzh (tArrow tIntzh (tUtuple [tIntzh, tIntzh]))),
 220  ("zgzh", tcompare tIntzh),
 221  ("zgzezh", tcompare tIntzh),
 222  ("zezezh", tcompare tIntzh),
 223  ("zszezh", tcompare tIntzh),
 224  ("zlzh", tcompare tIntzh),
 225  ("zlzezh", tcompare tIntzh),
 226  ("chrzh", tArrow tIntzh tCharzh),
 227  ("int2Wordzh", tArrow tIntzh tWordzh),
 228  ("int2Floatzh", tArrow tIntzh tFloatzh),
 229  ("int2Doublezh", tArrow tIntzh tDoublezh),
 230  ("intToInt32zh", tArrow tIntzh tInt32zh),
 231  ("int2Integerzh", tArrow tIntzh tIntegerzhRes),
 232  ("iShiftLzh", tdyadic tIntzh),
 233  ("iShiftRAzh", tdyadic tIntzh),
 234  ("iShiftRLh", tdyadic tIntzh)]
 235
 236
 237 {- Int32zh -}
 238
 239 tcInt32zh = (primMname,"Int32zh")
 240 tInt32zh = Tcon tcInt32zh
 241 ktInt32zh = Kunlifted
 242
 243 opsInt32zh = [
 244  ("int32ToIntzh", tArrow tInt32zh tIntzh),
 245  ("int32ToIntegerzh", tArrow tInt32zh tIntegerzhRes)]
 246
 247
 248 {- Int64zh -}
 249
 250 tcInt64zh = (primMname,"Int64zh")
 251 tInt64zh = Tcon tcInt64zh
 252 ktInt64zh = Kunlifted
 253
 254 opsInt64zh = [
 255  ("int64ToIntegerzh", tArrow tInt64zh tIntegerzhRes)]
 256
 257 {- Integerzh -}
 258
 259 -- not actuallly a primitive type
 260 tIntegerzhRes = tUtuple [tIntzh, tByteArrayzh]
 261 tIntegerzhTo t = tArrow tIntzh (tArrow tByteArrayzh t)
 262 tdyadicIntegerzh = tIntegerzhTo (tIntegerzhTo tIntegerzhRes)
 263
 264 opsIntegerzh = [
 265  ("plusIntegerzh", tdyadicIntegerzh),
 266  ("minusIntegerzh", tdyadicIntegerzh),
 267  ("timesIntegerzh", tdyadicIntegerzh),
 268  ("gcdIntegerzh", tdyadicIntegerzh),
 269  ("gcdIntegerIntzh", tIntegerzhTo (tArrow tIntzh tIntzh)),
 270  ("divExactIntegerzh", tdyadicIntegerzh),
 271  ("quotIntegerzh", tdyadicIntegerzh),
 272  ("remIntegerzh", tdyadicIntegerzh),
 273  ("cmpIntegerzh", tIntegerzhTo (tIntegerzhTo tIntzh)),
 274  ("cmpIntegerIntzh", tIntegerzhTo (tArrow tIntzh tIntzh)),
 275  ("quotRemIntegerzh", tIntegerzhTo (tIntegerzhTo (tUtuple [tIntzh,tByteArrayzh,tIntzh,tByteArrayzh]))),
 276  ("divModIntegerzh", tIntegerzhTo (tIntegerzhTo (tUtuple [tIntzh,tByteArrayzh,tIntzh,tByteArrayzh]))),
 277  ("integer2Intzh", tIntegerzhTo tIntzh),
 278  ("integer2Wordzh", tIntegerzhTo tWordzh),
 279  ("integerToInt32zh", tIntegerzhTo tInt32zh),
 280  ("integerToWord32zh", tIntegerzhTo tWord32zh),
 281  ("integerToInt64zh", tIntegerzhTo tInt64zh),
 282  ("integerToWord64zh", tIntegerzhTo tWord64zh),
 283  ("andIntegerzh", tdyadicIntegerzh),
 284  ("orIntegerzh", tdyadicIntegerzh),
 285  ("xorIntegerzh", tdyadicIntegerzh),
 286  ("complementIntegerzh", tIntegerzhTo tIntegerzhRes)]
 287
 288
 289
 290 {- Wordzh -}
 291
 292 tcWordzh = (primMname,"Wordzh")
 293 tWordzh = Tcon tcWordzh
 294 ktWordzh = Kunlifted
 295
 296 opsWordzh = [
 297  ("plusWordzh", tdyadic tWordzh),
 298  ("minusWordzh", tdyadic tWordzh),
 299  ("timesWordzh", tdyadic tWordzh),
 300  ("quotWordzh",   tdyadic tWordzh),
 301  ("remWordzh",   tdyadic tWordzh),
 302  ("andzh",    tdyadic tWordzh),
 303  ("orzh",    tdyadic tWordzh),
 304  ("xorzh",    tdyadic tWordzh),
 305  ("notzh",    tmonadic tWordzh),
 306  ("shiftLzh", tArrow tWordzh (tArrow tIntzh tWordzh)),
 307  ("shiftRLzh", tArrow tWordzh (tArrow tIntzh tWordzh)),
 308  ("word2Intzh", tArrow tWordzh tIntzh),
 309  ("wordToWord32zh", tArrow tWordzh tWord32zh),
 310  ("word2Integerzh", tArrow tWordzh tIntegerzhRes),
 311  ("gtWordzh", tcompare tWordzh),
 312  ("geWordzh", tcompare tWordzh),
 313  ("eqWordzh", tcompare tWordzh),
 314  ("neWordzh", tcompare tWordzh),
 315  ("ltWordzh", tcompare tWordzh),
 316  ("leWordzh", tcompare tWordzh)]
 317
 318 {- Word32zh -}
 319
 320 tcWord32zh = (primMname,"Word32zh")
 321 tWord32zh = Tcon tcWord32zh
 322 ktWord32zh = Kunlifted
 323
 324 opsWord32zh = [
 325  ("word32ToWordzh", tArrow tWord32zh tWordzh),
 326  ("word32ToIntegerzh", tArrow tWord32zh tIntegerzhRes)]
 327
 328 {- Word64zh -}
 329
 330 tcWord64zh = (primMname,"Word64zh")
 331 tWord64zh = Tcon tcWord64zh
 332 ktWord64zh = Kunlifted
 333
 334 opsWord64zh = [
 335  ("word64ToIntegerzh", tArrow tWord64zh tIntegerzhRes)]
 336
 337 {- Explicitly sized Intzh and Wordzh -}
 338
 339 opsSized = [
 340  ("narrow8Intzh", tmonadic tIntzh),
 341  ("narrow16Intzh", tmonadic tIntzh),
 342  ("narrow32Intzh", tmonadic tIntzh),
 343  ("narrow8Wordzh", tmonadic tWordzh),
 344  ("narrow16Wordzh", tmonadic tWordzh),
 345  ("narrow32Wordzh", tmonadic tWordzh)]
 346
 347 {- Arrays -}
 348
 349 tcArrayzh = (primMname,"Arrayzh")
 350 tArrayzh t = Tapp (Tcon tcArrayzh) t
 351 ktArrayzh = Karrow Klifted Kunlifted
 352
 353 tcByteArrayzh = (primMname,"ByteArrayzh")
 354 tByteArrayzh = Tcon tcByteArrayzh
 355 ktByteArrayzh = Kunlifted
 356
 357 tcMutableArrayzh = (primMname,"MutableArrayzh")
 358 tMutableArrayzh s t = Tapp (Tapp (Tcon tcMutableArrayzh) s) t
 359 ktMutableArrayzh = Karrow Klifted (Karrow Klifted Kunlifted)
 360
 361 tcMutableByteArrayzh = (primMname,"MutableByteArrayzh")
 362 tMutableByteArrayzh s = Tapp (Tcon tcMutableByteArrayzh) s
 363 ktMutableByteArrayzh = Karrow Klifted Kunlifted
 364
 365 opsArray = [
 366  ("newArrayzh", Tforall ("a",Klifted)
 367                        (Tforall ("s",Klifted)
 368                                 (tArrow tIntzh
 369                                        (tArrow (Tvar "a")
 370                                                (tArrow (tStatezh (Tvar "s"))
 371                                                        (tUtuple [tStatezh (Tvar "s"),tMutableArrayzh (Tvar "s") (Tvar "a")])))))),
 372  ("newByteArrayzh", Tforall ("s",Klifted)
 373                            (tArrow tIntzh
 374                                    (tArrow (tStatezh (Tvar "s"))
 375                                            (tUtuple [tStatezh (Tvar "s"),tMutableByteArrayzh (Tvar "s")])))),
 376  ("newPinnedByteArrayzh", Tforall ("s",Klifted)
 377                            (tArrow tIntzh
 378                                    (tArrow (tStatezh (Tvar "s"))
 379                                            (tUtuple [tStatezh (Tvar "s"),tMutableByteArrayzh (Tvar "s")])))),
 380  ("byteArrayContentszh", tArrow tByteArrayzh tAddrzh),
 381  ("indexCharArrayzh", tArrow tByteArrayzh (tArrow tIntzh tCharzh)),
 382  ("indexWideCharArrayzh", tArrow tByteArrayzh (tArrow tIntzh tCharzh)),
 383  ("indexIntArrayzh", tArrow tByteArrayzh (tArrow tIntzh tIntzh)),
 384  ("indexWordArrayzh", tArrow tByteArrayzh (tArrow tIntzh tWordzh)),
 385  ("indexAddrArrayzh", tArrow tByteArrayzh (tArrow tIntzh tAddrzh)),
 386  ("indexFloatArrayzh", tArrow tByteArrayzh (tArrow tIntzh tFloatzh)),
 387  ("indexDoubleArrayzh", tArrow tByteArrayzh (tArrow tIntzh tDoublezh)),
 388  ("indexStablePtrArrayzh", Tforall ("a",Klifted) (tArrow tByteArrayzh (tArrow tIntzh (tStablePtrzh (Tvar "a"))))),
 389  ("indexInt8Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tIntzh)),
 390  ("indexInt16Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tIntzh)),
 391  ("indexInt32Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tInt32zh)),
 392  ("indexInt64Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tInt64zh)),
 393  ("indexWord8Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tWordzh)),
 394  ("indexWord16Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tWordzh)),
 395  ("indexWord32Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tWord32zh)),
 396  ("indexWord64Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tWord64zh)),
 397  ("readCharArrayzh", tReadMutableByteArrayzh tCharzh),
 398  ("readWideCharArrayzh", tReadMutableByteArrayzh tCharzh),
 399  ("readIntArrayzh", tReadMutableByteArrayzh tIntzh),
 400  ("readWordArrayzh", tReadMutableByteArrayzh tWordzh),
 401  ("readAddrArrayzh", tReadMutableByteArrayzh tAddrzh),
 402  ("readFloatArrayzh", tReadMutableByteArrayzh tFloatzh),
 403  ("readDoubleArrayzh", tReadMutableByteArrayzh tDoublezh),
 404  ("readStablePtrArrayzh", Tforall ("s",Klifted)
 405                                  (Tforall ("a",Klifted)
 406                                           (tArrow (tMutableByteArrayzh (Tvar "s"))
 407                                                   (tArrow tIntzh
 408                                                          (tArrow (tStatezh (Tvar "s"))
 409                                                                  (tUtuple [tStatezh (Tvar "s"),tStablePtrzh (Tvar "a")])))))),
 410  ("readInt8Arrayzh", tReadMutableByteArrayzh tIntzh),
 411  ("readInt16Arrayzh", tReadMutableByteArrayzh tIntzh),
 412  ("readInt32Arrayzh", tReadMutableByteArrayzh tInt32zh),
 413  ("readInt64Arrayzh", tReadMutableByteArrayzh tInt64zh),
 414  ("readWord8Arrayzh", tReadMutableByteArrayzh tWordzh),
 415  ("readWord16Arrayzh", tReadMutableByteArrayzh tWordzh),
 416  ("readWord32Arrayzh", tReadMutableByteArrayzh tWord32zh),
 417  ("readWord64Arrayzh", tReadMutableByteArrayzh tWord64zh),
 418
 419  ("writeCharArrayzh", tWriteMutableByteArrayzh tCharzh),
 420  ("writeWideCharArrayzh", tWriteMutableByteArrayzh tCharzh),
 421  ("writeIntArrayzh", tWriteMutableByteArrayzh tIntzh),
 422  ("writeWordArrayzh", tWriteMutableByteArrayzh tWordzh),
 423  ("writeAddrArrayzh", tWriteMutableByteArrayzh tAddrzh),
 424  ("writeFloatArrayzh", tWriteMutableByteArrayzh tFloatzh),
 425  ("writeDoubleArrayzh", tWriteMutableByteArrayzh tDoublezh),
 426  ("writeStablePtrArrayzh", Tforall ("s",Klifted)
 427                                   (Tforall ("a",Klifted)
 428                                            (tArrow (tMutableByteArrayzh (Tvar "s"))
 429                                                    (tArrow tIntzh
 430                                                           (tArrow (tStablePtrzh (Tvar "a"))
 431                                                                   (tArrow (tStatezh (Tvar "s"))
 432                                                                           (tStatezh (Tvar "s")))))))),
 433  ("writeInt8Arrayzh", tWriteMutableByteArrayzh tIntzh),
 434  ("writeInt16Arrayzh", tWriteMutableByteArrayzh tIntzh),
 435  ("writeInt32Arrayzh", tWriteMutableByteArrayzh tIntzh),
 436  ("writeInt64Arrayzh", tWriteMutableByteArrayzh tInt64zh),
 437  ("writeWord8Arrayzh", tWriteMutableByteArrayzh tWordzh),
 438  ("writeWord16Arrayzh", tWriteMutableByteArrayzh tWordzh),
 439  ("writeWord32Arrayzh", tWriteMutableByteArrayzh tWord32zh),
 440  ("writeWord64Arrayzh", tWriteMutableByteArrayzh tWord64zh),
 441
 442  ("indexCharOffAddrzh", tArrow tAddrzh (tArrow tIntzh tCharzh)),
 443  ("indexWideCharOffAddrzh", tArrow tAddrzh (tArrow tIntzh tCharzh)),
 444  ("indexIntOffAddrzh", tArrow tAddrzh (tArrow tIntzh tIntzh)),
 445  ("indexWordOffAddrzh", tArrow tAddrzh (tArrow tIntzh tWordzh)),
 446  ("indexAddrOffAddrzh", tArrow tAddrzh (tArrow tIntzh tAddrzh)),
 447  ("indexFloatOffAddrzh", tArrow tAddrzh (tArrow tIntzh tFloatzh)),
 448  ("indexDoubleOffAddrzh", tArrow tAddrzh (tArrow tIntzh tDoublezh)),
 449  ("indexStablePtrOffAddrzh", Tforall ("a",Klifted) (tArrow tAddrzh (tArrow tIntzh (tStablePtrzh (Tvar "a"))))),
 450  ("indexInt8OffAddrzh", tArrow tAddrzh (tArrow tIntzh tIntzh)),
 451  ("indexInt16OffAddrzh", tArrow tAddrzh (tArrow tIntzh tIntzh)),
 452  ("indexInt32OffAddrzh", tArrow tAddrzh (tArrow tIntzh tInt32zh)),
 453  ("indexInt64OffAddrzh", tArrow tAddrzh (tArrow tIntzh tInt64zh)),
 454  ("indexWord8OffAddrzh", tArrow tAddrzh (tArrow tIntzh tWordzh)),
 455  ("indexWord16OffAddrzh", tArrow tAddrzh (tArrow tIntzh tWordzh)),
 456  ("indexWord32ffAddrzh", tArrow tAddrzh (tArrow tIntzh tWord32zh)),
 457  ("indexWord64OffAddrzh", tArrow tAddrzh (tArrow tIntzh tWord64zh)),
 458
 459  ("indexCharOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tCharzh)),
 460  ("indexWideCharOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tCharzh)),
 461  ("indexIntOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tIntzh)),
 462  ("indexWordOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWordzh)),
 463  ("indexAddrOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tAddrzh)),
 464  ("indexFloatOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tFloatzh)),
 465  ("indexDoubleOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tDoublezh)),
 466  ("indexStablePtrOffForeignObjzh", Tforall ("a",Klifted) (tArrow tForeignObjzh (tArrow tIntzh (tStablePtrzh (Tvar "a"))))),
 467  ("indexInt8OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tIntzh)),
 468  ("indexInt16OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tIntzh)),
 469  ("indexInt32OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tInt32zh)),
 470  ("indexInt64OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tInt64zh)),
 471  ("indexWord8OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWordzh)),
 472  ("indexWord16OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWordzh)),
 473  ("indexWord32ffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWord32zh)),
 474  ("indexWord64OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWord64zh)),
 475
 476  ("readCharOffAddrzh", tReadOffAddrzh tCharzh),
 477  ("readWideCharOffAddrzh", tReadOffAddrzh tCharzh),
 478  ("readIntOffAddrzh", tReadOffAddrzh tIntzh),
 479  ("readWordOffAddrzh", tReadOffAddrzh tWordzh),
 480  ("readAddrOffAddrzh", tReadOffAddrzh tAddrzh),
 481  ("readFloatOffAddrzh", tReadOffAddrzh tFloatzh),
 482  ("readDoubleOffAddrzh", tReadOffAddrzh tDoublezh),
 483  ("readStablePtrOffAddrzh", Tforall ("s",Klifted)
 484                                 (Tforall ("a",Klifted)
 485                                      (tArrow tAddrzh
 486                                              (tArrow tIntzh
 487                                                     (tArrow (tStatezh (Tvar "s"))
 488                                                             (tUtuple [tStatezh (Tvar "s"),tStablePtrzh (Tvar "a")])))))),
 489  ("readInt8OffAddrzh", tReadOffAddrzh tIntzh),
 490  ("readInt16OffAddrzh", tReadOffAddrzh tIntzh),
 491  ("readInt32OffAddrzh", tReadOffAddrzh tInt32zh),
 492  ("readInt64OffAddrzh", tReadOffAddrzh tInt64zh),
 493  ("readWord8OffAddrzh", tReadOffAddrzh tWordzh),
 494  ("readWord16OffAddrzh", tReadOffAddrzh tWordzh),
 495  ("readWord32OffAddrzh", tReadOffAddrzh tWord32zh),
 496  ("readWord64OffAddrzh", tReadOffAddrzh tWord64zh),
 497
 498  ("writeCharOffAddrzh", tWriteOffAddrzh tCharzh),
 499  ("writeWideCharOffAddrzh", tWriteOffAddrzh tCharzh),
 500  ("writeIntOffAddrzh", tWriteOffAddrzh tIntzh),
 501  ("writeWordOffAddrzh", tWriteOffAddrzh tWordzh),
 502  ("writeAddrOffAddrzh", tWriteOffAddrzh tAddrzh),
 503  ("writeFloatOffAddrzh", tWriteOffAddrzh tFloatzh),
 504  ("writeDoubleOffAddrzh", tWriteOffAddrzh tDoublezh),
 505  ("writeStablePtrOffAddrzh", Tforall ("a",Klifted) (tWriteOffAddrzh (tStablePtrzh (Tvar "a")))),
 506  ("writeInt8OffAddrzh", tWriteOffAddrzh tIntzh),
 507  ("writeInt16OffAddrzh", tWriteOffAddrzh tIntzh),
 508  ("writeInt32OffAddrzh", tWriteOffAddrzh tInt32zh),
 509  ("writeInt64OffAddrzh", tWriteOffAddrzh tInt64zh),
 510  ("writeWord8OffAddrzh", tWriteOffAddrzh tWordzh),
 511  ("writeWord16OffAddrzh", tWriteOffAddrzh tWordzh),
 512  ("writeWord32OffAddrzh", tWriteOffAddrzh tWord32zh),
 513  ("writeWord64OffAddrzh", tWriteOffAddrzh tWord64zh),
 514
 515  ("sameMutableArrayzh", Tforall ("s",Klifted)
 516                                (Tforall ("a",Klifted)
 517                                         (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a"))
 518                                                 (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a"))
 519                                                         tBool)))),
 520  ("sameMutableByteArrayzh", Tforall ("s",Klifted)
 521                                    (tArrow (tMutableByteArrayzh (Tvar "s"))
 522                                            (tArrow (tMutableByteArrayzh (Tvar "s"))
 523                                                    tBool))),
 524  ("readArrayzh",Tforall ("s",Klifted)
 525                         (Tforall ("a",Klifted)
 526                                  (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a"))
 527                                          (tArrow tIntzh
 528                                                  (tArrow (tStatezh (Tvar "s"))
 529                                                          (tUtuple[tStatezh (Tvar "s"), Tvar "a"])))))),
 530  ("writeArrayzh",Tforall ("s",Klifted)
 531                          (Tforall ("a",Klifted)
 532                                   (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a"))
 533                                           (tArrow tIntzh
 534                                                   (tArrow (Tvar "a")
 535                                                           (tArrow (tStatezh (Tvar "s"))
 536                                                                   (tStatezh (Tvar "s")))))))),
 537  ("indexArrayzh", Tforall ("a",Klifted)
 538                           (tArrow (tArrayzh (Tvar "a"))
 539                                   (tArrow tIntzh
 540                                           (tUtuple[Tvar "a"])))),
 541  ("unsafeFreezzeArrayzh",Tforall ("s",Klifted)
 542                                 (Tforall ("a",Klifted)
 543                                          (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a"))
 544                                                  (tArrow (tStatezh (Tvar "s"))
 545                                                          (tUtuple[tStatezh (Tvar "s"),tArrayzh (Tvar "a")]))))),
 546  ("unsafeFreezzeByteArrayzh",Tforall ("s",Klifted)
 547                                     (tArrow (tMutableByteArrayzh (Tvar "s"))
 548                                             (tArrow (tStatezh (Tvar "s"))
 549                                                     (tUtuple[tStatezh (Tvar "s"),tByteArrayzh])))),
 550  ("unsafeThawArrayzh",Tforall ("a",Klifted)
 551                              (Tforall ("s",Klifted)
 552                                       (tArrow (tArrayzh (Tvar "a"))
 553                                               (tArrow (tStatezh (Tvar "s"))
 554                                                       (tUtuple[tStatezh (Tvar "s"),tMutableArrayzh (Tvar "s") (Tvar "a")]))))),
 555  ("sizzeofByteArrayzh", tArrow tByteArrayzh tIntzh),
 556  ("sizzeofMutableByteArrayzh", Tforall ("s",Klifted) (tArrow (tMutableByteArrayzh (Tvar "s")) tIntzh))]
 557  where
 558  tReadMutableByteArrayzh t =
 559      Tforall ("s",Klifted)
 560              (tArrow (tMutableByteArrayzh (Tvar "s"))
 561                      (tArrow tIntzh
 562                             (tArrow (tStatezh (Tvar "s"))
 563                                     (tUtuple [tStatezh (Tvar "s"),t]))))
 564
 565  tWriteMutableByteArrayzh t =
 566      Tforall ("s",Klifted)
 567              (tArrow (tMutableByteArrayzh (Tvar "s"))
 568                      (tArrow tIntzh
 569                             (tArrow t
 570                                     (tArrow (tStatezh (Tvar "s"))
 571                                             (tStatezh (Tvar "s"))))))
 572
 573  tReadOffAddrzh t =
 574      Tforall ("s",Klifted)
 575              (tArrow tAddrzh
 576                      (tArrow tIntzh
 577                             (tArrow (tStatezh (Tvar "s"))
 578                                     (tUtuple [tStatezh (Tvar "s"),t]))))
 579
 580
 581  tWriteOffAddrzh t =
 582      Tforall ("s",Klifted)
 583              (tArrow tAddrzh
 584                      (tArrow tIntzh
 585                             (tArrow t
 586                                     (tArrow (tStatezh (Tvar "s"))
 587                                             (tStatezh (Tvar "s"))))))
 588
 589 {- MutVars -}
 590
 591 tcMutVarzh = (primMname,"MutVarzh")
 592 tMutVarzh s t = Tapp (Tapp (Tcon tcMutVarzh) s) t
 593 ktMutVarzh = Karrow Klifted (Karrow Klifted Kunlifted)
 594
 595 opsMutVarzh = [
 596  ("newMutVarzh", Tforall ("a",Klifted)
 597                     (Tforall ("s",Klifted)
 598                         (tArrow (Tvar "a") (tArrow (tStatezh (Tvar "s"))
 599                                                    (tUtuple [tStatezh (Tvar "s"),
 600                                                              tMutVarzh (Tvar "s") (Tvar "a")]))))),
 601  ("readMutVarzh", Tforall ("s",Klifted)
 602                     (Tforall ("a",Klifted)
 603                         (tArrow (tMutVarzh (Tvar "s")(Tvar "a"))
 604                                 (tArrow (tStatezh (Tvar "s"))
 605                                         (tUtuple [tStatezh (Tvar "s"), Tvar "a"]))))),
 606  ("writeMutVarzh", Tforall ("s",Klifted)
 607                     (Tforall ("a",Klifted)
 608                         (tArrow (tMutVarzh (Tvar "s") (Tvar "a"))
 609                                 (tArrow (Tvar "a")
 610                                         (tArrow (tStatezh (Tvar "s"))
 611                                                 (tStatezh (Tvar "s"))))))),
 612  ("sameMutVarzh", Tforall ("s",Klifted)
 613                     (Tforall ("a",Klifted)
 614                         (tArrow (tMutVarzh (Tvar "s") (Tvar "a"))
 615                                 (tArrow (tMutVarzh (Tvar "s") (Tvar "a"))
 616                                         tBool))))]
 617
 618 {- Real world and state. -}
 619
 620 tcRealWorld = (primMname,"RealWorld")
 621 tRealWorld = Tcon tcRealWorld
 622 ktRealWorld = Klifted
 623
 624 tcStatezh = (primMname, "Statezh")
 625 tStatezh t = Tapp (Tcon tcStatezh) t
 626 ktStatezh = Karrow Klifted Kunlifted
 627
 628 tRWS = tStatezh tRealWorld
 629
 630 opsState = [
 631   ("realWorldzh", tRWS)]
 632
 633 {- Exceptions -}
 634
 635 -- no primitive type
 636 opsExn = [
 637  ("catchzh",
 638         let t' = tArrow tRWS (tUtuple [tRWS, Tvar "a"]) in
 639         Tforall ("a",Klifted)
 640                 (Tforall ("b",Klifted)
 641                          (tArrow t'
 642                                  (tArrow (tArrow (Tvar "b") t')
 643                                          t')))),
 644   ("raisezh", Tforall ("a",Klifted)
 645                       (Tforall ("b",Klifted)
 646                                (tArrow (Tvar "a") (Tvar "b")))),
 647   ("blockAsyncExceptionszh", Tforall ("a",Klifted)
 648                                     (tArrow (tArrow tRWS (tUtuple[tRWS,Tvar "a"]))
 649                                             (tArrow tRWS (tUtuple[tRWS,Tvar "a"])))),
 650   ("unblockAsyncExceptionszh", Tforall ("a",Klifted)
 651                                     (tArrow (tArrow tRWS (tUtuple[tRWS,Tvar "a"]))
 652                                             (tArrow tRWS (tUtuple[tRWS,Tvar "a"]))))]
 653
 654 {- Mvars -}
 655
 656 tcMVarzh = (primMname, "MVarzh")
 657 tMVarzh s t = Tapp (Tapp (Tcon tcMVarzh) s) t
 658 ktMVarzh = Karrow Klifted (Karrow Klifted Kunlifted)
 659
 660 opsMVar = [
 661  ("newMVarzh", Tforall ("s",Klifted)
 662                       (Tforall ("a",Klifted)
 663                                (tArrow (tStatezh (Tvar "s"))
 664                                        (tUtuple[tStatezh (Tvar "s"),tMVarzh (Tvar "s") (Tvar "a")])))),
 665  ("takeMVarzh", Tforall ("s",Klifted)
 666                       (Tforall ("a",Klifted)
 667                                (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
 668                                        (tArrow (tStatezh (Tvar "s"))
 669                                                (tUtuple[tStatezh (Tvar "s"),Tvar "a"]))))),
 670  ("tryTakeMVarzh", Tforall ("s",Klifted)
 671                       (Tforall ("a",Klifted)
 672                                (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
 673                                        (tArrow (tStatezh (Tvar "s"))
 674                                                (tUtuple[tStatezh (Tvar "s"),tIntzh,Tvar "a"]))))),
 675  ("putMVarzh", Tforall ("s",Klifted)
 676                       (Tforall ("a",Klifted)
 677                                (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
 678                                        (tArrow (Tvar "a")
 679                                                (tArrow (tStatezh (Tvar "s"))
 680                                                        (tStatezh (Tvar "s"))))))),
 681  ("tryPutMVarzh", Tforall ("s",Klifted)
 682                       (Tforall ("a",Klifted)
 683                                (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
 684                                        (tArrow (Tvar "a")
 685                                                (tArrow (tStatezh (Tvar "s"))
 686                                                        (tUtuple [tStatezh (Tvar "s"), tIntzh])))))),
 687  ("sameMVarzh", Tforall ("s",Klifted)
 688                       (Tforall ("a",Klifted)
 689                                (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
 690                                        (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
 691                                                tBool)))),
 692  ("isEmptyMVarzh", Tforall ("s",Klifted)
 693                       (Tforall ("a",Klifted)
 694                                (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
 695                                        (tArrow (tStatezh (Tvar "s"))
 696                                                (tUtuple[tStatezh (Tvar "s"),tIntzh])))))]
 697
 698
 699 {- Weak Objects -}
 700
 701 tcWeakzh = (primMname, "Weakzh")
 702 tWeakzh t = Tapp (Tcon tcWeakzh) t
 703 ktWeakzh = Karrow Klifted Kunlifted
 704
 705 opsWeak = [
 706   ("mkWeakzh", Tforall ("o",Kopen)
 707                       (Tforall ("b",Klifted)
 708                                (Tforall ("c",Klifted)
 709                                         (tArrow (Tvar "o")
 710                                                 (tArrow (Tvar "b")
 711                                                         (tArrow (Tvar "c")
 712                                                                 (tArrow tRWS (tUtuple[tRWS, tWeakzh (Tvar "b")])))))))),
 713   ("deRefWeakzh", Tforall ("a",Klifted)
 714                          (tArrow (tWeakzh (Tvar "a"))
 715                                  (tArrow tRWS (tUtuple[tRWS, tIntzh, Tvar "a"])))),
 716   ("finalizeWeakzh", Tforall ("a",Klifted)
 717                             (tArrow (tWeakzh (Tvar "a"))
 718                                     (tArrow tRWS
 719                                             (tUtuple[tRWS,tIntzh,
 720                                                      tArrow tRWS (tUtuple[tRWS, tUnit])]))))]
 721
 722
 723 {- Foreign Objects -}
 724
 725 tcForeignObjzh = (primMname, "ForeignObjzh")
 726 tForeignObjzh = Tcon tcForeignObjzh
 727 ktForeignObjzh = Kunlifted
 728
 729 opsForeignObjzh = [
 730  ("mkForeignObjzh", tArrow tAddrzh
 731                            (tArrow tRWS (tUtuple [tRWS,tForeignObjzh]))),
 732  ("writeForeignObjzh", Tforall ("s",Klifted)
 733                                (tArrow tForeignObjzh
 734                                        (tArrow tAddrzh
 735                                                (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s")))))),
 736  ("foreignObjToAddrzh", tArrow tForeignObjzh tAddrzh),
 737  ("touchzh", Tforall ("o",Kopen)
 738                      (tArrow (Tvar "o")
 739                              (tArrow tRWS tRWS)))]
 740
 741
 742 {- Stable Pointers (but not names) -}
 743
 744 tcStablePtrzh = (primMname, "StablePtrzh")
 745 tStablePtrzh t = Tapp (Tcon tcStablePtrzh) t
 746 ktStablePtrzh = Karrow Klifted Kunlifted
 747
 748 opsStablePtrzh = [
 749   ("makeStablePtrzh", Tforall ("a",Klifted)
 750                              (tArrow (Tvar "a")
 751                                      (tArrow tRWS (tUtuple[tRWS,tStablePtrzh (Tvar "a")])))),
 752   ("deRefStablePtrzh", Tforall ("a",Klifted)
 753                               (tArrow (tStablePtrzh (Tvar "a"))
 754                                       (tArrow tRWS (tUtuple[tRWS,Tvar "a"])))),
 755   ("eqStablePtrzh", Tforall ("a",Klifted)
 756                            (tArrow (tStablePtrzh (Tvar "a"))
 757                                    (tArrow (tStablePtrzh (Tvar "a")) tIntzh)))]
 758
 759 {- Concurrency  operations -}
 760
 761 tcThreadIdzh = (primMname,"ThreadIdzh")
 762 tThreadIdzh = Tcon tcThreadIdzh
 763 ktThreadIdzh = Kunlifted
 764
 765 opsConc = [
 766   ("seqzh", Tforall ("a",Klifted)
 767                     (tArrow (Tvar "a") tIntzh)),
 768   ("parzh", Tforall ("a",Klifted)
 769                     (tArrow (Tvar "a") tIntzh)),
 770   ("delayzh", Tforall ("s",Klifted)
 771                      (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s"))))),
 772   ("waitReadzh", Tforall ("s",Klifted)
 773                      (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s"))))),
 774   ("waitWritezh", Tforall ("s",Klifted)
 775                      (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s"))))),
 776   ("forkzh", Tforall ("a",Klifted)
 777                     (tArrow (Tvar "a")
 778                             (tArrow tRWS (tUtuple[tRWS,tThreadIdzh])))),
 779   ("killThreadzh", Tforall ("a",Klifted)
 780                           (tArrow tThreadIdzh
 781                                   (tArrow (Tvar "a")
 782                                           (tArrow tRWS tRWS)))),
 783   ("yieldzh", tArrow tRWS tRWS),
 784   ("myThreadIdzh", tArrow tRWS (tUtuple[tRWS, tThreadIdzh]))]
 785
 786 {- Miscellaneous operations -}
 787
 788 opsMisc =  [
 789   ("dataToTagzh", Tforall ("a",Klifted)
 790                           (tArrow (Tvar "a") tIntzh)),
 791   ("tagToEnumzh", Tforall ("a",Klifted)
 792                           (tArrow tIntzh (Tvar "a"))),
 793   ("unsafeCoercezh", Tforall ("a",Kopen)
 794                              (Tforall ("b",Kopen)
 795                                       (tArrow (Tvar "a") (Tvar "b")))) -- maybe unneeded
 796   ]
 797
 798 {- CCallable and CReturnable.
 799    We just define the type constructors for the dictionaries
 800    corresponding to these pseudo-classes. -}
 801
 802 tcZCTCCallable = (primMname,"ZCTCCallable")
 803 ktZCTCCallable = Karrow Kopen Klifted  -- ??
 804 tcZCTCReturnable = (primMname,"ZCTCReturnable")
 805 ktZCTCReturnable = Karrow Kopen Klifted  -- ??
 806
 807 {- Non-primitive, but mentioned in the types of primitives. -}
 808
 809 tcUnit = ("PrelBase","Unit")
 810 tUnit = Tcon tcUnit
 811 ktUnit = Klifted
 812 tcBool = ("PrelBase","Bool")
 813 tBool = Tcon tcBool
 814 ktBool = Klifted
 815
 816 {- Properly defined in PrelError, but needed in many modules before that. -}
 817 errorVals = [
 818  ("error", Tforall ("a",Kopen) (tArrow tString (Tvar "a"))),
 819  ("irrefutPatError", Tforall ("a",Kopen) (tArrow tString (Tvar "a"))),
 820  ("patError", Tforall ("a",Kopen) (tArrow tString (Tvar "a")))]
 821
 822 tcChar = ("PrelBase","Char")
 823 tChar = Tcon tcChar
 824 ktChar = Klifted
 825 tcList = ("PrelBase","ZMZN")
 826 tList t = Tapp (Tcon tcList) t
 827 ktList = Karrow Klifted Klifted
 828 tString = tList tChar
 829
 830 {- Utilities for building types -}
 831 tmonadic t = tArrow t t
 832 tdyadic t = tArrow t (tArrow t t)
 833 tcompare t = tArrow t (tArrow t tBool)
 834