\section[PrelVals]{Prelude values the compiler ``knows about''}
\begin{code}
+module PrelVals where
+
#include "HsVersions.h"
-module PrelVals where
+import {-# SOURCE #-} CoreUnfold ( UnfoldingGuidance(..), mkUnfolding )
-IMP_Ubiq()
-IMPORT_DELOOPER(IdLoop) ( UnfoldingGuidance(..) )
-import Id ( Id(..), GenId, mkImported, mkUserId, mkTemplateLocals )
-IMPORT_DELOOPER(PrelLoop)
+import Id ( Id, mkImported, mkTemplateLocals )
+import SpecEnv ( SpecEnv, emptySpecEnv )
-- friends:
import PrelMods
import TysWiredIn
-- others:
-import CmdLineOpts ( maybe_CompilingPrelude )
+import CmdLineOpts ( maybe_CompilingGhcInternals )
import CoreSyn -- quite a bit
import IdInfo -- quite a bit
import Literal ( mkMachInt )
+import Name ( mkWiredInIdName, Module )
import PragmaInfo
import PrimOp ( PrimOp(..) )
-import SpecEnv ( SpecEnv(..), nullSpecEnv )
-import Type ( mkTyVarTy )
-import TyVar ( openAlphaTyVar, alphaTyVar, betaTyVar, gammaTyVar )
+import Type
+import TyVar ( openAlphaTyVar, alphaTyVar, betaTyVar, gammaTyVar, TyVar )
import Unique -- lots of *Keys
import Util ( panic )
\end{code}
-
-
-
\begin{code}
-- only used herein:
-pcMiscPrelId :: Unique{-IdKey-} -> FAST_STRING -> FAST_STRING -> Type -> IdInfo -> Id
-pcMiscPrelId key m n ty info
+mk_inline_unfolding = mkUnfolding IWantToBeINLINEd
+
+pcMiscPrelId :: Unique{-IdKey-} -> Module -> FAST_STRING -> Type -> IdInfo -> Id
+
+pcMiscPrelId key mod occ ty info
= let
- name = mkWiredInName key (OrigName m n)
+ name = mkWiredInIdName key mod occ imp
imp = mkImported name ty info -- the usual case...
in
imp
-- We lie and say the thing is imported; otherwise, we get into
-- a mess with dependency analysis; e.g., core2stg may heave in
- -- random calls to GHCbase.unpackPS. If GHCbase is the module
+ -- random calls to GHCbase.unpackPS__. If GHCbase is the module
-- being compiled, then it's just a matter of luck if the definition
-- will be in "the right place" to be in scope.
-{- ???
- case maybe_CompilingPrelude of
- Nothing -> imp
- Just modname ->
- if modname == _UNPK_ m -- we are compiling the module where this thing is defined...
- then mkUserId name ty NoPragmaInfo
- else imp
--}
\end{code}
%************************************************************************
pc_bottoming_Id key mod name ty
= pcMiscPrelId key mod name ty bottoming_info
where
- bottoming_info = noIdInfo `addInfo` mkBottomStrictnessInfo
+ bottoming_info = noIdInfo `addStrictnessInfo` mkBottomStrictnessInfo
-- these "bottom" out, no matter what their arguments
eRROR_ID
- = pc_bottoming_Id errorIdKey pRELUDE SLIT("error") errorTy
+ = pc_bottoming_Id errorIdKey pREL_ERR SLIT("error") errorTy
generic_ERROR_ID u n
- = pc_bottoming_Id u gHC__ n errorTy
+ = pc_bottoming_Id u pREL_ERR n errorTy
pAT_ERROR_ID
= generic_ERROR_ID patErrorIdKey SLIT("patError")
= generic_ERROR_ID irrefutPatErrorIdKey SLIT("irrefutPatError")
nON_EXHAUSTIVE_GUARDS_ERROR_ID
= generic_ERROR_ID nonExhaustiveGuardsErrorIdKey SLIT("nonExhaustiveGuardsError")
-nO_DEFAULT_METHOD_ERROR_ID
- = generic_ERROR_ID noDefaultMethodErrorIdKey SLIT("noDefaultMethodError")
-nO_EXPLICIT_METHOD_ERROR_ID
- = generic_ERROR_ID nonExplicitMethodErrorIdKey SLIT("noExplicitMethodError")
+nO_METHOD_BINDING_ERROR_ID
+ = generic_ERROR_ID noMethodBindingErrorIdKey SLIT("noMethodBindingError")
aBSENT_ERROR_ID
- = pc_bottoming_Id absentErrorIdKey gHC__ SLIT("absentErr")
- (mkSigmaTy [alphaTyVar] [] alphaTy)
+ = pc_bottoming_Id absentErrorIdKey pREL_ERR SLIT("absentErr")
+ (mkSigmaTy [openAlphaTyVar] [] openAlphaTy)
pAR_ERROR_ID
- = pcMiscPrelId parErrorIdKey gHC__ SLIT("parError")
- (mkSigmaTy [alphaTyVar] [] alphaTy) noIdInfo
+ = pcMiscPrelId parErrorIdKey pREL_ERR SLIT("parError")
+ (mkSigmaTy [openAlphaTyVar] [] openAlphaTy) noIdInfo
+
+openAlphaTy = mkTyVarTy openAlphaTyVar
errorTy :: Type
-errorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] (mkTyVarTy openAlphaTyVar))
+errorTy = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] openAlphaTy)
+ -- Notice the openAlphaTyVar. It says that "error" can be applied
+ -- to unboxed as well as boxed types. This is OK because it never
+ -- returns, so the return type is irrelevant.
\end{code}
-We want \tr{_trace} (NB: name not in user namespace) to be wired in
+We want \tr{GHCbase.trace} to be wired in
because we don't want the strictness analyser to get ahold of it,
decide that the second argument is strict, evaluate that first (!!),
-and make a jolly old mess. Having \tr{_trace} wired in also helps when
-attempting to re-export it---because it's in \tr{PreludeBuiltin}, it
-won't get an \tr{import} declaration in the interface file, so the
-importing-subsequently module needs to know it's magic.
+and make a jolly old mess.
\begin{code}
tRACE_ID
- = pcMiscPrelId traceIdKey gHC__ SLIT("trace") traceTy
- (noIdInfo `addInfo` pcGenerateSpecs traceIdKey tRACE_ID noIdInfo traceTy)
+ = pcMiscPrelId traceIdKey pREL_IO_BASE SLIT("trace") traceTy
+ (noIdInfo `addSpecInfo` pcGenerateSpecs traceIdKey tRACE_ID noIdInfo traceTy)
where
traceTy = mkSigmaTy [alphaTyVar] [] (mkFunTys [mkListTy charTy, alphaTy] alphaTy)
\end{code}
\begin{code}
packStringForCId
- = pcMiscPrelId packCStringIdKey{-ToDo:rename-} gHC__ SLIT("packStringForC")
+ = pcMiscPrelId packCStringIdKey{-ToDo:rename-} pREL_PACK SLIT("packCString#")
(mkFunTys [stringTy] byteArrayPrimTy) noIdInfo
--------------------------------------------------------------------
unpackCStringId
- = pcMiscPrelId unpackCStringIdKey gHC__ SLIT("unpackPS")
+ = pcMiscPrelId unpackCStringIdKey pREL_PACK SLIT("unpackCString#")
(mkFunTys [addrPrimTy{-a char *-}] stringTy) noIdInfo
-- Andy says:
--- (FunTy addrPrimTy{-a char *-} stringTy) (noIdInfo `addInfo` mkArityInfo 1)
+-- (FunTy addrPrimTy{-a char *-} stringTy) (noIdInfo `addInfo` exactArity 1)
-- but I don't like wired-in IdInfos (WDP)
unpackCString2Id -- for cases when a string has a NUL in it
- = pcMiscPrelId unpackCString2IdKey gHC__ SLIT("unpackPS2")
+ = pcMiscPrelId unpackCString2IdKey pREL_PACK SLIT("unpackNBytes#")
(mkFunTys [addrPrimTy{-a char *-}, intPrimTy{-length-}] stringTy)
noIdInfo
--------------------------------------------------------------------
unpackCStringAppendId
- = pcMiscPrelId unpackCStringAppendIdKey gHC__ SLIT("unpackAppendPS")
+ = pcMiscPrelId unpackCStringAppendIdKey pREL_PACK SLIT("unpackAppendCString#")
(mkFunTys [addrPrimTy{-a "char *" pointer-},stringTy] stringTy)
((noIdInfo
- {-LATER:`addInfo_UF` mkMagicUnfolding unpackCStringAppendIdKey-})
- `addInfo` mkArityInfo 2)
+ {-LATER:`addUnfoldInfo` mkMagicUnfolding unpackCStringAppendIdKey-})
+ `addArityInfo` exactArity 2)
unpackCStringFoldrId
- = pcMiscPrelId unpackCStringFoldrIdKey gHC__ SLIT("unpackFoldrPS")
+ = pcMiscPrelId unpackCStringFoldrIdKey pREL_PACK SLIT("unpackFoldrCString#")
(mkSigmaTy [alphaTyVar] []
(mkFunTys [addrPrimTy{-a "char *" pointer-},
mkFunTys [charTy, alphaTy] alphaTy,
alphaTy]
alphaTy))
((noIdInfo
- {-LATER:`addInfo_UF` mkMagicUnfolding unpackCStringFoldrIdKey-})
- `addInfo` mkArityInfo 3)
+ {-LATER:`addUnfoldInfo` mkMagicUnfolding unpackCStringFoldrIdKey-})
+ `addArityInfo` exactArity 3)
\end{code}
OK, this is Will's idea: we should have magic values for Integers 0,
+1, +2, and -1 (go ahead, fire me):
+
\begin{code}
integerZeroId
- = pcMiscPrelId integerZeroIdKey gHC__ SLIT("integer_0") integerTy noIdInfo
+ = pcMiscPrelId integerZeroIdKey pREL_NUM SLIT("integer_0") integerTy noIdInfo
integerPlusOneId
- = pcMiscPrelId integerPlusOneIdKey gHC__ SLIT("integer_1") integerTy noIdInfo
+ = pcMiscPrelId integerPlusOneIdKey pREL_NUM SLIT("integer_1") integerTy noIdInfo
integerPlusTwoId
- = pcMiscPrelId integerPlusTwoIdKey gHC__ SLIT("integer_2") integerTy noIdInfo
+ = pcMiscPrelId integerPlusTwoIdKey pREL_NUM SLIT("integer_2") integerTy noIdInfo
integerMinusOneId
- = pcMiscPrelId integerMinusOneIdKey gHC__ SLIT("integer_m1") integerTy noIdInfo
+ = pcMiscPrelId integerMinusOneIdKey pREL_NUM SLIT("integer_m1") integerTy noIdInfo
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
+{- OUT:
--------------------------------------------------------------------
-- seqId :: "seq", used w/ GRIP, etc., is really quite similar to
-- dangerousEval
-}
-seqId = pcMiscPrelId seqIdKey gHC__ SLIT("seq")
+seqId = pcMiscPrelId seqIdKey pRELUDE SLIT("seq")
(mkSigmaTy [alphaTyVar, betaTyVar] []
(mkFunTys [alphaTy, betaTy] betaTy))
- (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding seq_template))
+ (noIdInfo `addUnfoldInfo` (mk_inline_unfolding seq_template))
where
[x, y, z]
= mkTemplateLocals [
par = /\ a b -> \ x::a y::b -> case par# x of { 0# -> parError#; _ -> y; }
-}
-parId = pcMiscPrelId parIdKey gHC__ SLIT("par")
+parId = pcMiscPrelId parIdKey cONC_BASE SLIT("par")
(mkSigmaTy [alphaTyVar, betaTyVar] []
(mkFunTys [alphaTy, betaTy] betaTy))
- (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding par_template))
+ (noIdInfo `addUnfoldInfo` (mk_inline_unfolding par_template))
where
[x, y, z]
= mkTemplateLocals [
{-
_fork_ = /\ a b -> \ x::a y::b -> case fork# x of { 0# -> parError#; _ -> y; }
-}
-forkId = pcMiscPrelId forkIdKey gHC__ SLIT("fork")
+forkId = pcMiscPrelId forkIdKey cONC_BASE SLIT("fork")
(mkSigmaTy [alphaTyVar, betaTyVar] []
(mkFunTys [alphaTy, betaTy] betaTy))
- (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding fork_template))
+ (noIdInfo `addUnfoldInfo` (mk_inline_unfolding fork_template))
where
[x, y, z]
= mkTemplateLocals [
PrimAlts
[(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
(BindDefault z (Var y))))
-
+-}
\end{code}
GranSim ones:
\begin{code}
-parLocalId = pcMiscPrelId parLocalIdKey gHC__ SLIT("parLocal")
+{- OUT:
+parLocalId = pcMiscPrelId parLocalIdKey cONC_BASE SLIT("parLocal")
(mkSigmaTy [alphaTyVar, betaTyVar] []
(mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
- (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parLocal_template))
+ (noIdInfo `addUnfoldInfo` (mk_inline_unfolding parLocal_template))
where
-- Annotations: w: name, g: gran. info, s: size info, p: par info -- HWL
[w, g, s, p, x, y, z]
[(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
(BindDefault z (Var y))))
-parGlobalId = pcMiscPrelId parGlobalIdKey gHC__ SLIT("parGlobal")
+parGlobalId = pcMiscPrelId parGlobalIdKey cONC_BASE SLIT("parGlobal")
(mkSigmaTy [alphaTyVar, betaTyVar] []
(mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
- (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parGlobal_template))
+ (noIdInfo `addUnfoldInfo` (mk_inline_unfolding parGlobal_template))
where
-- Annotations: w: name, g: gran. info, s: size info, p: par info -- HWL
[w, g, s, p, x, y, z]
(BindDefault z (Var y))))
-parAtId = pcMiscPrelId parAtIdKey gHC__ SLIT("parAt")
+parAtId = pcMiscPrelId parAtIdKey cONC_BASE SLIT("parAt")
(mkSigmaTy [alphaTyVar, betaTyVar] []
(mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy,
alphaTy, betaTy, gammaTy] gammaTy))
- (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parAt_template))
+ (noIdInfo `addUnfoldInfo` (mk_inline_unfolding parAt_template))
where
-- Annotations: w: name, g: gran. info, s: size info, p: par info -- HWL
[w, g, s, p, v, x, y, z]
= mkLam [alphaTyVar, betaTyVar, gammaTyVar] [w, g, s, p, v, x, y] (
Case (Prim ParAtOp [TyArg alphaTy, TyArg betaTy, TyArg gammaTy, VarArg x, VarArg v, VarArg w, VarArg g, VarArg s, VarArg p, VarArg y]) (
PrimAlts
- [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
+ [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [gammaTy])]
(BindDefault z (Var y))))
-parAtAbsId = pcMiscPrelId parAtAbsIdKey gHC__ SLIT("parAtAbs")
+parAtAbsId = pcMiscPrelId parAtAbsIdKey cONC_BASE SLIT("parAtAbs")
(mkSigmaTy [alphaTyVar, betaTyVar] []
(mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
- (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parAtAbs_template))
+ (noIdInfo `addUnfoldInfo` (mk_inline_unfolding parAtAbs_template))
where
-- Annotations: w: name, g: gran. info, s: size info, p: par info -- HWL
[w, g, s, p, v, x, y, z]
[(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
(BindDefault z (Var y))))
-parAtRelId = pcMiscPrelId parAtRelIdKey gHC__ SLIT("parAtRel")
+parAtRelId = pcMiscPrelId parAtRelIdKey cONC_BASE SLIT("parAtRel")
(mkSigmaTy [alphaTyVar, betaTyVar] []
(mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
- (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parAtRel_template))
+ (noIdInfo `addUnfoldInfo` (mk_inline_unfolding parAtRel_template))
where
-- Annotations: w: name, g: gran. info, s: size info, p: par info -- HWL
[w, g, s, p, v, x, y, z]
[(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
(BindDefault z (Var y))))
-parAtForNowId = pcMiscPrelId parAtForNowIdKey gHC__ SLIT("parAtForNow")
+parAtForNowId = pcMiscPrelId parAtForNowIdKey cONC_BASE SLIT("parAtForNow")
(mkSigmaTy [alphaTyVar, betaTyVar] []
(mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy,
alphaTy, betaTy, gammaTy] gammaTy))
- (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parAtForNow_template))
+ (noIdInfo `addUnfoldInfo` (mk_inline_unfolding parAtForNow_template))
where
-- Annotations: w: name, g: gran. info, s: size info, p: par info -- HWL
[w, g, s, p, v, x, y, z]
= mkLam [alphaTyVar, betaTyVar, gammaTyVar] [w, g, s, p, v, x, y] (
Case (Prim ParAtForNowOp [TyArg alphaTy, TyArg betaTy, TyArg gammaTy, VarArg x, VarArg v, VarArg w, VarArg g, VarArg s, VarArg p, VarArg y]) (
PrimAlts
- [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
+ [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [gammaTy])]
(BindDefault z (Var y))))
-- copyable and noFollow are currently merely hooks: they are translated into
-- calls to the macros COPYABLE and NOFOLLOW -- HWL
-copyableId = pcMiscPrelId copyableIdKey gHC__ SLIT("copyable")
+copyableId = pcMiscPrelId copyableIdKey cONC_BASE SLIT("copyable")
(mkSigmaTy [alphaTyVar] []
alphaTy)
- (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding copyable_template))
+ (noIdInfo `addUnfoldInfo` (mk_inline_unfolding copyable_template))
where
-- Annotations: x: closure that's tagged to by copyable
[x, z]
copyable_template
= mkLam [alphaTyVar] [x] ( Prim CopyableOp [TyArg alphaTy, VarArg x] )
-noFollowId = pcMiscPrelId noFollowIdKey gHC__ SLIT("noFollow")
+noFollowId = pcMiscPrelId noFollowIdKey cONC_BASE SLIT("noFollow")
(mkSigmaTy [alphaTyVar] []
alphaTy)
- (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding noFollow_template))
+ (noIdInfo `addUnfoldInfo` (mk_inline_unfolding noFollow_template))
where
-- Annotations: x: closure that's tagged to not follow
[x, z]
noFollow_template
= mkLam [alphaTyVar] [x] ( Prim NoFollowOp [TyArg alphaTy, VarArg x] )
-\end{code}
-
-%************************************************************************
-%* *
-\subsection[PrelVals-deriving]{Values known about mainly for doing derived instance decls}
-%* *
-%************************************************************************
-
-map :: (a -> b) -> [a] -> [b]
- -- this is up in the here-because-of-unfolding list
-
---??showChar :: Char -> ShowS
-showSpace :: ShowS -- non-std: == "showChar ' '"
-showString :: String -> ShowS
-showParen :: Bool -> ShowS -> ShowS
-
-(++) :: [a] -> [a] -> [a]
-readParen :: Bool -> ReadS a -> ReadS a
-lex :: ReadS String
-
-%************************************************************************
-%* *
-\subsection[PrelVals-runST]{@_runST@: Magic start-state-transformer function}
-%* *
-%************************************************************************
-
-@_runST@ has a non-Haskell-able type:
-\begin{verbatim}
--- _runST :: forall a. (forall s. _ST s a) -> a
--- which is to say ::
--- forall a. (forall s. (_State s -> (a, _State s))) -> a
-
-_runST a m = case m _RealWorld (S# _RealWorld realWorld#) of
- (r :: a, wild :: _State _RealWorld) -> r
-\end{verbatim}
-We unfold always, just for simplicity:
-\begin{code}
-runSTId
- = pcMiscPrelId runSTIdKey gHC__ SLIT("runST") run_ST_ty id_info
- where
- s_tv = betaTyVar
- s = betaTy
-
- st_ty a = mkSigmaTy [s_tv] [] (mkStateTransformerTy s a)
-
- run_ST_ty
- = mkSigmaTy [alphaTyVar] [] (mkFunTys [st_ty alphaTy] alphaTy)
- -- NB: rank-2 polymorphism! (forall inside the st_ty...)
-
- id_info
- = noIdInfo
- `addInfo` mkArityInfo 1
- `addInfo` mkStrictnessInfo [WwStrict] Nothing
- `addInfo` mkArgUsageInfo [ArgUsage 1]
- -- ABSOLUTELY NO UNFOLDING, e.g.: (mkUnfolding EssentialUnfolding run_ST_template)
- -- see example below
-{- OUT:
- [m, t, r, wild]
- = mkTemplateLocals [
- {-m-} st_ty alphaTy,
- {-t-} realWorldStateTy,
- {-r-} alphaTy,
- {-_-} realWorldStateTy
- ]
-
- run_ST_template
- = mkLam [alphaTyVar] [m] (
- Let (NonRec t (Con stateDataCon [TyArg realWorldTy, VarArg realWorldPrimId])) (
- Case (App (mkTyApp (Var m) [realWorldTy]) (VarArg t)) (
- AlgAlts
- [(mkTupleCon 2, [r, wild], Var r)]
- NoDefault)))
-}
\end{code}
-SLPJ 95/04: Why @_runST@ must not have an unfolding; consider:
-\begin{verbatim}
-f x =
- _runST ( \ s -> let
- (a, s') = newArray# 100 [] s
- (_, s'') = fill_in_array_or_something a x s'
- in
- freezeArray# a s'' )
-\end{verbatim}
-If we inline @_runST@, we'll get:
-\begin{verbatim}
-f x = let
- (a, s') = newArray# 100 [] realWorld#{-NB-}
- (_, s'') = fill_in_array_or_something a x s'
- in
- freezeArray# a s''
-\end{verbatim}
-And now the @newArray#@ binding can be floated to become a CAF, which
-is totally and utterly wrong:
-\begin{verbatim}
-f = let
- (a, s') = newArray# 100 [] realWorld#{-NB-} -- YIKES!!!
- in
- \ x ->
- let (_, s'') = fill_in_array_or_something a x s' in
- freezeArray# a s''
-\end{verbatim}
-All calls to @f@ will share a {\em single} array! End SLPJ 95/04.
-
@realWorld#@ used to be a magic literal, \tr{void#}. If things get
nasty as-is, change it back to a literal (@Literal@).
\begin{code}
realWorldPrimId
- = pcMiscPrelId realWorldPrimIdKey gHC_BUILTINS SLIT("realWorld#")
+ = pcMiscPrelId realWorldPrimIdKey pREL_GHC SLIT("realWorld#")
realWorldStatePrimTy
noIdInfo
\end{code}
\begin{code}
-voidId = pcMiscPrelId voidIdKey gHC_BUILTINS SLIT("void") voidTy noIdInfo
+voidId = pc_bottoming_Id voidIdKey pREL_BASE SLIT("void") voidTy
\end{code}
%************************************************************************
\begin{code}
buildId
- = pcMiscPrelId buildIdKey gHC__ SLIT("build") buildTy
+ = pcMiscPrelId buildIdKey pREL_ERR SLIT("build") buildTy
((((noIdInfo
- {-LATER:`addInfo_UF` mkMagicUnfolding buildIdKey-})
- `addInfo` mkStrictnessInfo [WwStrict] Nothing)
- `addInfo` mkArgUsageInfo [ArgUsage 2])
- `addInfo` pcGenerateSpecs buildIdKey buildId noIdInfo{-ToDo-} buildTy)
+ {-LATER:`addUnfoldInfo` mkMagicUnfolding buildIdKey-})
+ `addStrictnessInfo` mkStrictnessInfo [WwStrict] False)
+ `addArgUsageInfo` mkArgUsageInfo [ArgUsage 2])
+ `addSpecInfo` pcGenerateSpecs buildIdKey buildId noIdInfo{-ToDo-} buildTy)
-- cheating, but since _build never actually exists ...
where
-- The type of this strange object is:
\begin{code}
augmentId
- = pcMiscPrelId augmentIdKey gHC__ SLIT("augment") augmentTy
+ = pcMiscPrelId augmentIdKey pREL_ERR SLIT("augment") augmentTy
(((noIdInfo
- {-LATER:`addInfo_UF` mkMagicUnfolding augmentIdKey-})
- `addInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
- `addInfo` mkArgUsageInfo [ArgUsage 2,UnknownArgUsage])
+ {-LATER:`addUnfoldInfo` mkMagicUnfolding augmentIdKey-})
+ `addStrictnessInfo` mkStrictnessInfo [WwStrict,WwLazy False] False)
+ `addArgUsageInfo` mkArgUsageInfo [ArgUsage 2,UnknownArgUsage])
-- cheating, but since _augment never actually exists ...
where
-- The type of this strange object is:
\end{code}
\begin{code}
-foldrId = pcMiscPrelId foldrIdKey pRELUDE SLIT("foldr")
+foldrId = pcMiscPrelId foldrIdKey pREL_BASE SLIT("foldr")
foldrTy idInfo
where
foldrTy =
(mkFunTys [mkFunTys [alphaTy, betaTy] betaTy, betaTy, mkListTy alphaTy] betaTy)
idInfo = (((((noIdInfo
- {-LATER:`addInfo_UF` mkMagicUnfolding foldrIdKey-})
- `addInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
- `addInfo` mkArityInfo 3)
- `addInfo` mkUpdateInfo [2,2,1])
- `addInfo` pcGenerateSpecs foldrIdKey foldrId noIdInfo{-ToDo-} foldrTy)
+ {-LATER:`addUnfoldInfo` mkMagicUnfolding foldrIdKey-})
+ `addStrictnessInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] False)
+ `addArityInfo` exactArity 3)
+ `addUpdateInfo` mkUpdateInfo [2,2,1])
+ `addSpecInfo` pcGenerateSpecs foldrIdKey foldrId noIdInfo{-ToDo-} foldrTy)
-foldlId = pcMiscPrelId foldlIdKey pRELUDE SLIT("foldl")
+foldlId = pcMiscPrelId foldlIdKey pREL_LIST SLIT("foldl")
foldlTy idInfo
where
foldlTy =
(mkFunTys [mkFunTys [alphaTy, betaTy] alphaTy, alphaTy, mkListTy betaTy] alphaTy)
idInfo = (((((noIdInfo
- {-LATER:`addInfo_UF` mkMagicUnfolding foldlIdKey-})
- `addInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
- `addInfo` mkArityInfo 3)
- `addInfo` mkUpdateInfo [2,2,1])
- `addInfo` pcGenerateSpecs foldlIdKey foldlId noIdInfo{-ToDo-} foldlTy)
+ {-LATER:`addUnfoldInfo` mkMagicUnfolding foldlIdKey-})
+ `addStrictnessInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] False)
+ `addArityInfo` exactArity 3)
+ `addUpdateInfo` mkUpdateInfo [2,2,1])
+ `addSpecInfo` pcGenerateSpecs foldlIdKey foldlId noIdInfo{-ToDo-} foldlTy)
-- A bit of magic goes no here. We translate appendId into ++,
-- you have to be carefull when you actually compile append:
--
{- OLD: doesn't apply with 1.3
appendId
- = pcMiscPrelId appendIdKey pRELUDE_LIST SLIT("++") appendTy idInfo
+ = pcMiscPrelId appendIdKey mONAD SLIT("++") appendTy idInfo
where
appendTy =
(mkSigmaTy [alphaTyVar] []
(mkFunTys [mkListTy alphaTy, mkListTy alphaTy] (mkListTy alphaTy)))
idInfo = (((noIdInfo
- `addInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
- `addInfo` mkArityInfo 2)
- `addInfo` mkUpdateInfo [1,2])
+ `addStrictnessInfo` mkStrictnessInfo [WwStrict,WwLazy False] False)
+ `addArityInfo` exactArity 2)
+ `addUpdateInfo` mkUpdateInfo [1,2])
-}
\end{code}
ToDo: Create single mkworld definition which is grabbed here and in ghc.lprl
\begin{code}
-pcGenerateSpecs :: Unique -> Id -> IdInfo -> Type -> SpecEnv
+pcGenerateSpecs :: Unique -> Id -> IdInfo -> Type -> IdSpecEnv
pcGenerateSpecs key id info ty
- = nullSpecEnv
+ = emptySpecEnv
{- LATER:
projects / ghc-hetmet.git / blobdiff