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 Ubiq
  12 import IdLoop           ( UnfoldingGuidance(..) )
  13 import Id               ( Id(..), GenId, mkPreludeId, mkTemplateLocals )
  14 import PrelLoop
  15
  16 -- friends:
  17 import PrelMods
  18 import TysPrim
  19 import TysWiredIn
  20
  21 -- others:
  22 import CoreSyn          -- quite a bit
  23 import IdInfo           -- quite a bit
  24 import Literal          ( mkMachInt )
  25 import PrimOp           ( PrimOp(..) )
  26 import SpecEnv          ( SpecEnv(..), nullSpecEnv )
  27 import TyVar            ( alphaTyVar, betaTyVar )
  28 import Unique           -- lots of *Keys
  29 import Util             ( panic )
  30 \end{code}
  31
  32
  33
  34
  35 \begin{code}
  36 -- only used herein:
  37 pcMiscPrelId :: Unique{-IdKey-} -> FAST_STRING -> FAST_STRING -> Type -> IdInfo -> Id
  38
  39 pcMiscPrelId key mod name ty info
  40  = mkPreludeId (mkBuiltinName key mod name) ty info
  41 \end{code}
  42
  43 %************************************************************************
  44 %*                                                                      *
  45 \subsection[PrelVals-error-related]{@error@ and friends; @trace@}
  46 %*                                                                      *
  47 %************************************************************************
  48
  49 GHC randomly injects these into the code.
  50
  51 @patError#@ is just a version of @error@ for pattern-matching
  52 failures.  It knows various ``codes'' which expand to longer
  53 strings---this saves space!
  54
  55 @absent#@ is a thing we put in for ``absent'' arguments.  They jolly
  56 well shouldn't be yanked on, but if one is, then you will get a
  57 friendly message from @absent#@ (rather a totally random crash).
  58
  59 @parError#@ is a special version of @error@ which the compiler does
  60 not know to be a bottoming Id.  It is used in the @_par_@ and @_seq_@
  61 templates, but we don't ever expect to generate code for it.
  62
  63 \begin{code}
  64 pc_bottoming_Id key mod name ty
  65  = pcMiscPrelId key mod name ty bottoming_info
  66  where
  67     bottoming_info = noIdInfo `addInfo` mkBottomStrictnessInfo
  68         -- these "bottom" out, no matter what their arguments
  69
  70 eRROR_ID
  71   = pc_bottoming_Id errorIdKey pRELUDE_BUILTIN SLIT("error") errorTy
  72
  73 generic_ERROR_ID u n
  74   = pc_bottoming_Id u pRELUDE_BUILTIN n errorTy
  75
  76 pAT_ERROR_ID
  77   = generic_ERROR_ID patErrorIdKey SLIT("patError#")
  78 rEC_CON_ERROR_ID
  79   = generic_ERROR_ID recConErrorIdKey SLIT("recConError#")
  80 rEC_UPD_ERROR_ID
  81   = generic_ERROR_ID recUpdErrorIdKey SLIT("recUpdError#")
  82 iRREFUT_PAT_ERROR_ID
  83   = generic_ERROR_ID irrefutPatErrorIdKey SLIT("irrefutPatError#")
  84 nON_EXHAUSTIVE_GUARDS_ERROR_ID
  85   = generic_ERROR_ID nonExhaustiveGuardsErrorIdKey SLIT("nonExhaustiveGuardsError#")
  86
  87 aBSENT_ERROR_ID
  88   = pc_bottoming_Id absentErrorIdKey pRELUDE_BUILTIN SLIT("absent#")
  89         (mkSigmaTy [alphaTyVar] [] alphaTy)
  90
  91 pAR_ERROR_ID
  92   = pcMiscPrelId parErrorIdKey pRELUDE_BUILTIN SLIT("parError#")
  93     (mkSigmaTy [alphaTyVar] [] alphaTy) noIdInfo
  94
  95 errorTy  :: Type
  96 errorTy  = mkSigmaTy [alphaTyVar] [] (mkFunTys [mkListTy charTy] alphaTy)
  97 \end{code}
  98
  99 We want \tr{_trace} (NB: name not in user namespace) to be wired in
 100 because we don't want the strictness analyser to get ahold of it,
 101 decide that the second argument is strict, evaluate that first (!!),
 102 and make a jolly old mess.  Having \tr{_trace} wired in also helps when
 103 attempting to re-export it---because it's in \tr{PreludeBuiltin}, it
 104 won't get an \tr{import} declaration in the interface file, so the
 105 importing-subsequently module needs to know it's magic.
 106 \begin{code}
 107 tRACE_ID
 108   = pcMiscPrelId traceIdKey pRELUDE_BUILTIN SLIT("_trace") traceTy
 109         (noIdInfo `addInfo` pcGenerateSpecs traceIdKey tRACE_ID noIdInfo traceTy)
 110   where
 111     traceTy = mkSigmaTy [alphaTyVar] [] (mkFunTys [mkListTy charTy, alphaTy] alphaTy)
 112 \end{code}
 113
 114 %************************************************************************
 115 %*                                                                      *
 116 \subsection[PrelVals-Integer-support]{To support @Integer@ and @String@ literals}
 117 %*                                                                      *
 118 %************************************************************************
 119
 120 \begin{code}
 121 packStringForCId
 122   = pcMiscPrelId packCStringIdKey{-ToDo:rename-} pRELUDE_PS SLIT("_packStringForC")
 123         (mkFunTys [stringTy] byteArrayPrimTy) noIdInfo
 124
 125 --------------------------------------------------------------------
 126
 127 unpackCStringId
 128   = pcMiscPrelId unpackCStringIdKey pRELUDE_BUILTIN SLIT("unpackPS#")
 129                  (mkFunTys [addrPrimTy{-a char *-}] stringTy) noIdInfo
 130 -- Andy says:
 131 --      (FunTy addrPrimTy{-a char *-} stringTy) (noIdInfo `addInfo` mkArityInfo 1)
 132 -- but I don't like wired-in IdInfos (WDP)
 133
 134 unpackCString2Id -- for cases when a string has a NUL in it
 135   = pcMiscPrelId unpackCString2IdKey pRELUDE_BUILTIN SLIT("unpackPS2#")
 136                  (mkFunTys [addrPrimTy{-a char *-}, intPrimTy{-length-}] stringTy)
 137                  noIdInfo
 138
 139 --------------------------------------------------------------------
 140 unpackCStringAppendId
 141   = pcMiscPrelId unpackCStringAppendIdKey pRELUDE_BUILTIN SLIT("unpackAppendPS#")
 142                 (mkFunTys [addrPrimTy{-a "char *" pointer-},stringTy] stringTy)
 143                 ((noIdInfo
 144                  `addInfo_UF` mkMagicUnfolding unpackCStringAppendIdKey)
 145                  `addInfo` mkArityInfo 2)
 146
 147 unpackCStringFoldrId
 148   = pcMiscPrelId unpackCStringFoldrIdKey pRELUDE_BUILTIN SLIT("unpackFoldrPS#")
 149                 (mkSigmaTy [alphaTyVar] []
 150                 (mkFunTys [addrPrimTy{-a "char *" pointer-},
 151                            mkFunTys [charTy, alphaTy] alphaTy,
 152                            alphaTy]
 153                           alphaTy))
 154                 ((noIdInfo
 155                  `addInfo_UF` mkMagicUnfolding unpackCStringFoldrIdKey)
 156                  `addInfo` mkArityInfo 3)
 157 \end{code}
 158
 159 OK, this is Will's idea: we should have magic values for Integers 0,
 160 +1, +2, and -1 (go ahead, fire me):
 161 \begin{code}
 162 integerZeroId
 163   = pcMiscPrelId integerZeroIdKey     pRELUDE_CORE SLIT("__integer0")  integerTy noIdInfo
 164 integerPlusOneId
 165   = pcMiscPrelId integerPlusOneIdKey  pRELUDE_CORE SLIT("__integer1")  integerTy noIdInfo
 166 integerPlusTwoId
 167   = pcMiscPrelId integerPlusTwoIdKey  pRELUDE_CORE SLIT("__integer2")  integerTy noIdInfo
 168 integerMinusOneId
 169   = pcMiscPrelId integerMinusOneIdKey pRELUDE_CORE SLIT("__integerm1") integerTy noIdInfo
 170 \end{code}
 171
 172 %************************************************************************
 173 %*                                                                      *
 174 \subsection[PrelVals-parallel]{@seq@ and @par@: for parallel operation (only)}
 175 %*                                                                      *
 176 %************************************************************************
 177
 178 \begin{code}
 179 --------------------------------------------------------------------
 180 -- seqId :: "_seq_", used w/ GRIP, etc., is really quite similar to
 181 -- dangerousEval
 182 {-
 183    OLDER:
 184    _seq_ = /\ a b -> \ x y -> case x of { _ -> y }
 185
 186    OLD:
 187    _seq_ = /\ a b -> \ x y -> case seq# x y of { _Lift y' -> y' }
 188
 189    NEW (95/05):
 190    _seq_ = /\ a b -> \ x::a y::b -> case seq# x of { 0# -> parError#; _ -> y; }
 191
 192 -}
 193
 194 seqId = pcMiscPrelId seqIdKey pRELUDE_BUILTIN SLIT("_seq_")
 195                   (mkSigmaTy [alphaTyVar, betaTyVar] []
 196                     (mkFunTys [alphaTy, betaTy] betaTy))
 197                   (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding seq_template))
 198   where
 199     [x, y, z]
 200       = mkTemplateLocals [
 201         {-x-} alphaTy,
 202         {-y-} betaTy,
 203         {-z-} intPrimTy
 204         ]
 205
 206     seq_template
 207       = mkLam [alphaTyVar, betaTyVar] [x, y] (
 208                 Case (Prim SeqOp [TyArg alphaTy, VarArg x]) (
 209                   PrimAlts
 210                     [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
 211                     (BindDefault z (Var y))))
 212
 213 --------------------------------------------------------------------
 214 -- parId :: "_par_", also used w/ GRIP, etc.
 215 {-
 216     OLDER:
 217
 218     par = /\ a b -> \ x y -> case (par# (case x of { _ -> () })) of { _ -> y }
 219
 220     OLD:
 221
 222     _par_ = /\ a b -> \ x y -> case par# x y of { _Lift y' -> y' }
 223
 224     NEW (95/05):
 225
 226     _par_ = /\ a b -> \ x::a y::b -> case par# x of { 0# -> parError#; _ -> y; }
 227
 228 -}
 229 parId = pcMiscPrelId parIdKey pRELUDE_BUILTIN SLIT("_par_")
 230                   (mkSigmaTy [alphaTyVar, betaTyVar] []
 231                     (mkFunTys [alphaTy, betaTy] betaTy))
 232                   (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding par_template))
 233   where
 234     [x, y, z]
 235       = mkTemplateLocals [
 236         {-x-} alphaTy,
 237         {-y-} betaTy,
 238         {-z-} intPrimTy
 239         ]
 240
 241     par_template
 242       = mkLam [alphaTyVar, betaTyVar] [x, y] (
 243                 Case (Prim ParOp [TyArg alphaTy, VarArg x]) (
 244                   PrimAlts
 245                     [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
 246                     (BindDefault z (Var y))))
 247
 248 -- forkId :: "_fork_", for *required* concurrent threads
 249 {-
 250    _fork_ = /\ a b -> \ x::a y::b -> case fork# x of { 0# -> parError#; _ -> y; }
 251 -}
 252 forkId = pcMiscPrelId forkIdKey pRELUDE_BUILTIN SLIT("_fork_")
 253                   (mkSigmaTy [alphaTyVar, betaTyVar] []
 254                     (mkFunTys [alphaTy, betaTy] betaTy))
 255                   (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding fork_template))
 256   where
 257     [x, y, z]
 258       = mkTemplateLocals [
 259         {-x-} alphaTy,
 260         {-y-} betaTy,
 261         {-z-} intPrimTy
 262         ]
 263
 264     fork_template
 265       = mkLam [alphaTyVar, betaTyVar] [x, y] (
 266                 Case (Prim ForkOp [TyArg alphaTy, VarArg x]) (
 267                   PrimAlts
 268                     [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
 269                     (BindDefault z (Var y))))
 270
 271 \end{code}
 272
 273 \begin{code}
 274 #ifdef GRAN
 275
 276 parLocalId = pcMiscPrelId parLocalIdKey pRELUDE_BUILTIN SLIT("_parLocal_")
 277                   (mkSigmaTy [alphaTyVar, betaTyVar] []
 278                     (mkFunTys [intPrimTy, alphaTy, betaTy] betaTy))
 279                   (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parLocal_template))
 280   where
 281     [w, x, y, z]
 282       = mkTemplateLocals [
 283         {-w-} intPrimTy,
 284         {-x-} alphaTy,
 285         {-y-} betaTy,
 286         {-z-} betaTy
 287         ]
 288
 289     parLocal_template
 290       = mkLam [alphaTyVar, betaTyVar] [w, x, y] (
 291                 Case (Prim ParLocalOp [TyArg alphaTy, TyArg betaTy, VarArg x, VarArg w, VarArg y]) (
 292                   AlgAlts
 293                     [(liftDataCon, [z], Var z)]
 294                     (NoDefault)))
 295
 296 parGlobalId = pcMiscPrelId parGlobalIdKey pRELUDE_BUILTIN SLIT("_parGlobal_")
 297                   (mkSigmaTy [alphaTyVar, betaTyVar] []
 298                     (mkFunTys [intPrimTy,alphaTy,betaTy] betaTy))
 299                   (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parGlobal_template))
 300   where
 301     [w, x, y, z]
 302       = mkTemplateLocals [
 303         {-w-} intPrimTy,
 304         {-x-} alphaTy,
 305         {-y-} betaTy,
 306         {-z-} betaTy
 307         ]
 308
 309     parGlobal_template
 310       = mkLam [alphaTyVar, betaTyVar] [w, x, y] (
 311                 Case (Prim ParGlobalOp [TyArg alphaTy, TyArg betaTy, VarArg x, VarArg w, VarArg y]) (
 312                   AlgAlts
 313                     [(liftDataCon, [z], Var z)]
 314                     (NoDefault)))
 315
 316 #endif {-GRAN-}
 317 \end{code}
 318
 319 %************************************************************************
 320 %*                                                                      *
 321 \subsection[PrelVals-deriving]{Values known about mainly for doing derived instance decls}
 322 %*                                                                      *
 323 %************************************************************************
 324
 325 map             :: (a -> b) -> [a] -> [b]
 326         -- this is up in the here-because-of-unfolding list
 327
 328 --??showChar    :: Char -> ShowS
 329 showSpace       :: ShowS        -- non-std: == "showChar ' '"
 330 showString      :: String -> ShowS
 331 showParen       :: Bool -> ShowS -> ShowS
 332
 333 (++)            :: [a] -> [a] -> [a]
 334 readParen       :: Bool -> ReadS a -> ReadS a
 335 lex             :: ReadS String
 336
 337 %************************************************************************
 338 %*                                                                      *
 339 \subsection[PrelVals-void]{@void#@: Magic value of type @Void#@}
 340 %*                                                                      *
 341 %************************************************************************
 342
 343 I don't think this is available to the user; it's used in the
 344 simplifier (WDP 94/06).
 345 \begin{code}
 346 voidPrimId
 347   = pcMiscPrelId voidPrimIdKey pRELUDE_BUILTIN SLIT("void#")
 348         voidPrimTy noIdInfo
 349 \end{code}
 350
 351 %************************************************************************
 352 %*                                                                      *
 353 \subsection[PrelVals-runST]{@_runST@: Magic start-state-transformer function}
 354 %*                                                                      *
 355 %************************************************************************
 356
 357 @_runST@ has a non-Haskell-able type:
 358 \begin{verbatim}
 359 -- _runST :: forall a. (forall s. _ST s a) -> a
 360 -- which is to say ::
 361 --           forall a. (forall s. (_State s -> (a, _State s))) -> a
 362
 363 _runST a m = case m _RealWorld (S# _RealWorld realWorld#) of
 364                (r :: a, wild :: _State _RealWorld) -> r
 365 \end{verbatim}
 366 We unfold always, just for simplicity:
 367 \begin{code}
 368 runSTId
 369   = pcMiscPrelId runSTIdKey pRELUDE_BUILTIN SLIT("_runST") run_ST_ty id_info
 370   where
 371     s_tv = betaTyVar
 372     s    = betaTy
 373
 374     st_ty a = mkSigmaTy [s_tv] [] (mkStateTransformerTy s a)
 375
 376     run_ST_ty
 377       = mkSigmaTy [alphaTyVar] [] (mkFunTys [st_ty alphaTy] alphaTy)
 378             -- NB: rank-2 polymorphism! (forall inside the st_ty...)
 379
 380     id_info
 381       = noIdInfo
 382         `addInfo` mkArityInfo 1
 383         `addInfo` mkStrictnessInfo [WwStrict] Nothing
 384         `addInfo` mkArgUsageInfo [ArgUsage 1]
 385         -- ABSOLUTELY NO UNFOLDING, e.g.: (mkUnfolding EssentialUnfolding run_ST_template)
 386         -- see example below
 387 {- OUT:
 388     [m, t, r, wild]
 389       = mkTemplateLocals [
 390         {-m-} st_ty alphaTy,
 391         {-t-} realWorldStateTy,
 392         {-r-} alphaTy,
 393         {-_-} realWorldStateTy
 394         ]
 395
 396     run_ST_template
 397       = mkLam [alphaTyVar] [m] (
 398             Let (NonRec t (Con stateDataCon [TyArg realWorldTy, VarArg realWorldPrimId])) (
 399               Case (App (mkTyApp (Var m) [realWorldTy]) (VarArg t)) (
 400                 AlgAlts
 401                   [(mkTupleCon 2, [r, wild], Var r)]
 402                   NoDefault)))
 403 -}
 404 \end{code}
 405
 406 SLPJ 95/04: Why @_runST@ must not have an unfolding; consider:
 407 \begin{verbatim}
 408 f x =
 409   _runST ( \ s -> let
 410                     (a, s')  = newArray# 100 [] s
 411                     (_, s'') = fill_in_array_or_something a x s'
 412                   in
 413                   freezeArray# a s'' )
 414 \end{verbatim}
 415 If we inline @_runST@, we'll get:
 416 \begin{verbatim}
 417 f x = let
 418         (a, s')  = newArray# 100 [] realWorld#{-NB-}
 419         (_, s'') = fill_in_array_or_something a x s'
 420       in
 421       freezeArray# a s''
 422 \end{verbatim}
 423 And now the @newArray#@ binding can be floated to become a CAF, which
 424 is totally and utterly wrong:
 425 \begin{verbatim}
 426 f = let
 427     (a, s')  = newArray# 100 [] realWorld#{-NB-} -- YIKES!!!
 428     in
 429     \ x ->
 430         let (_, s'') = fill_in_array_or_something a x s' in
 431         freezeArray# a s''
 432 \end{verbatim}
 433 All calls to @f@ will share a {\em single} array!  End SLPJ 95/04.
 434
 435 @realWorld#@ used to be a magic literal, \tr{void#}.  If things get
 436 nasty as-is, change it back to a literal (@Literal@).
 437 \begin{code}
 438 realWorldPrimId
 439   = pcMiscPrelId realWorldPrimIdKey pRELUDE_BUILTIN SLIT("realWorld#")
 440         realWorldStatePrimTy
 441         noIdInfo
 442 \end{code}
 443
 444 %************************************************************************
 445 %*                                                                      *
 446 \subsection[PrelVals-foldr-build]{Values known about for ``foldr/build''}
 447 %*                                                                      *
 448 %************************************************************************
 449
 450 \begin{code}
 451 buildId
 452   = pcMiscPrelId buildIdKey pRELUDE_CORE SLIT("_build") buildTy
 453         ((((noIdInfo
 454                 `addInfo_UF` mkMagicUnfolding buildIdKey)
 455                 `addInfo` mkStrictnessInfo [WwStrict] Nothing)
 456                 `addInfo` mkArgUsageInfo [ArgUsage 2])
 457                 `addInfo` pcGenerateSpecs buildIdKey buildId noIdInfo{-ToDo-} buildTy)
 458         -- cheating, but since _build never actually exists ...
 459   where
 460     -- The type of this strange object is:
 461     --  \/ a . (\/ b . (a -> b -> b) -> b -> b) -> [a]
 462
 463     buildTy = mkSigmaTy [alphaTyVar] [] (mkFunTys [build_ty] (mkListTy alphaTy))
 464         where
 465             build_ty = mkSigmaTy [betaTyVar] []
 466                         (mkFunTys [alphaTy, mkFunTys [betaTy] betaTy, betaTy] betaTy)
 467 \end{code}
 468
 469 @mkBuild@ is sugar for building a build!
 470
 471 @mkbuild ty tv c n e@ $Rightarrow$ @build ty (/\ tv -> \ c n -> e)@
 472 @ty@ is the type of the list.
 473 @tv@ is always a new type variable.
 474 @c,n@ are Id's for the abstract cons and nil, @g@ for let binding the argument argument.
 475         c :: a -> b -> b
 476         n :: b
 477         v :: (\/ b . (a -> b -> b) -> b -> b) -> [a]
 478 --  \/ a .  (\/ b . (a -> b -> b) -> b -> b) -> [a]
 479 @e@ is the object right inside the @build@
 480
 481 \begin{code}
 482 mkBuild :: Type
 483         -> TyVar
 484         -> Id
 485         -> Id
 486         -> Id
 487         -> CoreExpr -- template
 488         -> CoreExpr -- template
 489
 490 mkBuild ty tv c n g expr
 491   = Let (NonRec g (mkLam [tv] [c,n] expr))
 492         (App (mkTyApp (Var buildId) [ty]) (VarArg g))
 493 \end{code}
 494
 495 \begin{code}
 496 augmentId
 497   = pcMiscPrelId augmentIdKey pRELUDE_CORE SLIT("_augment") augmentTy
 498         (((noIdInfo
 499                 `addInfo_UF` mkMagicUnfolding augmentIdKey)
 500                 `addInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
 501                 `addInfo` mkArgUsageInfo [ArgUsage 2,UnknownArgUsage])
 502         -- cheating, but since _augment never actually exists ...
 503   where
 504     -- The type of this strange object is:
 505     --  \/ a . (\/ b . (a -> b -> b) -> b -> b) -> [a] -> [a]
 506
 507     augmentTy = mkSigmaTy [alphaTyVar] [] (mkFunTys [aug_ty, mkListTy alphaTy] (mkListTy alphaTy))
 508         where
 509             aug_ty = mkSigmaTy [betaTyVar] []
 510                         (mkFunTys [alphaTy, mkFunTys [betaTy] betaTy, betaTy] betaTy)
 511 \end{code}
 512
 513 \begin{code}
 514 foldrId = pcMiscPrelId foldrIdKey pRELUDE_FB{-not "List"-} SLIT("foldr")
 515                  foldrTy idInfo
 516   where
 517         foldrTy =
 518           mkSigmaTy [alphaTyVar, betaTyVar] []
 519                 (mkFunTys [alphaTy, mkFunTys [betaTy] betaTy, betaTy, mkListTy alphaTy] betaTy)
 520
 521         idInfo = (((((noIdInfo
 522                         `addInfo_UF` mkMagicUnfolding foldrIdKey)
 523                         `addInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
 524                         `addInfo` mkArityInfo 3)
 525                         `addInfo` mkUpdateInfo [2,2,1])
 526                         `addInfo` pcGenerateSpecs foldrIdKey foldrId noIdInfo{-ToDo-} foldrTy)
 527
 528 foldlId = pcMiscPrelId foldlIdKey pRELUDE_FB{-not "List"-} SLIT("foldl")
 529                  foldlTy idInfo
 530   where
 531         foldlTy =
 532           mkSigmaTy [alphaTyVar, betaTyVar] []
 533                 (mkFunTys [alphaTy, mkFunTys [betaTy] betaTy, alphaTy, mkListTy betaTy] alphaTy)
 534
 535         idInfo = (((((noIdInfo
 536                         `addInfo_UF` mkMagicUnfolding foldlIdKey)
 537                         `addInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
 538                         `addInfo` mkArityInfo 3)
 539                         `addInfo` mkUpdateInfo [2,2,1])
 540                         `addInfo` pcGenerateSpecs foldlIdKey foldlId noIdInfo{-ToDo-} foldlTy)
 541
 542 -- A bit of magic goes no here. We translate appendId into ++,
 543 -- you have to be carefull when you actually compile append:
 544 --      xs ++ ys = augment (\ c n -> foldr c n xs) ys
 545 --               {- unfold augment -}
 546 --               = foldr (:) ys xs
 547 --               {- fold foldr to append -}
 548 --               = ys `appendId` xs
 549 --               = ys ++ xs             -- ugg!
 550 -- *BUT* you want (++) and not _append in your interfaces.
 551 --
 552 -- So you have to turn *off* unfolding of foldr inside FoldrBuild.hs inside
 553 -- the prelude.
 554 --
 555
 556 appendId
 557   = pcMiscPrelId appendIdKey pRELUDE_LIST SLIT("++") appendTy idInfo
 558   where
 559     appendTy =
 560       (mkSigmaTy [alphaTyVar] []
 561             (mkFunTys [mkListTy alphaTy, mkListTy alphaTy] (mkListTy alphaTy)))
 562     idInfo = (((noIdInfo
 563                 `addInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
 564                 `addInfo` mkArityInfo 2)
 565                 `addInfo` mkUpdateInfo [1,2])
 566 \end{code}
 567
 568 %************************************************************************
 569 %*                                                                      *
 570 \subsection[PrelUtils-specialisations]{Specialisations for builtin values}
 571 %*                                                                      *
 572 %************************************************************************
 573
 574 The specialisations which exist for the builtin values must be recorded in
 575 their IdInfos.
 576
 577 NOTE: THE USES OF THE pcGenerate... FUNCTIONS MUST CORRESPOND
 578       TO THE SPECIALISATIONS DECLARED IN THE PRELUDE !!!
 579
 580 HACK: We currently use the same unique for the specialised Ids.
 581
 582 The list @specing_types@ determines the types for which specialised
 583 versions are created. Note: This should correspond with the
 584 types passed to the pre-processor with the -genSPECS arg (see ghc.lprl).
 585
 586 ToDo: Create single mkworld definition which is grabbed here and in ghc.lprl
 587
 588 \begin{code}
 589 pcGenerateSpecs :: Unique -> Id -> IdInfo -> Type -> SpecEnv
 590 pcGenerateSpecs key id info ty
 591   = nullSpecEnv
 592
 593 {- LATER:
 594
 595 pc_gen_specs True key id info ty
 596
 597 pc_gen_specs is_id key id info ty
 598  = mkSpecEnv spec_infos
 599  where
 600    spec_infos = [ let spec_ty = specialiseTy ty spec_tys 0
 601                       spec_id = if is_id
 602                                 then mkSpecId key {- HACK WARNING: same unique! -}
 603                                               id spec_tys spec_ty info
 604                                 else panic "SpecData:SpecInfo:SpecId"
 605                   in
 606                   SpecInfo spec_tys (length ctxts) spec_id
 607                 | spec_tys <- specialisations ]
 608
 609    (tyvars, ctxts, _) = splitSigmaTy ty
 610    no_tyvars          = length tyvars
 611
 612    specialisations    = if no_tyvars == 0
 613                         then []
 614                         else tail (cross_product no_tyvars specing_types)
 615
 616                         -- N.B. tail removes fully polymorphic specialisation
 617
 618 cross_product 0 tys = []
 619 cross_product 1 tys = map (:[]) tys
 620 cross_product n tys = concat [map (:cp) tys | cp <- cross_product (n-1) tys]
 621
 622
 623 specing_types = [Nothing,
 624                  Just charPrimTy,
 625                  Just doublePrimTy,
 626                  Just intPrimTy ]
 627 -}
 628 \end{code}