ghc/compiler/prelude/PrelVals.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[PrelVals]{Prelude values the compiler ``knows about''}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module PrelVals where
  10
  11 import PrelFuns         -- help functions, types and things
  12 import BasicLit         ( mkMachInt, BasicLit(..), PrimKind )
  13 import TysPrim
  14 import TysWiredIn
  15 #ifdef DPH
  16 import TyPod            ( mkPodNTy ,mkPodTy )
  17 import TyProcs          ( mkProcessorTy )
  18 #endif {- Data Parallel Haskell -}
  19
  20 #ifndef DPH
  21 import AbsUniType
  22 import Id               ( mkTemplateLocals, mkTupleCon, getIdUniType,
  23                           mkSpecId
  24                         )
  25 #else
  26 import AbsUniType       ( mkSigmaTy, mkDictTy, mkTyVarTy , SigmaType(..),
  27                           applyTyCon, splitType, specialiseTy
  28                         )
  29 import Id               ( mkTemplateLocals, mkTupleCon, getIdUniType,
  30                           mkSpecId, mkProcessorCon
  31                         )
  32 #endif {- Data Parallel Haskell -}
  33 import IdInfo
  34
  35 import Maybes           ( Maybe(..) )
  36 import PlainCore        -- to make unfolding templates
  37 import Unique           -- *Key things
  38 import Util
  39 \end{code}
  40
  41 %************************************************************************
  42 %*                                                                      *
  43 \subsection[PrelVals-error-related]{@error@ and friends; @trace@}
  44 %*                                                                      *
  45 %************************************************************************
  46
  47 GHC randomly injects these into the code.
  48
  49 @patError#@ is just a version of @error@ for pattern-matching
  50 failures.  It knows various ``codes'' which expand to longer
  51 strings---this saves space!
  52
  53 @absent#@ is a thing we put in for ``absent'' arguments.  They jolly
  54 well shouldn't be yanked on, but if one is, then you will get a
  55 friendly message from @absent#@ (rather a totally random crash).
  56
  57 @parError#@ is a special version of @error@ which the compiler does
  58 not know to be a bottoming Id.  It is used in the @_par_@ and @_seq_@
  59 templates, but we don't ever expect to generate code for it.
  60
  61 \begin{code}
  62 pc_bottoming_Id key mod name ty
  63  = pcMiscPrelId key mod name ty bottoming_info
  64  where
  65     bottoming_info = noIdInfo `addInfo` mkBottomStrictnessInfo
  66         -- these "bottom" out, no matter what their arguments
  67
  68 eRROR_ID
  69   = pc_bottoming_Id errorIdKey pRELUDE_BUILTIN SLIT("error") errorTy
  70
  71 pAT_ERROR_ID
  72   = pc_bottoming_Id patErrorIdKey pRELUDE_BUILTIN SLIT("patError#") errorTy
  73
  74 aBSENT_ERROR_ID
  75   = pc_bottoming_Id absentErrorIdKey pRELUDE_BUILTIN SLIT("absent#")
  76         (mkSigmaTy [alpha_tv] [] alpha)
  77
  78 pAR_ERROR_ID
  79   = pcMiscPrelId parErrorIdKey pRELUDE_BUILTIN SLIT("parError#")
  80     (mkSigmaTy [alpha_tv] [] alpha) noIdInfo
  81
  82 errorTy  :: UniType
  83 errorTy  = mkSigmaTy [alpha_tv] [] (UniFun (mkListTy charTy) alpha)
  84 \end{code}
  85
  86 We want \tr{_trace} (NB: name not in user namespace) to be wired in
  87 because we don't want the strictness analyser to get ahold of it,
  88 decide that the second argument is strict, evaluate that first (!!),
  89 and make a jolly old mess.  Having \tr{_trace} wired in also helps when
  90 attempting to re-export it---because it's in \tr{PreludeBuiltin}, it
  91 won't get an \tr{import} declaration in the interface file, so the
  92 importing-subsequently module needs to know it's magic.
  93 \begin{code}
  94 tRACE_ID
  95   = pcMiscPrelId traceIdKey pRELUDE_BUILTIN SLIT("_trace") traceTy
  96         (noIdInfo `addInfo` pcGenerateSpecs traceIdKey tRACE_ID noIdInfo traceTy)
  97   where
  98     traceTy = mkSigmaTy [alpha_tv] [] (UniFun (mkListTy charTy) (UniFun alpha alpha))
  99 \end{code}
 100
 101 %************************************************************************
 102 %*                                                                      *
 103 \subsection[PrelVals-Integer-support]{To support @Integer@ and @String@ literals}
 104 %*                                                                      *
 105 %************************************************************************
 106
 107 \begin{code}
 108 {- OLD:
 109 int2IntegerId
 110   = pcMiscPrelId int2IntegerIdKey pRELUDE_BUILTIN SLIT("_int2Integer")
 111         (UniFun intTy integerTy)
 112         noIdInfo
 113 -}
 114
 115 --------------------------------------------------------------------
 116
 117 packStringForCId
 118   = pcMiscPrelId packCStringIdKey{-ToDo:rename-} pRELUDE_PS SLIT("_packStringForC")
 119         (UniFun stringTy byteArrayPrimTy) noIdInfo
 120
 121 --------------------------------------------------------------------
 122
 123 unpackCStringId
 124   = pcMiscPrelId unpackCStringIdKey pRELUDE_BUILTIN SLIT("unpackPS#")
 125                  (addrPrimTy{-a char *-} `UniFun` stringTy) noIdInfo
 126 -- Andy says:
 127 --      (UniFun addrPrimTy{-a char *-} stringTy) (noIdInfo `addInfo` mkArityInfo 1)
 128 -- but I don't like wired-in IdInfos (WDP)
 129
 130 unpackCString2Id -- for cases when a string has a NUL in it
 131   = pcMiscPrelId unpackCString2IdKey pRELUDE_BUILTIN SLIT("unpackPS2#")
 132                  (addrPrimTy{-a char *-}
 133         `UniFun` (intPrimTy -- length
 134         `UniFun` stringTy)) noIdInfo
 135
 136
 137 --------------------------------------------------------------------
 138 unpackCStringAppendId
 139   = pcMiscPrelId unpackCStringAppendIdKey pRELUDE_BUILTIN SLIT("unpackAppendPS#")
 140                                 (addrPrimTy{-a "char *" pointer-}
 141                 `UniFun`        (stringTy
 142                 `UniFun`        stringTy)) ((noIdInfo
 143                                 `addInfo_UF` mkMagicUnfolding SLIT("unpackAppendPS#"))
 144                                 `addInfo` mkArityInfo 2)
 145
 146 unpackCStringFoldrId
 147   = pcMiscPrelId unpackCStringFoldrIdKey pRELUDE_BUILTIN SLIT("unpackFoldrPS#")
 148                 (mkSigmaTy [alpha_tv] []
 149                            (addrPrimTy{-a "char *" pointer-}
 150                 `UniFun`   ((charTy `UniFun` (alpha `UniFun` alpha))
 151                 `UniFun`   (alpha
 152                 `UniFun`   alpha)))) ((noIdInfo
 153                                 `addInfo_UF` mkMagicUnfolding SLIT("unpackFoldrPS#"))
 154                                 `addInfo` mkArityInfo 3)
 155 \end{code}
 156
 157 OK, this is Will's idea: we should have magic values for Integers 0,
 158 +1, +2, and -1 (go ahead, fire me):
 159 \begin{code}
 160 integerZeroId
 161   = pcMiscPrelId integerZeroIdKey     pRELUDE_CORE SLIT("__integer0")  integerTy noIdInfo
 162 integerPlusOneId
 163   = pcMiscPrelId integerPlusOneIdKey  pRELUDE_CORE SLIT("__integer1")  integerTy noIdInfo
 164 integerPlusTwoId
 165   = pcMiscPrelId integerPlusTwoIdKey  pRELUDE_CORE SLIT("__integer2")  integerTy noIdInfo
 166 integerMinusOneId
 167   = pcMiscPrelId integerMinusOneIdKey pRELUDE_CORE SLIT("__integerm1") integerTy noIdInfo
 168 \end{code}
 169
 170 %************************************************************************
 171 %*                                                                      *
 172 \subsection[PrelVals-parallel]{@seq@ and @par@: for parallel operation (only)}
 173 %*                                                                      *
 174 %************************************************************************
 175
 176 In the definitions that follow, we use the @TyVar@-based
 177 alpha/beta/gamma types---not the usual @TyVarTemplate@ ones.
 178
 179 This is so the @TyVars@ in the @CoTyLams@ (@alpha_tyvar@, etc) match
 180 up with those in the types of the {\em lambda-bound} template-locals
 181 we create (using types @alpha_ty@, etc.).
 182
 183 \begin{code}
 184 --------------------------------------------------------------------
 185 -- seqId :: "_seq_", used w/ GRIP, etc., is really quite similar to
 186 -- dangerousEval
 187 {-
 188    OLDER:
 189    _seq_ = /\ a b -> \ x y -> case x of { _ -> y }
 190
 191    OLD:
 192    _seq_ = /\ a b -> \ x y -> case seq# x y of { _Lift y' -> y' }
 193
 194    NEW (95/05):
 195    _seq_ = /\ a b -> \ x::a y::b -> case seq# x of { 0# -> parError#; _ -> y; }
 196
 197 -}
 198
 199 seqId = pcMiscPrelId seqIdKey pRELUDE_BUILTIN SLIT("_seq_")
 200                   (mkSigmaTy [alpha_tv, beta_tv] []
 201                     (alpha `UniFun` (beta `UniFun` beta)))
 202                   (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding seq_template))
 203   where
 204     [x, y, z]
 205       = mkTemplateLocals [
 206         {-x-} alpha_ty,
 207         {-y-} beta_ty,
 208         {-z-} intPrimTy
 209         ]
 210
 211     seq_template
 212       = CoTyLam alpha_tyvar
 213           (CoTyLam beta_tyvar
 214              (mkCoLam [x, y] (
 215                 CoCase (CoPrim SeqOp [alpha_ty] [CoVarAtom x]) (
 216                   CoPrimAlts
 217                     [(mkMachInt 0, CoTyApp (CoVar pAR_ERROR_ID) beta_ty)]
 218                     (CoBindDefault z (CoVar y))))))
 219
 220 --------------------------------------------------------------------
 221 -- parId :: "_par_", also used w/ GRIP, etc.
 222 {-
 223     OLDER:
 224
 225     par = /\ a b -> \ x y -> case (par# (case x of { _ -> () })) of { _ -> y }
 226
 227     OLD:
 228
 229     _par_ = /\ a b -> \ x y -> case par# x y of { _Lift y' -> y' }
 230
 231     NEW (95/05):
 232
 233     _par_ = /\ a b -> \ x::a y::b -> case par# x of { 0# -> parError#; _ -> y; }
 234
 235 -}
 236 parId = pcMiscPrelId parIdKey pRELUDE_BUILTIN SLIT("_par_")
 237                   (mkSigmaTy [alpha_tv, beta_tv] []
 238                     (alpha `UniFun` (beta `UniFun` beta)))
 239                   (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding par_template))
 240   where
 241     [x, y, z]
 242       = mkTemplateLocals [
 243         {-x-} alpha_ty,
 244         {-y-} beta_ty,
 245         {-z-} intPrimTy
 246         ]
 247
 248     par_template
 249       = CoTyLam alpha_tyvar
 250           (CoTyLam beta_tyvar
 251              (mkCoLam [x, y] (
 252                 CoCase (CoPrim ParOp [alpha_ty] [CoVarAtom x]) (
 253                   CoPrimAlts
 254                     [(mkMachInt 0, CoTyApp (CoVar pAR_ERROR_ID) beta_ty)]
 255                     (CoBindDefault z (CoVar y))))))
 256
 257 -- forkId :: "_fork_", for *required* concurrent threads
 258 {-
 259    _fork_ = /\ a b -> \ x::a y::b -> case fork# x of { 0# -> parError#; _ -> y; }
 260 -}
 261 forkId = pcMiscPrelId forkIdKey pRELUDE_BUILTIN SLIT("_fork_")
 262                   (mkSigmaTy [alpha_tv, beta_tv] []
 263                     (alpha `UniFun` (beta `UniFun` beta)))
 264                   (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding fork_template))
 265   where
 266     [x, y, z]
 267       = mkTemplateLocals [
 268         {-x-} alpha_ty,
 269         {-y-} beta_ty,
 270         {-z-} intPrimTy
 271         ]
 272
 273     fork_template
 274       = CoTyLam alpha_tyvar
 275           (CoTyLam beta_tyvar
 276              (mkCoLam [x, y] (
 277                 CoCase (CoPrim ForkOp [alpha_ty] [CoVarAtom x]) (
 278                   CoPrimAlts
 279                     [(mkMachInt 0, CoTyApp (CoVar pAR_ERROR_ID) beta_ty)]
 280                     (CoBindDefault z (CoVar y))))))
 281
 282 \end{code}
 283
 284 \begin{code}
 285 #ifdef GRAN
 286
 287 parLocalId = pcMiscPrelId parLocalIdKey pRELUDE_BUILTIN SLIT("_parLocal_")
 288                   (mkSigmaTy [alpha_tv, beta_tv] []
 289                     (intPrimTy `UniFun` (alpha `UniFun` (beta `UniFun` beta))))
 290                   (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parLocal_template))
 291   where
 292     [w, x, y, z]
 293       = mkTemplateLocals [
 294         {-w-} intPrimTy,
 295         {-x-} alpha_ty,
 296         {-y-} beta_ty,
 297         {-z-} beta_ty
 298         ]
 299
 300     parLocal_template
 301       = CoTyLam alpha_tyvar
 302           (CoTyLam beta_tyvar
 303              (mkCoLam [w, x, y] (
 304                 CoCase (CoPrim ParLocalOp [alpha_ty, beta_ty] [CoVarAtom x, CoVarAtom w, CoVarAtom y]) (
 305                   CoAlgAlts
 306                     [(liftDataCon, [z], CoVar z)]
 307                     (CoNoDefault)))))
 308
 309 parGlobalId = pcMiscPrelId parGlobalIdKey pRELUDE_BUILTIN SLIT("_parGlobal_")
 310                   (mkSigmaTy [alpha_tv, beta_tv] []
 311                     (intPrimTy `UniFun` (alpha `UniFun` (beta `UniFun` beta))))
 312                   (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parGlobal_template))
 313   where
 314     [w, x, y, z]
 315       = mkTemplateLocals [
 316         {-w-} intPrimTy,
 317         {-x-} alpha_ty,
 318         {-y-} beta_ty,
 319         {-z-} beta_ty
 320         ]
 321
 322     parGlobal_template
 323       = CoTyLam alpha_tyvar
 324           (CoTyLam beta_tyvar
 325              (mkCoLam [w, x, y] (
 326                 CoCase (CoPrim ParGlobalOp [alpha_ty, beta_ty] [CoVarAtom x, CoVarAtom w, CoVarAtom y]) (
 327                   CoAlgAlts
 328                     [(liftDataCon, [z], CoVar z)]
 329                     (CoNoDefault)))))
 330
 331 #endif {-GRAN-}
 332 \end{code}
 333
 334 \begin{code}
 335 #ifdef DPH
 336 vectorMapId = pcChooseToKnowId vectorMapU pRELUDE "vectorMap"
 337               (mkSigmaTy [alpha_tv, beta_tv , gamma_tv]
 338                          [(pidClass,alpha)]
 339               ((beta `UniFun` gamma)                     `UniFun`
 340                  ((mkPodTy (mkProcessorTy [alpha] beta)) `UniFun`
 341                     (mkPodTy (mkProcessorTy [alpha] gamma)))))
 342               (panic "vectorMap:unfolding")--ToDo:DPH: (mkUnfoldTemplate vector_map_template)
 343               [(2,"","")]
 344  where
 345 {-
 346 vectorMap fn vec = << (|x;fn y|) | (|x;y|) <<- vec >>
 347
 348 Simplified :
 349 vectorMap :: for all a.83, b.82, c.86. <Pid a.83>
 350           -> (b.82 -> c.86)
 351           -> <<a.83;b.82>>
 352           -> <<a.83;c.86>>
 353 vectorMap =
 354     /\ t83 t82 o86 -> \ dict.127 ->
 355         let
 356           vecMap.128 =
 357               \ fn.129 vec.130 ->
 358                   << let si.133 = fn.129 ds.132 in
 359                      let
 360                        si.134 =
 361                            (fromDomain t82)
 362                                dict.127 ((toDomain t82) dict.127 ds.131)
 363                      in  MkProcessor1! Integer o86 si.134 si.133 |
 364                       (| ds.131 ; ds.132 |) <<- vec.130 >>
 365         in  vecMap.128
 366
 367  NOTE : no need to bother with overloading in class Pid; because the result
 368         PID (si.133) is wrapped in fromDomain.toDomain == id . Therefore we
 369         use the simplification below.
 370
 371 Simplified:
 372 vectorMap ::
 373     for all d.83, e.82, f.86.
 374         <Pid e.82> -> (d.83 -> f.86) -> <<e.82;d.83>> -> <<e.82;f.86>>
 375 vectorMap =
 376     /\ t83 t82 o86 -> \ dict.127 fn.129 vec.130 ->
 377     << MkProcessor1! Integer o86 ds.131 (fn.129 ds.132) |
 378                       (| ds.131 ; ds.132 |) <<- vec.130 >>
 379 -}
 380
 381     vector_map_template
 382       = let
 383            [dict,fn,vec,ds131,ds132]
 384              = mkTemplateLocals
 385                     [mkDictTy pidClass alpha_ty,
 386                      beta_ty `UniFun` gamma_ty,
 387                      mkPodTy (mkProcessorTy [alpha_ty] beta_ty),
 388                      integerTy,
 389                      beta_ty]
 390         in
 391           CoTyLam alpha_tyvar
 392             (CoTyLam beta_tyvar
 393               (CoTyLam gamma_tyvar
 394                 (mkCoLam [dict,fn,vec]
 395                   (CoZfExpr
 396                     (CoCon (mkProcessorCon 1)
 397                            [integerTy,mkTyVarTy gamma_tyvar]
 398                            [CoVar ds131,
 399                             (CoApp (CoVar fn) (CoVar ds132))])
 400                     (CoDrawnGen [ds131] ds132 (CoVar vec)) ))))
 401
 402 #endif {- Data Parallel Haskell -}
 403 \end{code}
 404
 405 \begin{code}
 406 #ifdef DPH
 407 -- A function used during podization that produces an index POD for a given
 408 -- POD as argument.
 409
 410 primIfromPodNSelectorId :: Int -> Int -> Id
 411 primIfromPodNSelectorId i n
 412    = pcMiscPrelId
 413         podSelectorIdKey
 414         pRELUDE_BUILTIN
 415         ("prim"++ show i ++ "fromPod" ++ show n ++ "Selector")
 416         (UniFun
 417            (mkPodNTy n alpha)
 418            (mkPodNTy n alpha))
 419         noIdInfo
 420 #endif {- Data Parallel Haskell -}
 421 \end{code}
 422
 423 %************************************************************************
 424 %*                                                                      *
 425 \subsection[PrelVals-deriving]{Values known about mainly for doing derived instance decls}
 426 %*                                                                      *
 427 %************************************************************************
 428
 429 map             :: (a -> b) -> [a] -> [b]
 430         -- this is up in the here-because-of-unfolding list
 431
 432 --??showChar    :: Char -> ShowS
 433 showSpace       :: ShowS        -- non-std: == "showChar ' '"
 434 showString      :: String -> ShowS
 435 showParen       :: Bool -> ShowS -> ShowS
 436
 437 (++)            :: [a] -> [a] -> [a]
 438 readParen       :: Bool -> ReadS a -> ReadS a
 439 lex             :: ReadS String
 440
 441 \begin{code}
 442 {- OLD:
 443 readS_ty :: UniType -> UniType
 444 readS_ty ty
 445   = UniFun stringTy (mkListTy (mkTupleTy 2 [ty, stringTy]))
 446
 447 showS_ty :: UniType
 448 showS_ty = UniFun stringTy stringTy
 449 -}
 450 \end{code}
 451
 452 \begin{code}
 453 {- OLD:
 454 showSpaceId = pcMiscPrelId showSpaceIdKey pRELUDE_TEXT SLIT("_showSpace")
 455                                 showS_ty
 456                                 noIdInfo
 457
 458 showParenId = pcMiscPrelId showParenIdKey pRELUDE_TEXT SLIT("showParen")
 459                                 (boolTy `UniFun` (showS_ty `UniFun` showS_ty))
 460                                 noIdInfo
 461
 462 readParenId = pcMiscPrelId readParenIdKey pRELUDE_TEXT SLIT("readParen")
 463                                 (mkSigmaTy [alpha_tv] [] (
 464                                  boolTy `UniFun` (
 465                                  (readS_ty alpha) `UniFun` (readS_ty alpha))))
 466                                 noIdInfo
 467
 468 lexId = pcMiscPrelId lexIdKey pRELUDE_TEXT SLIT("lex")
 469                                 (readS_ty (mkListTy charTy))
 470                                 noIdInfo
 471 -}
 472 \end{code}
 473
 474 %************************************************************************
 475 %*                                                                      *
 476 \subsection[PrelVals-void]{@void#@: Magic value of type @Void#@}
 477 %*                                                                      *
 478 %************************************************************************
 479
 480 I don't think this is available to the user; it's used in the
 481 simplifier (WDP 94/06).
 482 \begin{code}
 483 voidPrimId
 484   = pcMiscPrelId voidPrimIdKey pRELUDE_BUILTIN SLIT("void#")
 485         voidPrimTy noIdInfo
 486 \end{code}
 487
 488 %************************************************************************
 489 %*                                                                      *
 490 \subsection[PrelVals-runST]{@_runST@: Magic start-state-transformer function}
 491 %*                                                                      *
 492 %************************************************************************
 493
 494 @_runST@ has a non-Haskell-able type:
 495 \begin{verbatim}
 496 -- _runST :: forall a. (forall s. _ST s a) -> a
 497 -- which is to say ::
 498 --           forall a. (forall s. (_State s -> (a, _State s))) -> a
 499
 500 _runST a m = case m _RealWorld (S# _RealWorld realWorld#) of
 501                (r :: a, wild :: _State _RealWorld) -> r
 502 \end{verbatim}
 503 We unfold always, just for simplicity:
 504 \begin{code}
 505 runSTId
 506   = pcMiscPrelId runSTIdKey pRELUDE_BUILTIN SLIT("_runST") run_ST_ty id_info
 507   where
 508     s_tv = beta_tv
 509     s    = beta
 510
 511     st_ty a = mkSigmaTy [s_tv] [] (mkStateTransformerTy s a)
 512
 513     run_ST_ty
 514       = mkSigmaTy [alpha_tv] [] (st_ty alpha `UniFun` alpha)
 515             -- NB: rank-2 polymorphism! (forall inside the st_ty...)
 516
 517     id_info
 518       = noIdInfo
 519         `addInfo` mkArityInfo 1
 520         `addInfo` mkStrictnessInfo [WwStrict] Nothing
 521         `addInfo` mkArgUsageInfo [ArgUsage 1]
 522         -- ABSOLUTELY NO UNFOLDING, e.g.: (mkUnfolding EssentialUnfolding run_ST_template)
 523         -- see example below
 524 {- OUT:
 525     [m, t, r, wild]
 526       = mkTemplateLocals [
 527         {-m-} st_ty alpha_ty,
 528         {-t-} realWorldStateTy,
 529         {-r-} alpha_ty,
 530         {-_-} realWorldStateTy
 531         ]
 532
 533     run_ST_template
 534       = CoTyLam alpha_tyvar
 535          (mkCoLam [m] (
 536             CoLet (CoNonRec t (CoCon stateDataCon [realWorldTy] [CoVarAtom realWorldPrimId])) (
 537               CoCase (CoApp (mkCoTyApp (CoVar m) realWorldTy) (CoVarAtom t)) (
 538                 CoAlgAlts
 539                   [(mkTupleCon 2, [r, wild], CoVar r)]
 540                   CoNoDefault))))
 541 -}
 542 \end{code}
 543
 544 SLPJ 95/04: Why @_runST@ must not have an unfolding; consider:
 545 \begin{verbatim}
 546 f x =
 547   _runST ( \ s -> let
 548                     (a, s')  = newArray# 100 [] s
 549                     (_, s'') = fill_in_array_or_something a x s'
 550                   in
 551                   freezeArray# a s'' )
 552 \end{verbatim}
 553 If we inline @_runST@, we'll get:
 554 \begin{verbatim}
 555 f x = let
 556         (a, s')  = newArray# 100 [] realWorld#{-NB-}
 557         (_, s'') = fill_in_array_or_something a x s'
 558       in
 559       freezeArray# a s''
 560 \end{verbatim}
 561 And now the @newArray#@ binding can be floated to become a CAF, which
 562 is totally and utterly wrong:
 563 \begin{verbatim}
 564 f = let
 565     (a, s')  = newArray# 100 [] realWorld#{-NB-} -- YIKES!!!
 566     in
 567     \ x ->
 568         let (_, s'') = fill_in_array_or_something a x s' in
 569         freezeArray# a s''
 570 \end{verbatim}
 571 All calls to @f@ will share a {\em single} array!  End SLPJ 95/04.
 572
 573 @realWorld#@ used to be a magic literal, \tr{void#}.  If things get
 574 nasty as-is, change it back to a literal (@BasicLit@).
 575 \begin{code}
 576 realWorldPrimId
 577   = pcMiscPrelId realWorldPrimIdKey pRELUDE_BUILTIN SLIT("realWorld#")
 578         realWorldStatePrimTy
 579         noIdInfo
 580 \end{code}
 581
 582 %************************************************************************
 583 %*                                                                      *
 584 \subsection[PrelVals-foldr-build]{Values known about for ``foldr/build''}
 585 %*                                                                      *
 586 %************************************************************************
 587
 588 \begin{code}
 589 {- NO:
 590 rangeComplaint_Ix_IntId
 591  = pcMiscPrelId rangeComplaintIdKey pRELUDE_BUILTIN SLIT("_rangeComplaint_Ix_Int") my_ty id_info
 592   where
 593     my_ty
 594       = mkSigmaTy [alpha_tv] [] (
 595                         intPrimTy `UniFun` (
 596                         intPrimTy `UniFun` (
 597                         intPrimTy `UniFun` alpha)))
 598     id_info
 599       = noIdInfo
 600         `addInfo` mkArityInfo 3
 601         `addInfo` mkBottomStrictnessInfo
 602 -}
 603 \end{code}
 604
 605 \begin{code}
 606 buildId
 607   = pcMiscPrelId buildIdKey pRELUDE_CORE SLIT("_build") buildTy
 608         ((((noIdInfo
 609                 `addInfo_UF` mkMagicUnfolding SLIT("build"))
 610                 `addInfo` mkStrictnessInfo [WwStrict] Nothing)
 611                 `addInfo` mkArgUsageInfo [ArgUsage 2])
 612                 `addInfo` pcGenerateSpecs buildIdKey buildId noIdInfo{-ToDo-} buildTy)
 613         -- cheating, but since _build never actually exists ...
 614   where
 615     -- The type of this strange object is:
 616     --  \/ a . (\/ b . (a -> b -> b) -> b -> b) -> [a]
 617
 618     buildTy = mkSigmaTy [alpha_tv] [] (buildUniTy `UniFun` (mkListTy alpha))
 619         where
 620             buildUniTy = mkSigmaTy [beta_tv] []
 621                     ((alpha `UniFun` (beta `UniFun` beta))
 622                             `UniFun` (beta `UniFun` beta))
 623 \end{code}
 624
 625 @mkBuild@ is sugar for building a build!
 626
 627 @mkbuild ty tv c n e@ $Rightarrow$ @build ty (/\ tv -> \ c n -> e)@
 628 @ty@ is the type of the list.
 629 @tv@ is always a new type variable.
 630 @c,n@ are Id's for the abstract cons and nil, @g@ for let binding the argument argument.
 631         c :: a -> b -> b
 632         n :: b
 633         v :: (\/ b . (a -> b -> b) -> b -> b) -> [a]
 634 --  \/ a .  (\/ b . (a -> b -> b) -> b -> b) -> [a]
 635 @e@ is the object right inside the @build@
 636
 637 \begin{code}
 638 mkBuild :: UniType
 639         -> TyVar
 640         -> Id
 641         -> Id
 642         -> Id
 643         -> PlainCoreExpr -- template
 644         -> PlainCoreExpr -- template
 645
 646 mkBuild ty tv c n g expr
 647  = CoLet (CoNonRec g (CoTyLam tv (mkCoLam [c,n] expr)))
 648          (CoApp (mkCoTyApp (CoVar buildId) ty) (CoVarAtom g))
 649 \end{code}
 650
 651 \begin{code}
 652 augmentId
 653   = pcMiscPrelId buildIdKey pRELUDE_CORE SLIT("_augment") augmentTy
 654         (((noIdInfo
 655                 `addInfo_UF` mkMagicUnfolding SLIT("augment"))
 656                 `addInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
 657                 `addInfo` mkArgUsageInfo [ArgUsage 2,UnknownArgUsage])
 658         -- cheating, but since _build never actually exists ...
 659   where
 660     -- The type of this strange object is:
 661     --  \/ a . (\/ b . (a -> b -> b) -> b -> b) -> [a] -> [a]
 662
 663     augmentTy = mkSigmaTy [alpha_tv] [] (buildUniTy `UniFun`
 664                                         (mkListTy alpha `UniFun` mkListTy alpha))
 665         where
 666             buildUniTy = mkSigmaTy [beta_tv] []
 667                     ((alpha `UniFun` (beta `UniFun` beta))
 668                             `UniFun` (beta `UniFun` beta))
 669 \end{code}
 670
 671 mkFoldr ty_a ty_b [x,y...] => foldr ty_a ty_b x y ..
 672
 673 \begin{code}
 674 foldrId = pcMiscPrelId foldrIdKey pRELUDE_FB{-not "List"-} SLIT("foldr")
 675                  foldrTy idInfo
 676   where
 677         foldrTy =
 678           mkSigmaTy [alpha_tv, beta_tv] []
 679                 ((alpha `UniFun` (beta `UniFun` beta))
 680                 `UniFun` (beta
 681                 `UniFun` ((mkListTy alpha)
 682                 `UniFun` beta)))
 683
 684         idInfo = (((((noIdInfo
 685                         `addInfo_UF` mkMagicUnfolding SLIT("foldr"))
 686                         `addInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
 687                         `addInfo` mkArityInfo 3)
 688                         `addInfo` mkUpdateInfo [2,2,1])
 689                         `addInfo` pcGenerateSpecs foldrIdKey foldrId noIdInfo{-ToDo-} foldrTy)
 690
 691 mkFoldr a b f z xs = foldl CoApp
 692                            (mkCoTyApps (CoVar foldrId) [a, b])
 693                            [CoVarAtom f,CoVarAtom z,CoVarAtom xs]
 694
 695 foldlId = pcMiscPrelId foldlIdKey pRELUDE_FB{-not "List"-} SLIT("foldl")
 696                  foldlTy idInfo
 697   where
 698         foldlTy =
 699           mkSigmaTy [alpha_tv, beta_tv] []
 700                 ((alpha `UniFun` (beta `UniFun` alpha))
 701                 `UniFun` (alpha
 702                 `UniFun` ((mkListTy beta)
 703                 `UniFun` alpha)))
 704
 705         idInfo = (((((noIdInfo
 706                         `addInfo_UF` mkMagicUnfolding SLIT("foldl"))
 707                         `addInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
 708                         `addInfo` mkArityInfo 3)
 709                         `addInfo` mkUpdateInfo [2,2,1])
 710                         `addInfo` pcGenerateSpecs foldlIdKey foldlId noIdInfo{-ToDo-} foldlTy)
 711
 712 mkFoldl a b f z xs = foldl CoApp
 713                            (mkCoTyApps (CoVar foldlId) [a, b])
 714                            [CoVarAtom f,CoVarAtom z,CoVarAtom xs]
 715
 716 -- A bit of magic goes no here. We translate appendId into ++,
 717 -- you have to be carefull when you actually compile append:
 718 --      xs ++ ys = augment (\ c n -> foldr c n xs) ys
 719 --               {- unfold augment -}
 720 --               = foldr (:) ys xs
 721 --               {- fold foldr to append -}
 722 --               = ys `appendId` xs
 723 --               = ys ++ xs             -- ugg!
 724 -- *BUT* you want (++) and not _append in your interfaces.
 725 --
 726 -- So you have to turn *off* unfolding of foldr inside FoldrBuild.hs inside
 727 -- the prelude.
 728 --
 729
 730 appendId
 731   = pcMiscPrelId appendIdKey pRELUDE_LIST SLIT("++") appendTy idInfo
 732   where
 733     appendTy =
 734       (mkSigmaTy [alpha_tv] []
 735             ((mkListTy alpha) `UniFun` ((mkListTy alpha) `UniFun` (mkListTy alpha))))
 736     idInfo = (((noIdInfo
 737                 `addInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
 738                 `addInfo` mkArityInfo 2)
 739                 `addInfo` mkUpdateInfo [1,2])
 740
 741 pRELUDE_FB = SLIT("PreludeFoldrBuild")
 742 \end{code}