projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 1996-07-19 18:36:04 by partain]
[ghc-hetmet.git] / ghc / compiler / prelude / PrelVals.lhs
diff --git a/ghc/compiler/prelude/PrelVals.lhs b/ghc/compiler/prelude/PrelVals.lhs
index 5c5375a..37d6f6b 100644 (file)
--- a/ghc/compiler/prelude/PrelVals.lhs
+++ b/ghc/compiler/prelude/PrelVals.lhs
@@ -8,10 +8,10 @@
 
 module PrelVals where
 
 
 module PrelVals where
 
-import Ubiq
-import IdLoop          ( UnfoldingGuidance(..) )
-import Id              ( Id(..), GenId, mkPreludeId, mkTemplateLocals )
-import PrelLoop
+IMP_Ubiq()
+IMPORT_DELOOPER(IdLoop)                ( UnfoldingGuidance(..), nullSpecEnv, SpecEnv )
+import Id              ( SYN_IE(Id), GenId, mkImported, mkUserId, mkTemplateLocals )
+IMPORT_DELOOPER(PrelLoop)
 
 -- friends:
 import PrelMods
 
 -- friends:
 import PrelMods
@@ -19,25 +19,34 @@ import TysPrim
 import TysWiredIn
 
 -- others:
 import TysWiredIn
 
 -- others:
+import CmdLineOpts     ( maybe_CompilingGhcInternals )
 import CoreSyn         -- quite a bit
 import IdInfo          -- quite a bit
 import Literal         ( mkMachInt )
 import CoreSyn         -- quite a bit
 import IdInfo          -- quite a bit
 import Literal         ( mkMachInt )
+import Name            ( ExportFlag(..) )
+import PragmaInfo
 import PrimOp          ( PrimOp(..) )
 import PrimOp          ( PrimOp(..) )
-import SpecEnv         ( SpecEnv(..), nullSpecEnv )
-import TyVar           ( alphaTyVar, betaTyVar )
+import Type            ( mkTyVarTy )
+import TyVar           ( openAlphaTyVar, alphaTyVar, betaTyVar, gammaTyVar )
 import Unique          -- lots of *Keys
 import Util            ( panic )
 \end{code}
 
 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
 
 \begin{code}
 -- only used herein:
 pcMiscPrelId :: Unique{-IdKey-} -> FAST_STRING -> FAST_STRING -> Type -> IdInfo -> Id
 
-pcMiscPrelId key mod name ty info
- = mkPreludeId (mkBuiltinName key mod name) ty info
+pcMiscPrelId key m n ty info
+  = let
+       name = mkWiredInName key (OrigName m n) ExportAll
+       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
+    -- being compiled, then it's just a matter of luck if the definition
+    -- will be in "the right place" to be in scope.
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -48,15 +57,15 @@ pcMiscPrelId key mod name ty info
 
 GHC randomly injects these into the code.
 
 
 GHC randomly injects these into the code.
 
-@patError#@ is just a version of @error@ for pattern-matching
+@patError@ is just a version of @error@ for pattern-matching
 failures.  It knows various ``codes'' which expand to longer
 strings---this saves space!
 
 failures.  It knows various ``codes'' which expand to longer
 strings---this saves space!
 
-@absent#@ is a thing we put in for ``absent'' arguments.  They jolly
+@absentErr@ is a thing we put in for ``absent'' arguments.  They jolly
 well shouldn't be yanked on, but if one is, then you will get a
 well shouldn't be yanked on, but if one is, then you will get a
-friendly message from @absent#@ (rather a totally random crash).
+friendly message from @absentErr@ (rather a totally random crash).
 
 
-@parError#@ is a special version of @error@ which the compiler does
+@parError@ is a special version of @error@ which the compiler does
 not know to be a bottoming Id.  It is used in the @_par_@ and @_seq_@
 templates, but we don't ever expect to generate code for it.
 
 not know to be a bottoming Id.  It is used in the @_par_@ and @_seq_@
 templates, but we don't ever expect to generate code for it.
 
@@ -68,33 +77,47 @@ pc_bottoming_Id key mod name ty
        -- these "bottom" out, no matter what their arguments
 
 eRROR_ID
        -- these "bottom" out, no matter what their arguments
 
 eRROR_ID
-  = pc_bottoming_Id errorIdKey pRELUDE_BUILTIN SLIT("error") errorTy
+  = pc_bottoming_Id errorIdKey pRELUDE SLIT("error") errorTy
+
+generic_ERROR_ID u n
+  = pc_bottoming_Id u SLIT("GHCerr") n errorTy
 
 pAT_ERROR_ID
 
 pAT_ERROR_ID
