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