ghc/compiler/prelude/PrelVals.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   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 unpackCStringId
 118   = pcMiscPrelId unpackCStringIdKey pRELUDE_PS SLIT("unpackPS#")
 119                  (addrPrimTy{-a char *-} `UniFun` stringTy) noIdInfo
 120
 121 unpackCString2Id -- for cases when a string has a NUL in it
 122   = pcMiscPrelId unpackCString2IdKey pRELUDE_PS SLIT("unpackPS2#")
 123                  (addrPrimTy{-a char *-}
 124         `UniFun` (intPrimTy -- length
 125         `UniFun` stringTy)) noIdInfo
 126
 127 --------------------------------------------------------------------
 128 unpackCStringAppendId
 129   = pcMiscPrelId unpackCStringAppendIdKey pRELUDE_BUILTIN SLIT("unpackCStringAppend#")
 130                                 (addrPrimTy{-a "char *" pointer-}
 131                 `UniFun`        (stringTy
 132                 `UniFun`        stringTy)) noIdInfo
 133
 134 --------------------------------------------------------------------
 135
 136 packStringForCId
 137   = pcMiscPrelId packCStringIdKey{-ToDo:rename-} pRELUDE_PS SLIT("_packStringForC")
 138         (UniFun stringTy byteArrayPrimTy) noIdInfo
 139 \end{code}
 140
 141 OK, this is Will's idea: we should have magic values for Integers 0,
 142 +1, +2, and -1 (go ahead, fire me):
 143 \begin{code}
 144 integerZeroId
 145   = pcMiscPrelId integerZeroIdKey     pRELUDE_CORE SLIT("__integer0")  integerTy noIdInfo
 146 integerPlusOneId
 147   = pcMiscPrelId integerPlusOneIdKey  pRELUDE_CORE SLIT("__integer1")  integerTy noIdInfo
 148 integerPlusTwoId
 149   = pcMiscPrelId integerPlusTwoIdKey  pRELUDE_CORE SLIT("__integer2")  integerTy noIdInfo
 150 integerMinusOneId
 151   = pcMiscPrelId integerMinusOneIdKey pRELUDE_CORE SLIT("__integerm1") integerTy noIdInfo
 152 \end{code}
 153
 154 %************************************************************************
 155 %*                                                                      *
 156 \subsection[PrelVals-parallel]{@seq@ and @par@: for parallel operation (only)}
 157 %*                                                                      *
 158 %************************************************************************
 159
 160 In the definitions that follow, we use the @TyVar@-based
 161 alpha/beta/gamma types---not the usual @TyVarTemplate@ ones.
 162
 163 This is so the @TyVars@ in the @CoTyLams@ (@alpha_tyvar@, etc) match
 164 up with those in the types of the {\em lambda-bound} template-locals
 165 we create (using types @alpha_ty@, etc.).
 166
 167 \begin{code}
 168 --------------------------------------------------------------------
 169 -- seqId :: "_seq_", used w/ GRIP, etc., is really quite similar to
 170 -- dangerousEval
 171 {-
 172    OLDER:
 173    _seq_ = /\ a b -> \ x y -> case x of { _ -> y }
 174
 175    OLD:
 176    _seq_ = /\ a b -> \ x y -> case seq# x y of { _Lift y' -> y' }
 177
 178    NEW (95/05):
 179    _seq_ = /\ a b -> \ x::a y::b -> case seq# x of { 0# -> parError#; _ -> y; }
 180
 181 -}
 182
 183 seqId = pcMiscPrelId seqIdKey pRELUDE_BUILTIN SLIT("_seq_")
 184                   (mkSigmaTy [alpha_tv, beta_tv] []
 185                     (alpha `UniFun` (beta `UniFun` beta)))
 186                   (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding seq_template))
 187   where
 188     [x, y, z]
 189       = mkTemplateLocals [
 190         {-x-} alpha_ty,
 191         {-y-} beta_ty,
 192         {-z-} intPrimTy
 193         ]
 194
 195     seq_template
 196       = CoTyLam alpha_tyvar
 197           (CoTyLam beta_tyvar
 198              (mkCoLam [x, y] (
 199                 CoCase (CoPrim SeqOp [alpha_ty] [CoVarAtom x]) (
 200                   CoPrimAlts
 201                     [(mkMachInt 0, CoTyApp (CoVar pAR_ERROR_ID) beta_ty)]
 202                     (CoBindDefault z (CoVar y))))))
 203
 204 --------------------------------------------------------------------
 205 -- parId :: "_par_", also used w/ GRIP, etc.
 206 {-
 207     OLDER:
 208
 209     par = /\ a b -> \ x y -> case (par# (case x of { _ -> () })) of { _ -> y }
 210
 211     OLD:
 212
 213     _par_ = /\ a b -> \ x y -> case par# x y of { _Lift y' -> y' }
 214
 215     NEW (95/05):
 216
 217     _par_ = /\ a b -> \ x::a y::b -> case par# x of { 0# -> parError#; _ -> y; }
 218
 219 -}
 220 parId = pcMiscPrelId parIdKey pRELUDE_BUILTIN SLIT("_par_")
 221                   (mkSigmaTy [alpha_tv, beta_tv] []
 222                     (alpha `UniFun` (beta `UniFun` beta)))
 223                   (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding par_template))
 224   where
 225     [x, y, z]
 226       = mkTemplateLocals [
 227         {-x-} alpha_ty,
 228         {-y-} beta_ty,
 229         {-z-} intPrimTy
 230         ]
 231
 232     par_template
 233       = CoTyLam alpha_tyvar
 234           (CoTyLam beta_tyvar
 235              (mkCoLam [x, y] (
 236                 CoCase (CoPrim ParOp [alpha_ty] [CoVarAtom x]) (
 237                   CoPrimAlts
 238                     [(mkMachInt 0, CoTyApp (CoVar pAR_ERROR_ID) beta_ty)]
 239                     (CoBindDefault z (CoVar y))))))
 240
 241 -- forkId :: "_fork_", for *required* concurrent threads
 242 {-
 243    _fork_ = /\ a b -> \ x::a y::b -> case fork# x of { 0# -> parError#; _ -> y; }
 244 -}
 245 forkId = pcMiscPrelId forkIdKey pRELUDE_BUILTIN SLIT("_fork_")
 246                   (mkSigmaTy [alpha_tv, beta_tv] []
 247                     (alpha `UniFun` (beta `UniFun` beta)))
 248                   (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding fork_template))
 249   where
 250     [x, y, z]
 251       = mkTemplateLocals [
 252         {-x-} alpha_ty,
 253         {-y-} beta_ty,
 254         {-z-} intPrimTy
 255         ]
 256
 257     fork_template
 258       = CoTyLam alpha_tyvar
 259           (CoTyLam beta_tyvar
 260              (mkCoLam [x, y] (
 261                 CoCase (CoPrim ForkOp [alpha_ty] [CoVarAtom x]) (
 262                   CoPrimAlts
 263                     [(mkMachInt 0, CoTyApp (CoVar pAR_ERROR_ID) beta_ty)]
 264                     (CoBindDefault z (CoVar y))))))
 265
 266 \end{code}
 267
 268 \begin{code}
 269 #ifdef GRAN
 270
 271 parLocalId = pcMiscPrelId parLocalIdKey pRELUDE_BUILTIN SLIT("_parLocal_")
 272                   (mkSigmaTy [alpha_tv, beta_tv] []
 273                     (intPrimTy `UniFun` (alpha `UniFun` (beta `UniFun` beta))))
 274                   (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parLocal_template))
 275   where
 276     [w, x, y, z]
 277       = mkTemplateLocals [
 278         {-w-} intPrimTy,
 279         {-x-} alpha_ty,
 280         {-y-} beta_ty,
 281         {-z-} beta_ty
 282         ]
 283
 284     parLocal_template
 285       = CoTyLam alpha_tyvar
 286           (CoTyLam beta_tyvar
 287              (mkCoLam [w, x, y] (
 288                 CoCase (CoPrim ParLocalOp [alpha_ty, beta_ty] [CoVarAtom x, CoVarAtom w, CoVarAtom y]) (
 289                   CoAlgAlts
 290                     [(liftDataCon, [z], CoVar z)]
 291                     (CoNoDefault)))))
 292
 293 parGlobalId = pcMiscPrelId parGlobalIdKey pRELUDE_BUILTIN SLIT("_parGlobal_")
 294                   (mkSigmaTy [alpha_tv, beta_tv] []
 295                     (intPrimTy `UniFun` (alpha `UniFun` (beta `UniFun` beta))))
 296                   (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parGlobal_template))
 297   where
 298     [w, x, y, z]
 299       = mkTemplateLocals [
 300         {-w-} intPrimTy,
 301         {-x-} alpha_ty,
 302         {-y-} beta_ty,
 303         {-z-} beta_ty
 304         ]
 305
 306     parGlobal_template
 307       = CoTyLam alpha_tyvar
 308           (CoTyLam beta_tyvar
 309              (mkCoLam [w, x, y] (
 310                 CoCase (CoPrim ParGlobalOp [alpha_ty, beta_ty] [CoVarAtom x, CoVarAtom w, CoVarAtom y]) (
 311                   CoAlgAlts
 312                     [(liftDataCon, [z], CoVar z)]
 313                     (CoNoDefault)))))
 314
 315 #endif {-GRAN-}
 316 \end{code}
 317
 318 \begin{code}
 319 #ifdef DPH
 320 vectorMapId = pcChooseToKnowId vectorMapU pRELUDE "vectorMap"
 321               (mkSigmaTy [alpha_tv, beta_tv , gamma_tv]
 322                          [(pidClass,alpha)]
 323               ((beta `UniFun` gamma)                     `UniFun`
 324                  ((mkPodTy (mkProcessorTy [alpha] beta)) `UniFun`
 325                     (mkPodTy (mkProcessorTy [alpha] gamma)))))
 326               (panic "vectorMap:unfolding")--ToDo:DPH: (mkUnfoldTemplate vector_map_template)
 327               [(2,"","")]
 328  where
 329 {-
 330 vectorMap fn vec = << (|x;fn y|) | (|x;y|) <<- vec >>
 331
 332 Simplified :
 333 vectorMap :: for all a.83, b.82, c.86. <Pid a.83>
 334           -> (b.82 -> c.86)
 335           -> <<a.83;b.82>>
 336           -> <<a.83;c.86>>
 337 vectorMap =
 338     /\ t83 t82 o86 -> \ dict.127 ->
 339         let
 340           vecMap.128 =
 341               \ fn.129 vec.130 ->
 342                   << let si.133 = fn.129 ds.132 in
 343                      let
 344                        si.134 =
 345                            (fromDomain t82)
 346                                dict.127 ((toDomain t82) dict.127 ds.131)
 347                      in  MkProcessor1! Integer o86 si.134 si.133 |
 348                       (| ds.131 ; ds.132 |) <<- vec.130 >>
 349         in  vecMap.128
 350
 351  NOTE : no need to bother with overloading in class Pid; because the result
 352         PID (si.133) is wrapped in fromDomain.toDomain == id . Therefore we
 353         use the simplification below.
 354
 355 Simplified:
 356 vectorMap ::
 357     for all d.83, e.82, f.86.
 358         <Pid e.82> -> (d.83 -> f.86) -> <<e.82;d.83>> -> <<e.82;f.86>>
 359 vectorMap =
 360     /\ t83 t82 o86 -> \ dict.127 fn.129 vec.130 ->
 361     << MkProcessor1! Integer o86 ds.131 (fn.129 ds.132) |
 362                       (| ds.131 ; ds.132 |) <<- vec.130 >>
 363 -}
 364
 365     vector_map_template
 366       = let
 367            [dict,fn,vec,ds131,ds132]
 368              = mkTemplateLocals
 369                     [mkDictTy pidClass alpha_ty,
 370                      beta_ty `UniFun` gamma_ty,
 371                      mkPodTy (mkProcessorTy [alpha_ty] beta_ty),
 372                      integerTy,
 373                      beta_ty]
 374         in
 375           CoTyLam alpha_tyvar
 376             (CoTyLam beta_tyvar
 377               (CoTyLam gamma_tyvar
 378                 (mkCoLam [dict,fn,vec]
 379                   (CoZfExpr
 380                     (CoCon (mkProcessorCon 1)
 381                            [integerTy,mkTyVarTy gamma_tyvar]
 382                            [CoVar ds131,
 383                             (CoApp (CoVar fn) (CoVar ds132))])
 384                     (CoDrawnGen [ds131] ds132 (CoVar vec)) ))))
 385
 386 #endif {- Data Parallel Haskell -}
 387 \end{code}
 388
 389 \begin{code}
 390 #ifdef DPH
 391 -- A function used during podization that produces an index POD for a given
 392 -- POD as argument.
 393
 394 primIfromPodNSelectorId :: Int -> Int -> Id
 395 primIfromPodNSelectorId i n
 396    = pcMiscPrelId
 397         podSelectorIdKey
 398         pRELUDE_BUILTIN
 399         ("prim"++ show i ++ "fromPod" ++ show n ++ "Selector")
 400         (UniFun
 401            (mkPodNTy n alpha)
 402            (mkPodNTy n alpha))
 403         noIdInfo
 404 #endif {- Data Parallel Haskell -}
 405 \end{code}
 406
 407 %************************************************************************
 408 %*                                                                      *
 409 \subsection[PrelVals-deriving]{Values known about mainly for doing derived instance decls}
 410 %*                                                                      *
 411 %************************************************************************
 412
 413 map             :: (a -> b) -> [a] -> [b]
 414         -- this is up in the here-because-of-unfolding list
 415
 416 --??showChar    :: Char -> ShowS
 417 showSpace       :: ShowS        -- non-std: == "showChar ' '"
 418 showString      :: String -> ShowS
 419 showParen       :: Bool -> ShowS -> ShowS
 420
 421 (++)            :: [a] -> [a] -> [a]
 422 readParen       :: Bool -> ReadS a -> ReadS a
 423 lex             :: ReadS String
 424
 425 \begin{code}
 426 {- OLD:
 427 readS_ty :: UniType -> UniType
 428 readS_ty ty
 429   = UniFun stringTy (mkListTy (mkTupleTy 2 [ty, stringTy]))
 430
 431 showS_ty :: UniType
 432 showS_ty = UniFun stringTy stringTy
 433 -}
 434 \end{code}
 435
 436 \begin{code}
 437 {- OLD:
 438 showSpaceId = pcMiscPrelId showSpaceIdKey pRELUDE_TEXT SLIT("_showSpace")
 439                                 showS_ty
 440                                 noIdInfo
 441
 442 showParenId = pcMiscPrelId showParenIdKey pRELUDE_TEXT SLIT("showParen")
 443                                 (boolTy `UniFun` (showS_ty `UniFun` showS_ty))
 444                                 noIdInfo
 445
 446 readParenId = pcMiscPrelId readParenIdKey pRELUDE_TEXT SLIT("readParen")
 447                                 (mkSigmaTy [alpha_tv] [] (
 448                                  boolTy `UniFun` (
 449                                  (readS_ty alpha) `UniFun` (readS_ty alpha))))
 450                                 noIdInfo
 451
 452 lexId = pcMiscPrelId lexIdKey pRELUDE_TEXT SLIT("lex")
 453                                 (readS_ty (mkListTy charTy))
 454                                 noIdInfo
 455 -}
 456 \end{code}
 457
 458 %************************************************************************
 459 %*                                                                      *
 460 \subsection[PrelVals-void]{@void#@: Magic value of type @Void#@}
 461 %*                                                                      *
 462 %************************************************************************
 463
 464 I don't think this is available to the user; it's used in the
 465 simplifier (WDP 94/06).
 466 \begin{code}
 467 voidPrimId
 468   = pcMiscPrelId voidPrimIdKey pRELUDE_BUILTIN SLIT("void#")
 469         voidPrimTy noIdInfo
 470 \end{code}
 471
 472 %************************************************************************
 473 %*                                                                      *
 474 \subsection[PrelVals-runST]{@_runST@: Magic start-state-transformer function}
 475 %*                                                                      *
 476 %************************************************************************
 477
 478 @_runST@ has a non-Haskell-able type:
 479 \begin{verbatim}
 480 -- _runST :: forall a. (forall s. _ST s a) -> a
 481 -- which is to say ::
 482 --           forall a. (forall s. (_State s -> (a, _State s))) -> a
 483
 484 _runST a m = case m _RealWorld (S# _RealWorld realWorld#) of
 485                (r :: a, wild :: _State _RealWorld) -> r
 486 \end{verbatim}
 487 We unfold always, just for simplicity:
 488 \begin{code}
 489 runSTId
 490   = pcMiscPrelId runSTIdKey pRELUDE_BUILTIN SLIT("_runST") run_ST_ty id_info
 491   where
 492     s_tv = beta_tv
 493     s    = beta
 494
 495     st_ty a = mkSigmaTy [s_tv] [] (mkStateTransformerTy s a)
 496
 497     run_ST_ty
 498       = mkSigmaTy [alpha_tv] [] (st_ty alpha `UniFun` alpha)
 499             -- NB: rank-2 polymorphism! (forall inside the st_ty...)
 500
 501     id_info
 502       = noIdInfo
 503         `addInfo` mkArityInfo 1
 504         `addInfo` mkStrictnessInfo [WwStrict] Nothing
 505         -- ABSOLUTELY NO UNFOLDING, e.g.: (mkUnfolding EssentialUnfolding run_ST_template)
 506         -- see example below
 507 {- OUT:
 508     [m, t, r, wild]
 509       = mkTemplateLocals [
 510         {-m-} st_ty alpha_ty,
 511         {-t-} realWorldStateTy,
 512         {-r-} alpha_ty,
 513         {-_-} realWorldStateTy
 514         ]
 515
 516     run_ST_template
 517       = CoTyLam alpha_tyvar
 518          (mkCoLam [m] (
 519             CoLet (CoNonRec t (CoCon stateDataCon [realWorldTy] [CoVarAtom realWorldPrimId])) (
 520               CoCase (CoApp (mkCoTyApp (CoVar m) realWorldTy) (CoVarAtom t)) (
 521                 CoAlgAlts
 522                   [(mkTupleCon 2, [r, wild], CoVar r)]
 523                   CoNoDefault))))
 524 -}
 525 \end{code}
 526
 527 SLPJ 95/04: Why @_runST@ must not have an unfolding; consider:
 528 \begin{verbatim}
 529 f x =
 530   _runST ( \ s -> let
 531                     (a, s')  = newArray# 100 [] s
 532                     (_, s'') = fill_in_array_or_something a x s'
 533                   in
 534                   freezeArray# a s'' )
 535 \end{verbatim}
 536 If we inline @_runST@, we'll get:
 537 \begin{verbatim}
 538 f x = let
 539         (a, s')  = newArray# 100 [] realWorld#{-NB-}
 540         (_, s'') = fill_in_array_or_something a x s'
 541       in
 542       freezeArray# a s''
 543 \end{verbatim}
 544 And now the @newArray#@ binding can be floated to become a CAF, which
 545 is totally and utterly wrong:
 546 \begin{verbatim}
 547 f = let
 548     (a, s')  = newArray# 100 [] realWorld#{-NB-} -- YIKES!!!
 549     in
 550     \ x ->
 551         let (_, s'') = fill_in_array_or_something a x s' in
 552         freezeArray# a s''
 553 \end{verbatim}
 554 All calls to @f@ will share a {\em single} array!  End SLPJ 95/04.
 555
 556 @realWorld#@ used to be a magic literal, \tr{void#}.  If things get
 557 nasty as-is, change it back to a literal (@BasicLit@).
 558 \begin{code}
 559 realWorldPrimId
 560   = pcMiscPrelId realWorldPrimIdKey pRELUDE_BUILTIN SLIT("realWorld#")
 561         realWorldStatePrimTy
 562         noIdInfo
 563 \end{code}
 564
 565 %************************************************************************
 566 %*                                                                      *
 567 \subsection[PrelVals-foldr-build]{Values known about for ``foldr/build''}
 568 %*                                                                      *
 569 %************************************************************************
 570
 571 \begin{code}
 572 buildId
 573   = pcMiscPrelId buildIdKey pRELUDE_CORE SLIT("_build") buildTy
 574         ((((noIdInfo
 575                 `addInfo_UF` mkMagicUnfolding SLIT("build"))
 576                 `addInfo` mkStrictnessInfo [WwStrict] Nothing)
 577                 `addInfo` mkArgUsageInfo [ArgUsage 2])
 578                 `addInfo` pcGenerateSpecs buildIdKey buildId noIdInfo{-ToDo-} buildTy)
 579         -- cheating, but since _build never actually exists ...
 580   where
 581     -- The type of this strange object is:
 582     --  \/ a . (\/ b . (a -> b -> b) -> b -> b) -> [a]
 583
 584     buildTy = mkSigmaTy [alpha_tv] [] (buildUniTy `UniFun` (mkListTy alpha))
 585         where
 586             buildUniTy = mkSigmaTy [beta_tv] []
 587                     ((alpha `UniFun` (beta `UniFun` beta))
 588                             `UniFun` (beta `UniFun` beta))
 589 \end{code}
 590
 591 @mkBuild@ is sugar for building a build!
 592
 593 @mkbuild ty tv c n e@ $Rightarrow$ @build ty (/\ tv -> \ c n -> e)@
 594 @ty@ is the type of the list.
 595 @tv@ is always a new type variable.
 596 @c,n@ are Id's for the abstract cons and nil, @g@ for let binding the argument argument.
 597         c :: a -> b -> b
 598         n :: b
 599         v :: (\/ b . (a -> b -> b) -> b -> b) -> [a]
 600 --  \/ a .  (\/ b . (a -> b -> b) -> b -> b) -> [a]
 601 @e@ is the object right inside the @build@
 602
 603 \begin{code}
 604 mkBuild :: UniType
 605         -> TyVar
 606         -> Id
 607         -> Id
 608         -> Id
 609         -> PlainCoreExpr -- template
 610         -> PlainCoreExpr -- template
 611
 612 mkBuild ty tv c n g expr
 613  = CoLet (CoNonRec g (CoTyLam tv (mkCoLam [c,n] expr)))
 614          (CoApp (mkCoTyApp (CoVar buildId) ty) (CoVarAtom g))
 615 \end{code}
 616
 617 mkFoldr ty_a ty_b [x,y...] => foldr ty_a ty_b x y ..
 618
 619 \begin{code}
 620 foldrId = pcMiscPrelId foldrIdKey pRELUDE_FB{-not "List"-} SLIT("foldr")
 621                  foldrTy idInfo
 622   where
 623         foldrTy =
 624           mkSigmaTy [alpha_tv, beta_tv] []
 625                 ((alpha `UniFun` (beta `UniFun` beta))
 626                 `UniFun` (beta
 627                 `UniFun` ((mkListTy alpha)
 628                 `UniFun` beta)))
 629
 630         idInfo = (((((noIdInfo
 631                         `addInfo_UF` mkMagicUnfolding SLIT("foldr"))
 632                         `addInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
 633                         `addInfo` mkArityInfo 3)
 634                         `addInfo` mkUpdateInfo [2,2,1])
 635                         `addInfo` pcGenerateSpecs foldrIdKey foldrId noIdInfo{-ToDo-} foldrTy)
 636
 637 mkFoldr a b f z xs = foldl CoApp
 638                            (mkCoTyApps (CoVar foldrId) [a, b])
 639                            [CoVarAtom f,CoVarAtom z,CoVarAtom xs]
 640
 641 foldlId = pcMiscPrelId foldlIdKey pRELUDE_FB{-not "List"-} SLIT("foldl")
 642                  foldlTy idInfo
 643   where
 644         foldlTy =
 645           mkSigmaTy [alpha_tv, beta_tv] []
 646                 ((alpha `UniFun` (beta `UniFun` alpha))
 647                 `UniFun` (alpha
 648                 `UniFun` ((mkListTy beta)
 649                 `UniFun` alpha)))
 650
 651         idInfo = (((((noIdInfo
 652                         `addInfo_UF` mkMagicUnfolding SLIT("foldl"))
 653                         `addInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
 654                         `addInfo` mkArityInfo 3)
 655                         `addInfo` mkUpdateInfo [2,2,1])
 656                         `addInfo` pcGenerateSpecs foldlIdKey foldlId noIdInfo{-ToDo-} foldlTy)
 657
 658 mkFoldl a b f z xs = foldl CoApp
 659                            (mkCoTyApps (CoVar foldlId) [a, b])
 660                            [CoVarAtom f,CoVarAtom z,CoVarAtom xs]
 661
 662 pRELUDE_FB = SLIT("PreludeFoldrBuild")
 663 \end{code}