-  = pc_bottoming_Id patErrorIdKey pRELUDE_BUILTIN SLIT("patError#") errorTy
+  = generic_ERROR_ID patErrorIdKey SLIT("patError")
+rEC_CON_ERROR_ID
+  = generic_ERROR_ID recConErrorIdKey SLIT("recConError")
+rEC_UPD_ERROR_ID
+  = generic_ERROR_ID recUpdErrorIdKey SLIT("recUpdError")
+iRREFUT_PAT_ERROR_ID
+  = 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")
 
 aBSENT_ERROR_ID
 
 aBSENT_ERROR_ID
-  = pc_bottoming_Id absentErrorIdKey pRELUDE_BUILTIN SLIT("absent#")
-       (mkSigmaTy [alphaTyVar] [] alphaTy)
+  = pc_bottoming_Id absentErrorIdKey SLIT("GHCerr") SLIT("absentErr")
+       (mkSigmaTy [openAlphaTyVar] [] openAlphaTy)
 
 pAR_ERROR_ID
 
 pAR_ERROR_ID
-  = pcMiscPrelId parErrorIdKey pRELUDE_BUILTIN SLIT("parError#")
-    (mkSigmaTy [alphaTyVar] [] alphaTy) noIdInfo
+  = pcMiscPrelId parErrorIdKey SLIT("GHCerr") SLIT("parError")
+    (mkSigmaTy [openAlphaTyVar] [] openAlphaTy) noIdInfo
+
+openAlphaTy = mkTyVarTy openAlphaTyVar
 
 errorTy  :: Type
 
 errorTy  :: Type
-errorTy  = mkSigmaTy [alphaTyVar] [] (mkFunTys [mkListTy charTy] alphaTy)
+errorTy  = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] openAlphaTy)
 \end{code}
 
 \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 (!!),
 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
 \begin{code}
 tRACE_ID
-  = pcMiscPrelId traceIdKey pRELUDE_BUILTIN SLIT("_trace") traceTy
+  = pcMiscPrelId traceIdKey gHC__ SLIT("trace") traceTy
        (noIdInfo `addInfo` pcGenerateSpecs traceIdKey tRACE_ID noIdInfo traceTy)
   where
     traceTy = mkSigmaTy [alphaTyVar] [] (mkFunTys [mkListTy charTy, alphaTy] alphaTy)
        (noIdInfo `addInfo` pcGenerateSpecs traceIdKey tRACE_ID noIdInfo traceTy)
   where
     traceTy = mkSigmaTy [alphaTyVar] [] (mkFunTys [mkListTy charTy, alphaTy] alphaTy)
@@ -108,40 +131,40 @@ tRACE_ID
 
 \begin{code}
 packStringForCId
 
 \begin{code}
 packStringForCId
-  = pcMiscPrelId packCStringIdKey{-ToDo:rename-} pRELUDE_PS SLIT("_packStringForC")
+  = pcMiscPrelId packCStringIdKey{-ToDo:rename-} gHC__ SLIT("packStringForC__")
        (mkFunTys [stringTy] byteArrayPrimTy) noIdInfo
 
 --------------------------------------------------------------------
 
 unpackCStringId
        (mkFunTys [stringTy] byteArrayPrimTy) noIdInfo
 
 --------------------------------------------------------------------
 
 unpackCStringId
-  = pcMiscPrelId unpackCStringIdKey pRELUDE_BUILTIN SLIT("unpackPS#")
+  = pcMiscPrelId unpackCStringIdKey gHC__ SLIT("unpackPS__")
                 (mkFunTys [addrPrimTy{-a char *-}] stringTy) noIdInfo
 -- Andy says:
 --     (FunTy addrPrimTy{-a char *-} stringTy) (noIdInfo `addInfo` mkArityInfo 1)
 -- but I don't like wired-in IdInfos (WDP)
 
 unpackCString2Id -- for cases when a string has a NUL in it
                 (mkFunTys [addrPrimTy{-a char *-}] stringTy) noIdInfo
 -- Andy says:
 --     (FunTy addrPrimTy{-a char *-} stringTy) (noIdInfo `addInfo` mkArityInfo 1)
 -- but I don't like wired-in IdInfos (WDP)
 
 unpackCString2Id -- for cases when a string has a NUL in it
-  = pcMiscPrelId unpackCString2IdKey pRELUDE_BUILTIN SLIT("unpackPS2#")
+  = pcMiscPrelId unpackCString2IdKey gHC__ SLIT("unpackPS2__")
                 (mkFunTys [addrPrimTy{-a char *-}, intPrimTy{-length-}] stringTy)
                 noIdInfo
 
 --------------------------------------------------------------------
 unpackCStringAppendId
                 (mkFunTys [addrPrimTy{-a char *-}, intPrimTy{-length-}] stringTy)
                 noIdInfo
 
 --------------------------------------------------------------------
 unpackCStringAppendId
