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