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