-  = pcMiscPrelId unpackCStringAppendIdKey pRELUDE_BUILTIN SLIT("unpackAppendPS#")
+  = pcMiscPrelId unpackCStringAppendIdKey gHC__ SLIT("unpackAppendPS__")
                (mkFunTys [addrPrimTy{-a "char *" pointer-},stringTy] stringTy)
                ((noIdInfo
                (mkFunTys [addrPrimTy{-a "char *" pointer-},stringTy] stringTy)
                ((noIdInfo
-                `addInfo_UF` mkMagicUnfolding unpackCStringAppendIdKey)
+                {-LATER:`addInfo_UF` mkMagicUnfolding unpackCStringAppendIdKey-})
                 `addInfo` mkArityInfo 2)
 
 unpackCStringFoldrId
                 `addInfo` mkArityInfo 2)
 
 unpackCStringFoldrId
-  = pcMiscPrelId unpackCStringFoldrIdKey pRELUDE_BUILTIN SLIT("unpackFoldrPS#")
+  = pcMiscPrelId unpackCStringFoldrIdKey gHC__ SLIT("unpackFoldrPS__")
                (mkSigmaTy [alphaTyVar] []
                (mkFunTys [addrPrimTy{-a "char *" pointer-},
                           mkFunTys [charTy, alphaTy] alphaTy,
                           alphaTy]
                          alphaTy))
                ((noIdInfo
                (mkSigmaTy [alphaTyVar] []
                (mkFunTys [addrPrimTy{-a "char *" pointer-},
                           mkFunTys [charTy, alphaTy] alphaTy,
                           alphaTy]
                          alphaTy))
                ((noIdInfo
-                `addInfo_UF` mkMagicUnfolding unpackCStringFoldrIdKey)
+                {-LATER:`addInfo_UF` mkMagicUnfolding unpackCStringFoldrIdKey-})
                 `addInfo` mkArityInfo 3)
 \end{code}
 
                 `addInfo` mkArityInfo 3)
 \end{code}
 
@@ -149,13 +172,13 @@ 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
 +1, +2, and -1 (go ahead, fire me):
 \begin{code}
 integerZeroId
-  = pcMiscPrelId integerZeroIdKey     pRELUDE_CORE SLIT("__integer0")  integerTy noIdInfo
+  = pcMiscPrelId integerZeroIdKey     gHC__ SLIT("integer_0")  integerTy noIdInfo
 integerPlusOneId
 integerPlusOneId
-  = pcMiscPrelId integerPlusOneIdKey  pRELUDE_CORE SLIT("__integer1")  integerTy noIdInfo
+  = pcMiscPrelId integerPlusOneIdKey  gHC__ SLIT("integer_1")  integerTy noIdInfo
 integerPlusTwoId
 integerPlusTwoId
-  = pcMiscPrelId integerPlusTwoIdKey  pRELUDE_CORE SLIT("__integer2")  integerTy noIdInfo
+  = pcMiscPrelId integerPlusTwoIdKey  gHC__ SLIT("integer_2")  integerTy noIdInfo
 integerMinusOneId
 integerMinusOneId
-  = pcMiscPrelId integerMinusOneIdKey pRELUDE_CORE SLIT("__integerm1") integerTy noIdInfo
+  = pcMiscPrelId integerMinusOneIdKey gHC__ SLIT("integer_m1") integerTy noIdInfo
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -165,22 +188,23 @@ integerMinusOneId
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}
+{- OUT:
 --------------------------------------------------------------------
 --------------------------------------------------------------------
--- seqId :: "_seq_", used w/ GRIP, etc., is really quite similar to
+-- seqId :: "seq", used w/ GRIP, etc., is really quite similar to
 -- dangerousEval
 {-
    OLDER:
 -- dangerousEval
 {-
    OLDER:
-   _seq_ = /\ a b -> \ x y -> case x of { _ -> y }
+   seq = /\ a b -> \ x y -> case x of { _ -> y }
 
    OLD:
 
    OLD:
-   _seq_ = /\ a b -> \ x y -> case seq# x y of { _Lift y' -> y' }
+   seq = /\ a b -> \ x y -> case seq# x y of { _Lift y' -> y' }
 
    NEW (95/05):
 
    NEW (95/05):
-   _seq_ = /\ a b -> \ x::a y::b -> case seq# x of { 0# -> parError#; _ -> y; }
+   seq = /\ a b -> \ x::a y::b -> case seq# x of { 0# -> parError#; _ -> y; }
 
 -}
 
 
 -}
 
-seqId = pcMiscPrelId seqIdKey pRELUDE_BUILTIN SLIT("_seq_")
+seqId = pcMiscPrelId seqIdKey gHC__ SLIT("seq")
                  (mkSigmaTy [alphaTyVar, betaTyVar] []
                    (mkFunTys [alphaTy, betaTy] betaTy))
                  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding seq_template))
                  (mkSigmaTy [alphaTyVar, betaTyVar] []
                    (mkFunTys [alphaTy, betaTy] betaTy))
                  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding seq_template))
