2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[PrelVals]{Prelude values the compiler ``knows about''}
7 #include "HsVersions.h"
12 IMPORT_DELOOPER(IdLoop) ( UnfoldingGuidance(..) )
13 import Id ( Id(..), GenId, mkImported, mkUserId, mkTemplateLocals )
14 IMPORT_DELOOPER(PrelLoop)
22 import CmdLineOpts ( maybe_CompilingPrelude )
23 import CoreSyn -- quite a bit
24 import IdInfo -- quite a bit
25 import Literal ( mkMachInt )
27 import PrimOp ( PrimOp(..) )
28 import SpecEnv ( SpecEnv(..), nullSpecEnv )
29 import Type ( mkTyVarTy )
30 import TyVar ( openAlphaTyVar, alphaTyVar, betaTyVar, gammaTyVar )
31 import Unique -- lots of *Keys
40 pcMiscPrelId :: Unique{-IdKey-} -> FAST_STRING -> FAST_STRING -> Type -> IdInfo -> Id
42 pcMiscPrelId key m n ty info
44 name = mkWiredInName key (OrigName m n)
45 imp = mkImported name ty info -- the usual case...
48 -- We lie and say the thing is imported; otherwise, we get into
49 -- a mess with dependency analysis; e.g., core2stg may heave in
50 -- random calls to GHCbase.unpackPS. If GHCbase is the module
51 -- being compiled, then it's just a matter of luck if the definition
52 -- will be in "the right place" to be in scope.
54 case maybe_CompilingPrelude of
57 if modname == _UNPK_ m -- we are compiling the module where this thing is defined...
58 then mkUserId name ty NoPragmaInfo
63 %************************************************************************
65 \subsection[PrelVals-error-related]{@error@ and friends; @trace@}
67 %************************************************************************
69 GHC randomly injects these into the code.
71 @patError@ is just a version of @error@ for pattern-matching
72 failures. It knows various ``codes'' which expand to longer
73 strings---this saves space!
75 @absentErr@ is a thing we put in for ``absent'' arguments. They jolly
76 well shouldn't be yanked on, but if one is, then you will get a
77 friendly message from @absentErr@ (rather a totally random crash).
79 @parError@ is a special version of @error@ which the compiler does
80 not know to be a bottoming Id. It is used in the @_par_@ and @_seq_@
81 templates, but we don't ever expect to generate code for it.
84 pc_bottoming_Id key mod name ty
85 = pcMiscPrelId key mod name ty bottoming_info
87 bottoming_info = noIdInfo `addInfo` mkBottomStrictnessInfo
88 -- these "bottom" out, no matter what their arguments
91 = pc_bottoming_Id errorIdKey pRELUDE SLIT("error") errorTy
94 = pc_bottoming_Id u gHC__ n errorTy
97 = generic_ERROR_ID patErrorIdKey SLIT("patError")
99 = generic_ERROR_ID recConErrorIdKey SLIT("recConError")
101 = generic_ERROR_ID recUpdErrorIdKey SLIT("recUpdError")
103 = generic_ERROR_ID irrefutPatErrorIdKey SLIT("irrefutPatError")
104 nON_EXHAUSTIVE_GUARDS_ERROR_ID
105 = generic_ERROR_ID nonExhaustiveGuardsErrorIdKey SLIT("nonExhaustiveGuardsError")
106 nO_DEFAULT_METHOD_ERROR_ID
107 = generic_ERROR_ID noDefaultMethodErrorIdKey SLIT("noDefaultMethodError")
108 nO_EXPLICIT_METHOD_ERROR_ID
109 = generic_ERROR_ID nonExplicitMethodErrorIdKey SLIT("noExplicitMethodError")
112 = pc_bottoming_Id absentErrorIdKey gHC__ SLIT("absentErr")
113 (mkSigmaTy [alphaTyVar] [] alphaTy)
116 = pcMiscPrelId parErrorIdKey gHC__ SLIT("parError")
117 (mkSigmaTy [alphaTyVar] [] alphaTy) noIdInfo
120 errorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] (mkTyVarTy openAlphaTyVar))
123 We want \tr{_trace} (NB: name not in user namespace) to be wired in
124 because we don't want the strictness analyser to get ahold of it,
125 decide that the second argument is strict, evaluate that first (!!),
126 and make a jolly old mess. Having \tr{_trace} wired in also helps when
127 attempting to re-export it---because it's in \tr{PreludeBuiltin}, it
128 won't get an \tr{import} declaration in the interface file, so the
129 importing-subsequently module needs to know it's magic.
132 = pcMiscPrelId traceIdKey gHC__ SLIT("trace") traceTy
133 (noIdInfo `addInfo` pcGenerateSpecs traceIdKey tRACE_ID noIdInfo traceTy)
135 traceTy = mkSigmaTy [alphaTyVar] [] (mkFunTys [mkListTy charTy, alphaTy] alphaTy)
138 %************************************************************************
140 \subsection[PrelVals-Integer-support]{To support @Integer@ and @String@ literals}
142 %************************************************************************
146 = pcMiscPrelId packCStringIdKey{-ToDo:rename-} gHC__ SLIT("packStringForC")
147 (mkFunTys [stringTy] byteArrayPrimTy) noIdInfo
149 --------------------------------------------------------------------
152 = pcMiscPrelId unpackCStringIdKey gHC__ SLIT("unpackPS")
153 (mkFunTys [addrPrimTy{-a char *-}] stringTy) noIdInfo
155 -- (FunTy addrPrimTy{-a char *-} stringTy) (noIdInfo `addInfo` mkArityInfo 1)
156 -- but I don't like wired-in IdInfos (WDP)
158 unpackCString2Id -- for cases when a string has a NUL in it
159 = pcMiscPrelId unpackCString2IdKey gHC__ SLIT("unpackPS2")
160 (mkFunTys [addrPrimTy{-a char *-}, intPrimTy{-length-}] stringTy)
163 --------------------------------------------------------------------
164 unpackCStringAppendId
165 = pcMiscPrelId unpackCStringAppendIdKey gHC__ SLIT("unpackAppendPS")
166 (mkFunTys [addrPrimTy{-a "char *" pointer-},stringTy] stringTy)
168 {-LATER:`addInfo_UF` mkMagicUnfolding unpackCStringAppendIdKey-})
169 `addInfo` mkArityInfo 2)
172 = pcMiscPrelId unpackCStringFoldrIdKey gHC__ SLIT("unpackFoldrPS")
173 (mkSigmaTy [alphaTyVar] []
174 (mkFunTys [addrPrimTy{-a "char *" pointer-},
175 mkFunTys [charTy, alphaTy] alphaTy,
179 {-LATER:`addInfo_UF` mkMagicUnfolding unpackCStringFoldrIdKey-})
180 `addInfo` mkArityInfo 3)
183 OK, this is Will's idea: we should have magic values for Integers 0,
184 +1, +2, and -1 (go ahead, fire me):
187 = pcMiscPrelId integerZeroIdKey gHC__ SLIT("integer_0") integerTy noIdInfo
189 = pcMiscPrelId integerPlusOneIdKey gHC__ SLIT("integer_1") integerTy noIdInfo
191 = pcMiscPrelId integerPlusTwoIdKey gHC__ SLIT("integer_2") integerTy noIdInfo
193 = pcMiscPrelId integerMinusOneIdKey gHC__ SLIT("integer_m1") integerTy noIdInfo
196 %************************************************************************
198 \subsection[PrelVals-parallel]{@seq@ and @par@: for parallel operation (only)}
200 %************************************************************************
203 --------------------------------------------------------------------
204 -- seqId :: "seq", used w/ GRIP, etc., is really quite similar to
208 seq = /\ a b -> \ x y -> case x of { _ -> y }
211 seq = /\ a b -> \ x y -> case seq# x y of { _Lift y' -> y' }
214 seq = /\ a b -> \ x::a y::b -> case seq# x of { 0# -> parError#; _ -> y; }
218 seqId = pcMiscPrelId seqIdKey gHC__ SLIT("seq")
219 (mkSigmaTy [alphaTyVar, betaTyVar] []
220 (mkFunTys [alphaTy, betaTy] betaTy))
221 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding seq_template))
231 = mkLam [alphaTyVar, betaTyVar] [x, y] (
232 Case (Prim SeqOp [TyArg alphaTy, VarArg x]) (
234 [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
235 (BindDefault z (Var y))))
237 --------------------------------------------------------------------
238 -- parId :: "par", also used w/ GRIP, etc.
242 par = /\ a b -> \ x y -> case (par# (case x of { _ -> () })) of { _ -> y }
246 par = /\ a b -> \ x y -> case par# x y of { _Lift y' -> y' }
250 par = /\ a b -> \ x::a y::b -> case par# x of { 0# -> parError#; _ -> y; }
253 parId = pcMiscPrelId parIdKey gHC__ SLIT("par")
254 (mkSigmaTy [alphaTyVar, betaTyVar] []
255 (mkFunTys [alphaTy, betaTy] betaTy))
256 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding par_template))
266 = mkLam [alphaTyVar, betaTyVar] [x, y] (
267 Case (Prim ParOp [TyArg alphaTy, VarArg x]) (
269 [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
270 (BindDefault z (Var y))))
272 -- forkId :: "fork", for *required* concurrent threads
274 _fork_ = /\ a b -> \ x::a y::b -> case fork# x of { 0# -> parError#; _ -> y; }
276 forkId = pcMiscPrelId forkIdKey gHC__ SLIT("fork")
277 (mkSigmaTy [alphaTyVar, betaTyVar] []
278 (mkFunTys [alphaTy, betaTy] betaTy))
279 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding fork_template))
289 = mkLam [alphaTyVar, betaTyVar] [x, y] (
290 Case (Prim ForkOp [TyArg alphaTy, VarArg x]) (
292 [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
293 (BindDefault z (Var y))))
299 parLocalId = pcMiscPrelId parLocalIdKey gHC__ SLIT("parLocal")
300 (mkSigmaTy [alphaTyVar, betaTyVar] []
301 (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
302 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parLocal_template))
304 -- Annotations: w: name, g: gran. info, s: size info, p: par info -- HWL
305 [w, g, s, p, x, y, z]
317 = mkLam [alphaTyVar, betaTyVar] [w, g, s, p, x, y] (
318 Case (Prim ParLocalOp [TyArg alphaTy, TyArg betaTy, VarArg x, VarArg w, VarArg g, VarArg s, VarArg p, VarArg y]) (
320 [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
321 (BindDefault z (Var y))))
323 parGlobalId = pcMiscPrelId parGlobalIdKey gHC__ SLIT("parGlobal")
324 (mkSigmaTy [alphaTyVar, betaTyVar] []
325 (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
326 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parGlobal_template))
328 -- Annotations: w: name, g: gran. info, s: size info, p: par info -- HWL
329 [w, g, s, p, x, y, z]
341 = mkLam [alphaTyVar, betaTyVar] [w, g, s, p, x, y] (
342 Case (Prim ParGlobalOp [TyArg alphaTy, TyArg betaTy, VarArg x, VarArg w, VarArg g, VarArg s, VarArg p, VarArg y]) (
344 [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
345 (BindDefault z (Var y))))
348 parAtId = pcMiscPrelId parAtIdKey gHC__ SLIT("parAt")
349 (mkSigmaTy [alphaTyVar, betaTyVar] []
350 (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy,
351 alphaTy, betaTy, gammaTy] gammaTy))
352 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parAt_template))
354 -- Annotations: w: name, g: gran. info, s: size info, p: par info -- HWL
355 [w, g, s, p, v, x, y, z]
368 = mkLam [alphaTyVar, betaTyVar, gammaTyVar] [w, g, s, p, v, x, y] (
369 Case (Prim ParAtOp [TyArg alphaTy, TyArg betaTy, TyArg gammaTy, VarArg x, VarArg v, VarArg w, VarArg g, VarArg s, VarArg p, VarArg y]) (
371 [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
372 (BindDefault z (Var y))))
374 parAtAbsId = pcMiscPrelId parAtAbsIdKey gHC__ SLIT("parAtAbs")
375 (mkSigmaTy [alphaTyVar, betaTyVar] []
376 (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
377 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parAtAbs_template))
379 -- Annotations: w: name, g: gran. info, s: size info, p: par info -- HWL
380 [w, g, s, p, v, x, y, z]
393 = mkLam [alphaTyVar, betaTyVar] [w, g, s, p, v, x, y] (
394 Case (Prim ParAtAbsOp [TyArg alphaTy, TyArg betaTy, VarArg x, VarArg v, VarArg w, VarArg g, VarArg s, VarArg p, VarArg y]) (
396 [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
397 (BindDefault z (Var y))))
399 parAtRelId = pcMiscPrelId parAtRelIdKey gHC__ SLIT("parAtRel")
400 (mkSigmaTy [alphaTyVar, betaTyVar] []
401 (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
402 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parAtRel_template))
404 -- Annotations: w: name, g: gran. info, s: size info, p: par info -- HWL
405 [w, g, s, p, v, x, y, z]
418 = mkLam [alphaTyVar, betaTyVar] [w, g, s, p, v, x, y] (
419 Case (Prim ParAtRelOp [TyArg alphaTy, TyArg betaTy, VarArg x, VarArg v, VarArg w, VarArg g, VarArg s, VarArg p, VarArg y]) (
421 [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
422 (BindDefault z (Var y))))
424 parAtForNowId = pcMiscPrelId parAtForNowIdKey gHC__ SLIT("parAtForNow")
425 (mkSigmaTy [alphaTyVar, betaTyVar] []
426 (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy,
427 alphaTy, betaTy, gammaTy] gammaTy))
428 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parAtForNow_template))
430 -- Annotations: w: name, g: gran. info, s: size info, p: par info -- HWL
431 [w, g, s, p, v, x, y, z]
444 = mkLam [alphaTyVar, betaTyVar, gammaTyVar] [w, g, s, p, v, x, y] (
445 Case (Prim ParAtForNowOp [TyArg alphaTy, TyArg betaTy, TyArg gammaTy, VarArg x, VarArg v, VarArg w, VarArg g, VarArg s, VarArg p, VarArg y]) (
447 [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
448 (BindDefault z (Var y))))
450 -- copyable and noFollow are currently merely hooks: they are translated into
451 -- calls to the macros COPYABLE and NOFOLLOW -- HWL
453 copyableId = pcMiscPrelId copyableIdKey gHC__ SLIT("copyable")
454 (mkSigmaTy [alphaTyVar] []
456 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding copyable_template))
458 -- Annotations: x: closure that's tagged to by copyable
466 = mkLam [alphaTyVar] [x] ( Prim CopyableOp [TyArg alphaTy, VarArg x] )
468 noFollowId = pcMiscPrelId noFollowIdKey gHC__ SLIT("noFollow")
469 (mkSigmaTy [alphaTyVar] []
471 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding noFollow_template))
473 -- Annotations: x: closure that's tagged to not follow
481 = mkLam [alphaTyVar] [x] ( Prim NoFollowOp [TyArg alphaTy, VarArg x] )
484 %************************************************************************
486 \subsection[PrelVals-deriving]{Values known about mainly for doing derived instance decls}
488 %************************************************************************
490 map :: (a -> b) -> [a] -> [b]
491 -- this is up in the here-because-of-unfolding list
493 --??showChar :: Char -> ShowS
494 showSpace :: ShowS -- non-std: == "showChar ' '"
495 showString :: String -> ShowS
496 showParen :: Bool -> ShowS -> ShowS
498 (++) :: [a] -> [a] -> [a]
499 readParen :: Bool -> ReadS a -> ReadS a
502 %************************************************************************
504 \subsection[PrelVals-runST]{@_runST@: Magic start-state-transformer function}
506 %************************************************************************
508 @_runST@ has a non-Haskell-able type:
510 -- _runST :: forall a. (forall s. _ST s a) -> a
511 -- which is to say ::
512 -- forall a. (forall s. (_State s -> (a, _State s))) -> a
514 _runST a m = case m _RealWorld (S# _RealWorld realWorld#) of
515 (r :: a, wild :: _State _RealWorld) -> r
517 We unfold always, just for simplicity:
520 = pcMiscPrelId runSTIdKey gHC__ SLIT("runST") run_ST_ty id_info
525 st_ty a = mkSigmaTy [s_tv] [] (mkStateTransformerTy s a)
528 = mkSigmaTy [alphaTyVar] [] (mkFunTys [st_ty alphaTy] alphaTy)
529 -- NB: rank-2 polymorphism! (forall inside the st_ty...)
533 `addInfo` mkArityInfo 1
534 `addInfo` mkStrictnessInfo [WwStrict] Nothing
535 `addInfo` mkArgUsageInfo [ArgUsage 1]
536 -- ABSOLUTELY NO UNFOLDING, e.g.: (mkUnfolding EssentialUnfolding run_ST_template)
542 {-t-} realWorldStateTy,
544 {-_-} realWorldStateTy
548 = mkLam [alphaTyVar] [m] (
549 Let (NonRec t (Con stateDataCon [TyArg realWorldTy, VarArg realWorldPrimId])) (
550 Case (App (mkTyApp (Var m) [realWorldTy]) (VarArg t)) (
552 [(mkTupleCon 2, [r, wild], Var r)]
557 SLPJ 95/04: Why @_runST@ must not have an unfolding; consider:
561 (a, s') = newArray# 100 [] s
562 (_, s'') = fill_in_array_or_something a x s'
566 If we inline @_runST@, we'll get:
569 (a, s') = newArray# 100 [] realWorld#{-NB-}
570 (_, s'') = fill_in_array_or_something a x s'
574 And now the @newArray#@ binding can be floated to become a CAF, which
575 is totally and utterly wrong:
578 (a, s') = newArray# 100 [] realWorld#{-NB-} -- YIKES!!!
581 let (_, s'') = fill_in_array_or_something a x s' in
584 All calls to @f@ will share a {\em single} array! End SLPJ 95/04.
586 @realWorld#@ used to be a magic literal, \tr{void#}. If things get
587 nasty as-is, change it back to a literal (@Literal@).
590 = pcMiscPrelId realWorldPrimIdKey gHC_BUILTINS SLIT("realWorld#")
596 voidId = pcMiscPrelId voidIdKey gHC_BUILTINS SLIT("void") voidTy noIdInfo
599 %************************************************************************
601 \subsection[PrelVals-foldr-build]{Values known about for ``foldr/build''}
603 %************************************************************************
607 = pcMiscPrelId buildIdKey gHC__ SLIT("build") buildTy
609 {-LATER:`addInfo_UF` mkMagicUnfolding buildIdKey-})
610 `addInfo` mkStrictnessInfo [WwStrict] Nothing)
611 `addInfo` mkArgUsageInfo [ArgUsage 2])
612 `addInfo` pcGenerateSpecs buildIdKey buildId noIdInfo{-ToDo-} buildTy)
613 -- cheating, but since _build never actually exists ...
615 -- The type of this strange object is:
616 -- \/ a . (\/ b . (a -> b -> b) -> b -> b) -> [a]
618 buildTy = mkSigmaTy [alphaTyVar] [] (mkFunTys [build_ty] (mkListTy alphaTy))
620 build_ty = mkSigmaTy [betaTyVar] []
621 (mkFunTys [mkFunTys [alphaTy, betaTy] betaTy, betaTy] betaTy)
624 @mkBuild@ is sugar for building a build!
626 @mkbuild ty tv c n e@ $Rightarrow$ @build ty (/\ tv -> \ c n -> e)@
627 @ty@ is the type of the list.
628 @tv@ is always a new type variable.
629 @c,n@ are Id's for the abstract cons and nil, @g@ for let binding the argument argument.
632 v :: (\/ b . (a -> b -> b) -> b -> b) -> [a]
633 -- \/ a . (\/ b . (a -> b -> b) -> b -> b) -> [a]
634 @e@ is the object right inside the @build@
642 -> CoreExpr -- template
643 -> CoreExpr -- template
645 mkBuild ty tv c n g expr
646 = Let (NonRec g (mkLam [tv] [c,n] expr))
647 (App (mkTyApp (Var buildId) [ty]) (VarArg g))
652 = pcMiscPrelId augmentIdKey gHC__ SLIT("augment") augmentTy
654 {-LATER:`addInfo_UF` mkMagicUnfolding augmentIdKey-})
655 `addInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
656 `addInfo` mkArgUsageInfo [ArgUsage 2,UnknownArgUsage])
657 -- cheating, but since _augment never actually exists ...
659 -- The type of this strange object is:
660 -- \/ a . (\/ b . (a -> b -> b) -> b -> b) -> [a] -> [a]
662 augmentTy = mkSigmaTy [alphaTyVar] [] (mkFunTys [aug_ty, mkListTy alphaTy] (mkListTy alphaTy))
664 aug_ty = mkSigmaTy [betaTyVar] []
665 (mkFunTys [mkFunTys [alphaTy, betaTy] betaTy, betaTy] betaTy)
669 foldrId = pcMiscPrelId foldrIdKey pRELUDE SLIT("foldr")
673 mkSigmaTy [alphaTyVar, betaTyVar] []
674 (mkFunTys [mkFunTys [alphaTy, betaTy] betaTy, betaTy, mkListTy alphaTy] betaTy)
676 idInfo = (((((noIdInfo
677 {-LATER:`addInfo_UF` mkMagicUnfolding foldrIdKey-})
678 `addInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
679 `addInfo` mkArityInfo 3)
680 `addInfo` mkUpdateInfo [2,2,1])
681 `addInfo` pcGenerateSpecs foldrIdKey foldrId noIdInfo{-ToDo-} foldrTy)
683 foldlId = pcMiscPrelId foldlIdKey pRELUDE SLIT("foldl")
687 mkSigmaTy [alphaTyVar, betaTyVar] []
688 (mkFunTys [mkFunTys [alphaTy, betaTy] alphaTy, alphaTy, mkListTy betaTy] alphaTy)
690 idInfo = (((((noIdInfo
691 {-LATER:`addInfo_UF` mkMagicUnfolding foldlIdKey-})
692 `addInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
693 `addInfo` mkArityInfo 3)
694 `addInfo` mkUpdateInfo [2,2,1])
695 `addInfo` pcGenerateSpecs foldlIdKey foldlId noIdInfo{-ToDo-} foldlTy)
697 -- A bit of magic goes no here. We translate appendId into ++,
698 -- you have to be carefull when you actually compile append:
699 -- xs ++ ys = augment (\ c n -> foldr c n xs) ys
700 -- {- unfold augment -}
702 -- {- fold foldr to append -}
703 -- = ys `appendId` xs
704 -- = ys ++ xs -- ugg!
705 -- *BUT* you want (++) and not _append in your interfaces.
707 -- So you have to turn *off* unfolding of foldr inside FoldrBuild.hs inside
710 {- OLD: doesn't apply with 1.3
712 = pcMiscPrelId appendIdKey pRELUDE_LIST SLIT("++") appendTy idInfo
715 (mkSigmaTy [alphaTyVar] []
716 (mkFunTys [mkListTy alphaTy, mkListTy alphaTy] (mkListTy alphaTy)))
718 `addInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
719 `addInfo` mkArityInfo 2)
720 `addInfo` mkUpdateInfo [1,2])
724 %************************************************************************
726 \subsection[PrelUtils-specialisations]{Specialisations for builtin values}
728 %************************************************************************
730 The specialisations which exist for the builtin values must be recorded in
733 NOTE: THE USES OF THE pcGenerate... FUNCTIONS MUST CORRESPOND
734 TO THE SPECIALISATIONS DECLARED IN THE PRELUDE !!!
736 HACK: We currently use the same unique for the specialised Ids.
738 The list @specing_types@ determines the types for which specialised
739 versions are created. Note: This should correspond with the
740 types passed to the pre-processor with the -genSPECS arg (see ghc.lprl).
742 ToDo: Create single mkworld definition which is grabbed here and in ghc.lprl
745 pcGenerateSpecs :: Unique -> Id -> IdInfo -> Type -> SpecEnv
746 pcGenerateSpecs key id info ty
751 pc_gen_specs True key id info ty
753 pc_gen_specs is_id key id info ty
754 = mkSpecEnv spec_infos
756 spec_infos = [ let spec_ty = specialiseTy ty spec_tys 0
758 then mkSpecId key {- HACK WARNING: same unique! -}
759 id spec_tys spec_ty info
760 else panic "SpecData:SpecInfo:SpecId"
762 SpecInfo spec_tys (length ctxts) spec_id
763 | spec_tys <- specialisations ]
765 (tyvars, ctxts, _) = splitSigmaTy ty
766 no_tyvars = length tyvars
768 specialisations = if no_tyvars == 0
770 else tail (cross_product no_tyvars specing_types)
772 -- N.B. tail removes fully polymorphic specialisation
774 cross_product 0 tys = []
775 cross_product 1 tys = map (:[]) tys
776 cross_product n tys = concat [map (:cp) tys | cp <- cross_product (n-1) tys]
779 specing_types = [Nothing,