@@ -200,7 +224,7 @@ seqId = pcMiscPrelId seqIdKey pRELUDE_BUILTIN SLIT("_seq_")
                    (BindDefault z (Var y))))
 
 --------------------------------------------------------------------
                    (BindDefault z (Var y))))
 
 --------------------------------------------------------------------
--- parId :: "_par_", also used w/ GRIP, etc.
+-- parId :: "par", also used w/ GRIP, etc.
 {-
     OLDER:
 
 {-
     OLDER:
 
@@ -208,14 +232,14 @@ seqId = pcMiscPrelId seqIdKey pRELUDE_BUILTIN SLIT("_seq_")
 
     OLD:
 
 
     OLD:
 
-    _par_ = /\ a b -> \ x y -> case par# x y of { _Lift y' -> y' }
+    par = /\ a b -> \ x y -> case par# x y of { _Lift y' -> y' }
 
     NEW (95/05):
 
 
     NEW (95/05):
 
-    _par_ = /\ a b -> \ x::a y::b -> case par# x of { 0# -> parError#; _ -> y; }
+    par = /\ a b -> \ x::a y::b -> case par# x of { 0# -> parError#; _ -> y; }
 
 -}
 
 -}
-parId = pcMiscPrelId parIdKey pRELUDE_BUILTIN SLIT("_par_")
+parId = pcMiscPrelId parIdKey gHC__ SLIT("par")
                  (mkSigmaTy [alphaTyVar, betaTyVar] []
                    (mkFunTys [alphaTy, betaTy] betaTy))
                  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding par_template))
                  (mkSigmaTy [alphaTyVar, betaTyVar] []
                    (mkFunTys [alphaTy, betaTy] betaTy))
                  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding par_template))
@@ -234,11 +258,11 @@ parId = pcMiscPrelId parIdKey pRELUDE_BUILTIN SLIT("_par_")
                    [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
                    (BindDefault z (Var y))))
 
                    [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
                    (BindDefault z (Var y))))
 
--- forkId :: "_fork_", for *required* concurrent threads
+-- forkId :: "fork", for *required* concurrent threads
 {-
    _fork_ = /\ a b -> \ x::a y::b -> case fork# x of { 0# -> parError#; _ -> y; }
 -}
 {-
    _fork_ = /\ a b -> \ x::a y::b -> case fork# x of { 0# -> parError#; _ -> y; }
 -}
-forkId = pcMiscPrelId forkIdKey pRELUDE_BUILTIN SLIT("_fork_")
+forkId = pcMiscPrelId forkIdKey gHC__ SLIT("fork")
                  (mkSigmaTy [alphaTyVar, betaTyVar] []
                    (mkFunTys [alphaTy, betaTy] betaTy))
                  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding fork_template))
                  (mkSigmaTy [alphaTyVar, betaTyVar] []
                    (mkFunTys [alphaTy, betaTy] betaTy))
                  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding fork_template))
@@ -256,106 +280,218 @@ forkId = pcMiscPrelId forkIdKey pRELUDE_BUILTIN SLIT("_fork_")
                  PrimAlts
                    [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
                    (BindDefault z (Var y))))
                  PrimAlts
                    [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
                    (BindDefault z (Var y))))
-
+-}
 \end{code}
 
 \end{code}
 
+GranSim ones:
 \begin{code}
 \begin{code}
-#ifdef GRAN
-
-parLocalId = pcMiscPrelId parLocalIdKey pRELUDE_BUILTIN SLIT("_parLocal_")
+{- OUT:
+parLocalId = pcMiscPrelId parLocalIdKey gHC__ SLIT("parLocal")
                  (mkSigmaTy [alphaTyVar, betaTyVar] []
                  (mkSigmaTy [alphaTyVar, betaTyVar] []
-                   (mkFunTys [intPrimTy, alphaTy, betaTy] betaTy))
+                   (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
                  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parLocal_template))
   where
                  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parLocal_template))
   where
-    [w, x, y, z]
+    -- Annotations: w: name, g: gran. info, s: size info, p: par info  -- HWL
+    [w, g, s, p, x, y, z]
       = mkTemplateLocals [
        {-w-} intPrimTy,
       = mkTemplateLocals [
        {-w-} intPrimTy,
+       {-g-} intPrimTy,
+       {-s-} intPrimTy,
+       {-p-} intPrimTy,
        {-x-} alphaTy,
        {-y-} betaTy,
        {-x-} alphaTy,
        {-y-} betaTy,
-       {-z-} betaTy
+       {-z-} intPrimTy
        ]
 
     parLocal_template
        ]
 
     parLocal_template
-      = mkLam [alphaTyVar, betaTyVar] [w, x, y] (
-               Case (Prim ParLocalOp [TyArg alphaTy, TyArg betaTy, VarArg x, VarArg w, VarArg y]) (
-                 AlgAlts
-                   [(liftDataCon, [z], Var z)]
-                   (NoDefault)))
+      = mkLam [alphaTyVar, betaTyVar] [w, g, s, p, x, y] (
+               Case (Prim ParLocalOp [TyArg alphaTy, TyArg betaTy, VarArg x, VarArg w, VarArg g, VarArg s, VarArg p, VarArg y]) (
+                 PrimAlts
+                   [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
+                   (BindDefault z (Var y))))
 
 
-parGlobalId = pcMiscPrelId parGlobalIdKey pRELUDE_BUILTIN SLIT("_parGlobal_")
+parGlobalId = pcMiscPrelId parGlobalIdKey gHC__ SLIT("parGlobal")
                  (mkSigmaTy [alphaTyVar, betaTyVar] []
                  (mkSigmaTy [alphaTyVar, betaTyVar] []
-                   (mkFunTys [intPrimTy,alphaTy,betaTy] betaTy))
+                   (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
                  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parGlobal_template))
   where
                  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parGlobal_template))
   where
-    [w, x, y, z]
+    -- Annotations: w: name, g: gran. info, s: size info, p: par info  -- HWL
+    [w, g, s, p, x, y, z]
       = mkTemplateLocals [
        {-w-} intPrimTy,
       = mkTemplateLocals [
        {-w-} intPrimTy,
+       {-g-} intPrimTy,
+       {-s-} intPrimTy,
+       {-p-} intPrimTy,
        {-x-} alphaTy,
        {-y-} betaTy,
        {-x-} alphaTy,
        {-y-} betaTy,
-       {-z-} betaTy
+       {-z-} intPrimTy
        ]
 
     parGlobal_template
        ]
 
     parGlobal_template
-      = mkLam [alphaTyVar, betaTyVar] [w, x, y] (
-               Case (Prim ParGlobalOp [TyArg alphaTy, TyArg betaTy, VarArg x, VarArg w, VarArg y]) (
-                 AlgAlts
-                   [(liftDataCon, [z], Var z)]
-                   (NoDefault)))
+      = mkLam [alphaTyVar, betaTyVar] [w, g, s, p, x, y] (
+               Case (Prim ParGlobalOp [TyArg alphaTy, TyArg betaTy, VarArg x, VarArg w, VarArg g, VarArg s, VarArg p, VarArg y]) (
+                 PrimAlts
+                   [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
+                   (BindDefault z (Var y))))
 
 
-#endif {-GRAN-}
-\end{code}
 
 
-%************************************************************************
-%*                                                                     *
-\subsection[PrelVals-deriving]{Values known about mainly for doing derived instance decls}
-%*                                                                     *
-%************************************************************************
+parAtId = pcMiscPrelId parAtIdKey gHC__ SLIT("parAt")
+                 (mkSigmaTy [alphaTyVar, betaTyVar] []
+                   (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy,
+                              alphaTy, betaTy, gammaTy] gammaTy))
+                 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parAt_template))
+  where
+    -- Annotations: w: name, g: gran. info, s: size info, p: par info  -- HWL
+    [w, g, s, p, v, x, y, z]
+      = mkTemplateLocals [
+       {-w-} intPrimTy,
+       {-g-} intPrimTy,
+       {-s-} intPrimTy,
+       {-p-} intPrimTy,
+       {-v-} alphaTy,
+       {-x-} betaTy,
+       {-y-} gammaTy,
+       {-z-} intPrimTy
+       ]
 
 
-map            :: (a -> b) -> [a] -> [b]
-       -- this is up in the here-because-of-unfolding list
+    parAt_template
+      = 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) [gammaTy])]
+                   (BindDefault z (Var y))))
 
 
---??showChar   :: Char -> ShowS
-showSpace      :: ShowS        -- non-std: == "showChar ' '"
-showString     :: String -> ShowS
-showParen      :: Bool -> ShowS -> ShowS
+parAtAbsId = pcMiscPrelId parAtAbsIdKey gHC__ SLIT("parAtAbs")
+                 (mkSigmaTy [alphaTyVar, betaTyVar] []
+                   (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
+                 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parAtAbs_template))
+  where
+    -- Annotations: w: name, g: gran. info, s: size info, p: par info  -- HWL
+    [w, g, s, p, v, x, y, z]
+      = mkTemplateLocals [
+       {-w-} intPrimTy,
+       {-g-} intPrimTy,
+       {-s-} intPrimTy,
+       {-p-} intPrimTy,
+       {-v-} intPrimTy,
+       {-x-} alphaTy,
+       {-y-} betaTy,
+       {-z-} intPrimTy
+       ]
 
 
-(++)           :: [a] -> [a] -> [a]
-readParen      :: Bool -> ReadS a -> ReadS a
-lex            :: ReadS String
+    parAtAbs_template
+      = mkLam [alphaTyVar, betaTyVar] [w, g, s, p, v, x, y] (
+               Case (Prim ParAtAbsOp [TyArg alphaTy, TyArg betaTy, VarArg x, VarArg v, VarArg w, VarArg g, VarArg s, VarArg p, VarArg y]) (
+                 PrimAlts
+                   [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
+                   (BindDefault z (Var y))))
 
 
-%************************************************************************
-%*                                                                     *
-\subsection[PrelVals-void]{@void#@: Magic value of type @Void#@}
-%*                                                                     *
-%************************************************************************
+parAtRelId = pcMiscPrelId parAtRelIdKey gHC__ SLIT("parAtRel")
+                 (mkSigmaTy [alphaTyVar, betaTyVar] []
+                   (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
+                 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parAtRel_template))
+  where
+    -- Annotations: w: name, g: gran. info, s: size info, p: par info  -- HWL
+    [w, g, s, p, v, x, y, z]
+      = mkTemplateLocals [
+       {-w-} intPrimTy,
+       {-g-} intPrimTy,
+       {-s-} intPrimTy,
+       {-p-} intPrimTy,
+       {-v-} intPrimTy,
+       {-x-} alphaTy,
+       {-y-} betaTy,
+       {-z-} intPrimTy
+       ]
 
 
-I don't think this is available to the user; it's used in the
-simplifier (WDP 94/06).
-\begin{code}
-voidPrimId
-  = pcMiscPrelId voidPrimIdKey pRELUDE_BUILTIN SLIT("void#")
-       voidPrimTy noIdInfo
+    parAtRel_template
+      = mkLam [alphaTyVar, betaTyVar] [w, g, s, p, v, x, y] (
+               Case (Prim ParAtRelOp [TyArg alphaTy, TyArg betaTy, VarArg x, VarArg v, VarArg w, VarArg g, VarArg s, VarArg p, VarArg y]) (
+                 PrimAlts
+                   [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
+                   (BindDefault z (Var y))))
+
+parAtForNowId = pcMiscPrelId parAtForNowIdKey gHC__ SLIT("parAtForNow")
+                 (mkSigmaTy [alphaTyVar, betaTyVar] []
+                   (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy,
+                               alphaTy, betaTy, gammaTy] gammaTy))
+                 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parAtForNow_template))
+  where
+    -- Annotations: w: name, g: gran. info, s: size info, p: par info  -- HWL
+    [w, g, s, p, v, x, y, z]
+      = mkTemplateLocals [
+       {-w-} intPrimTy,
+       {-g-} intPrimTy,
+       {-s-} intPrimTy,
+       {-p-} intPrimTy,
+       {-v-} alphaTy,
+       {-x-} betaTy,
+       {-y-} gammaTy,
+       {-z-} intPrimTy
+       ]
+
+    parAtForNow_template
+      = 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) [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")
+                 (mkSigmaTy [alphaTyVar] []
+                   alphaTy)
+                 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding copyable_template))
+  where
+    -- Annotations: x: closure that's tagged to by copyable
+    [x, z]
+      = mkTemplateLocals [
+       {-x-} alphaTy,
+       {-z-} alphaTy
+       ]
+
+    copyable_template
+      = mkLam [alphaTyVar] [x] ( Prim CopyableOp [TyArg alphaTy, VarArg x] )
+
+noFollowId = pcMiscPrelId noFollowIdKey gHC__ SLIT("noFollow")
+                 (mkSigmaTy [alphaTyVar] []
+                   alphaTy)
+                 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding noFollow_template))
+  where
+    -- Annotations: x: closure that's tagged to not follow
+    [x, z]
+      = mkTemplateLocals [
+       {-x-} alphaTy,
+       {-z-} alphaTy
+       ]
+
+    noFollow_template
+      = mkLam [alphaTyVar] [x] ( Prim NoFollowOp [TyArg alphaTy, VarArg x] )
+-}
 \end{code}
 
 %************************************************************************
 %*                                                                     *
 \end{code}
 
 %************************************************************************
 %*                                                                     *
-\subsection[PrelVals-runST]{@_runST@: Magic start-state-transformer function}
+\subsection[PrelVals-runST]{@runST@: Magic start-state-transformer function}
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 
-@_runST@ has a non-Haskell-able type:
+@runST@ has a non-Haskell-able type:
 \begin{verbatim}
 \begin{verbatim}
--- _runST :: forall a. (forall s. _ST s a) -> a
+-- runST :: forall a. (forall s. _ST s a) -> a
 -- which is to say ::
 --          forall a. (forall s. (_State s -> (a, _State s))) -> 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
+runST a m = case m _RealWorld (S# _RealWorld realWorld#) of
               (r :: a, wild :: _State _RealWorld) -> r
 \end{verbatim}
               (r :: a, wild :: _State _RealWorld) -> r
 \end{verbatim}
+
 We unfold always, just for simplicity:
 \begin{code}
 runSTId
 We unfold always, just for simplicity:
 \begin{code}
 runSTId
-  = pcMiscPrelId runSTIdKey pRELUDE_BUILTIN SLIT("_runST") run_ST_ty id_info
+  = pcMiscPrelId runSTIdKey gHC__ SLIT("runST") run_ST_ty id_info
   where
     s_tv = betaTyVar
     s   = betaTy
   where
     s_tv = betaTyVar
     s   = betaTy
@@ -392,16 +528,16 @@ runSTId
 -}
 \end{code}
 
 -}
 \end{code}
 
-SLPJ 95/04: Why @_runST@ must not have an unfolding; consider:
+SLPJ 95/04: Why @runST@ must not have an unfolding; consider:
 \begin{verbatim}
 f x =
 \begin{verbatim}
 f x =
-  _runST ( \ s -> let
+  runST ( \ s -> let
                    (a, s')  = newArray# 100 [] s
                    (_, s'') = fill_in_array_or_something a x s'
                  in
                  freezeArray# a s'' )
 \end{verbatim}
                    (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:
+If we inline @runST@, we'll get:
 \begin{verbatim}
 f x = let
        (a, s')  = newArray# 100 [] realWorld#{-NB-}
 \begin{verbatim}
 f x = let
        (a, s')  = newArray# 100 [] realWorld#{-NB-}
@@ -425,11 +561,15 @@ All calls to @f@ will share a {\em single} array!  End SLPJ 95/04.
 nasty as-is, change it back to a literal (@Literal@).
 \begin{code}
 realWorldPrimId
 nasty as-is, change it back to a literal (@Literal@).
 \begin{code}
 realWorldPrimId
-  = pcMiscPrelId realWorldPrimIdKey pRELUDE_BUILTIN SLIT("realWorld#")
+  = pcMiscPrelId realWorldPrimIdKey gHC_BUILTINS SLIT("realWorld#")
        realWorldStatePrimTy
        noIdInfo
 \end{code}
 
        realWorldStatePrimTy
        noIdInfo
 \end{code}
 
+\begin{code}
+voidId = pcMiscPrelId voidIdKey gHC_BUILTINS SLIT("void") voidTy noIdInfo
+\end{code}
+
 %************************************************************************
 %*                                                                     *
 \subsection[PrelVals-foldr-build]{Values known about for ``foldr/build''}
 %************************************************************************
 %*                                                                     *
 \subsection[PrelVals-foldr-build]{Values known about for ``foldr/build''}
@@ -438,9 +578,9 @@ realWorldPrimId
 
 \begin{code}
 buildId
 
 \begin{code}
 buildId
-  = pcMiscPrelId buildIdKey pRELUDE_CORE SLIT("_build") buildTy
+  = pcMiscPrelId buildIdKey SLIT("GHCerr") SLIT("build") buildTy
        ((((noIdInfo
        ((((noIdInfo
-               `addInfo_UF` mkMagicUnfolding buildIdKey)
+               {-LATER:`addInfo_UF` mkMagicUnfolding buildIdKey-})
                `addInfo` mkStrictnessInfo [WwStrict] Nothing)
                `addInfo` mkArgUsageInfo [ArgUsage 2])
                `addInfo` pcGenerateSpecs buildIdKey buildId noIdInfo{-ToDo-} buildTy)
                `addInfo` mkStrictnessInfo [WwStrict] Nothing)
                `addInfo` mkArgUsageInfo [ArgUsage 2])
                `addInfo` pcGenerateSpecs buildIdKey buildId noIdInfo{-ToDo-} buildTy)
@@ -452,7 +592,7 @@ buildId
     buildTy = mkSigmaTy [alphaTyVar] [] (mkFunTys [build_ty] (mkListTy alphaTy))
        where
            build_ty = mkSigmaTy [betaTyVar] []
     buildTy = mkSigmaTy [alphaTyVar] [] (mkFunTys [build_ty] (mkListTy alphaTy))
        where
            build_ty = mkSigmaTy [betaTyVar] []
-                       (mkFunTys [alphaTy, mkFunTys [betaTy] betaTy, betaTy] betaTy)
+                       (mkFunTys [mkFunTys [alphaTy, betaTy] betaTy, betaTy] betaTy)
 \end{code}
 
 @mkBuild@ is sugar for building a build!
 \end{code}
 
 @mkBuild@ is sugar for building a build!
@@ -483,9 +623,9 @@ mkBuild ty tv c n g expr
 
 \begin{code}
 augmentId
 
 \begin{code}
 augmentId
-  = pcMiscPrelId augmentIdKey pRELUDE_CORE SLIT("_augment") augmentTy
+  = pcMiscPrelId augmentIdKey SLIT("GHCerr") SLIT("augment") augmentTy
        (((noIdInfo
        (((noIdInfo
-               `addInfo_UF` mkMagicUnfolding augmentIdKey)
+               {-LATER:`addInfo_UF` mkMagicUnfolding augmentIdKey-})
                `addInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
                `addInfo` mkArgUsageInfo [ArgUsage 2,UnknownArgUsage])
        -- cheating, but since _augment never actually exists ...
                `addInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
                `addInfo` mkArgUsageInfo [ArgUsage 2,UnknownArgUsage])
        -- cheating, but since _augment never actually exists ...
@@ -496,33 +636,33 @@ augmentId
     augmentTy = mkSigmaTy [alphaTyVar] [] (mkFunTys [aug_ty, mkListTy alphaTy] (mkListTy alphaTy))
        where
            aug_ty = mkSigmaTy [betaTyVar] []
     augmentTy = mkSigmaTy [alphaTyVar] [] (mkFunTys [aug_ty, mkListTy alphaTy] (mkListTy alphaTy))
        where
            aug_ty = mkSigmaTy [betaTyVar] []
-                       (mkFunTys [alphaTy, mkFunTys [betaTy] betaTy, betaTy] betaTy)
+                       (mkFunTys [mkFunTys [alphaTy, betaTy] betaTy, betaTy] betaTy)
 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}
-foldrId = pcMiscPrelId foldrIdKey pRELUDE_FB{-not "List"-} SLIT("foldr")
+foldrId = pcMiscPrelId foldrIdKey pRELUDE SLIT("foldr")
                 foldrTy idInfo
   where
        foldrTy =
          mkSigmaTy [alphaTyVar, betaTyVar] []
                 foldrTy idInfo
   where
        foldrTy =
          mkSigmaTy [alphaTyVar, betaTyVar] []
-               (mkFunTys [alphaTy, mkFunTys [betaTy] betaTy, betaTy, mkListTy alphaTy] betaTy)
+               (mkFunTys [mkFunTys [alphaTy, betaTy] betaTy, betaTy, mkListTy alphaTy] betaTy)
 
        idInfo = (((((noIdInfo
 
        idInfo = (((((noIdInfo
-                       `addInfo_UF` mkMagicUnfolding foldrIdKey)
+                       {-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)
 
                        `addInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
                        `addInfo` mkArityInfo 3)
                        `addInfo` mkUpdateInfo [2,2,1])
                        `addInfo` pcGenerateSpecs foldrIdKey foldrId noIdInfo{-ToDo-} foldrTy)
 
-foldlId = pcMiscPrelId foldlIdKey pRELUDE_FB{-not "List"-} SLIT("foldl")
+foldlId = pcMiscPrelId foldlIdKey pRELUDE SLIT("foldl")
                 foldlTy idInfo
   where
        foldlTy =
          mkSigmaTy [alphaTyVar, betaTyVar] []
                 foldlTy idInfo
   where
        foldlTy =
          mkSigmaTy [alphaTyVar, betaTyVar] []
-               (mkFunTys [alphaTy, mkFunTys [betaTy] betaTy, alphaTy, mkListTy betaTy] alphaTy)
+               (mkFunTys [mkFunTys [alphaTy, betaTy] alphaTy, alphaTy, mkListTy betaTy] alphaTy)
 
        idInfo = (((((noIdInfo
 
        idInfo = (((((noIdInfo
-                       `addInfo_UF` mkMagicUnfolding foldlIdKey)
+                       {-LATER:`addInfo_UF` mkMagicUnfolding foldlIdKey-})
                        `addInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
                        `addInfo` mkArityInfo 3)
                        `addInfo` mkUpdateInfo [2,2,1])
                        `addInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
                        `addInfo` mkArityInfo 3)
                        `addInfo` mkUpdateInfo [2,2,1])
@@ -541,7 +681,7 @@ foldlId = pcMiscPrelId foldlIdKey pRELUDE_FB{-not "List"-} SLIT("foldl")
 -- So you have to turn *off* unfolding of foldr inside FoldrBuild.hs inside
 -- the prelude.
 --
 -- So you have to turn *off* unfolding of foldr inside FoldrBuild.hs inside
 -- the prelude.
 --
-
+{- OLD: doesn't apply with 1.3
 appendId
   = pcMiscPrelId appendIdKey pRELUDE_LIST SLIT("++") appendTy idInfo
   where
 appendId
   = pcMiscPrelId appendIdKey pRELUDE_LIST SLIT("++") appendTy idInfo
   where
@@ -552,6 +692,7 @@ appendId
                `addInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
                `addInfo` mkArityInfo 2)
                `addInfo` mkUpdateInfo [1,2])
                `addInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
                `addInfo` mkArityInfo 2)
                `addInfo` mkUpdateInfo [1,2])
+-}
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)