[project @ 1998-02-02 17:27:26 by simonm]

[ghc-hetmet.git] / ghc / compiler / prelude / PrelVals.lhs

diff --git a/ghc/compiler/prelude/PrelVals.lhs b/ghc/compiler/prelude/PrelVals.lhs
index 5c5375a..9f6930b 100644 (file)
--- a/ghc/compiler/prelude/PrelVals.lhs
+++ b/ghc/compiler/prelude/PrelVals.lhs
@@ -4,14 +4,14 @@
 \section[PrelVals]{Prelude values the compiler ``knows about''}
 
 \begin{code}
 \section[PrelVals]{Prelude values the compiler ``knows about''}
 
 \begin{code}

+module PrelVals where
+

 #include "HsVersions.h"
 
 #include "HsVersions.h"
 

-module PrelVals where
+import {-# SOURCE #-} CoreUnfold ( UnfoldingGuidance(..), mkUnfolding )

 
 

-import Ubiq
-import IdLoop          ( UnfoldingGuidance(..) )
-import Id              ( Id(..), GenId, mkPreludeId, mkTemplateLocals )
-import PrelLoop
+import Id              ( Id, mkImported, mkTemplateLocals )
+import SpecEnv         ( SpecEnv, emptySpecEnv )

 
 -- friends:
 import PrelMods
 
 -- friends:
 import PrelMods

@@ -19,25 +19,37 @@ 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            ( mkWiredInIdName, Module )
+import PragmaInfo

 import PrimOp          ( PrimOp(..) )
 import PrimOp          ( PrimOp(..) )

-import SpecEnv         ( SpecEnv(..), nullSpecEnv )
-import TyVar           ( alphaTyVar, betaTyVar )
+import Type            
+import TyVar           ( openAlphaTyVar, alphaTyVar, betaTyVar, gammaTyVar, TyVar )

 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:
 \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
+mk_inline_unfolding = mkUnfolding IWantToBeINLINEd
+
+pcMiscPrelId :: Unique{-IdKey-} -> Module -> FAST_STRING -> Type -> IdInfo -> Id
+
+pcMiscPrelId key mod occ ty info
+  = let
+       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
+    -- 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 +60,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.
 

@@ -64,38 +76,53 @@ templates, but we don't ever expect to generate code for it.
 pc_bottoming_Id key mod name ty
  = pcMiscPrelId key mod name ty bottoming_info
  where
 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
        -- these "bottom" out, no matter what their arguments
 
 eRROR_ID

-  = pc_bottoming_Id errorIdKey pRELUDE_BUILTIN SLIT("error") errorTy
+  = pc_bottoming_Id errorIdKey pREL_ERR SLIT("error") errorTy
+
+generic_ERROR_ID u n
+  = pc_bottoming_Id u pREL_ERR 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_METHOD_BINDING_ERROR_ID
+  = generic_ERROR_ID noMethodBindingErrorIdKey SLIT("noMethodBindingError")

 
 aBSENT_ERROR_ID
 
 aBSENT_ERROR_ID

-  = pc_bottoming_Id absentErrorIdKey pRELUDE_BUILTIN SLIT("absent#")
-       (mkSigmaTy [alphaTyVar] [] alphaTy)
+  = pc_bottoming_Id absentErrorIdKey pREL_ERR SLIT("absentErr")
+       (mkSigmaTy [openAlphaTyVar] [] openAlphaTy)

 
 pAR_ERROR_ID
 
 pAR_ERROR_ID

-  = pcMiscPrelId parErrorIdKey pRELUDE_BUILTIN SLIT("parError#")
-    (mkSigmaTy [alphaTyVar] [] alphaTy) noIdInfo
+  = pcMiscPrelId parErrorIdKey pREL_ERR 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)
+    -- 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}
 
 \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
-       (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}
   where
     traceTy = mkSigmaTy [alphaTyVar] [] (mkFunTys [mkListTy charTy, alphaTy] alphaTy)
 \end{code}

@@ -108,54 +135,55 @@ tRACE_ID
 
 \begin{code}
 packStringForCId
 
 \begin{code}
 packStringForCId

-  = pcMiscPrelId packCStringIdKey{-ToDo:rename-} pRELUDE_PS SLIT("_packStringForC")
+  = pcMiscPrelId packCStringIdKey{-ToDo:rename-} pREL_PACK SLIT("packCString#")

        (mkFunTys [stringTy] byteArrayPrimTy) noIdInfo
 
 --------------------------------------------------------------------
 
 unpackCStringId
        (mkFunTys [stringTy] byteArrayPrimTy) noIdInfo
 
 --------------------------------------------------------------------
 
 unpackCStringId

-  = pcMiscPrelId unpackCStringIdKey pRELUDE_BUILTIN SLIT("unpackPS#")
+  = pcMiscPrelId unpackCStringIdKey pREL_PACK SLIT("unpackCString#")

                 (mkFunTys [addrPrimTy{-a char *-}] stringTy) noIdInfo
 -- Andy says:
                 (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
 -- 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 pREL_PACK SLIT("unpackNBytes#")

                 (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 pREL_PACK SLIT("unpackAppendCString#")

                (mkFunTys [addrPrimTy{-a "char *" pointer-},stringTy] stringTy)
                ((noIdInfo
                (mkFunTys [addrPrimTy{-a "char *" pointer-},stringTy] stringTy)
                ((noIdInfo

-                `addInfo_UF` mkMagicUnfolding unpackCStringAppendIdKey)
-                `addInfo` mkArityInfo 2)
+                {-LATER:`addUnfoldInfo` mkMagicUnfolding unpackCStringAppendIdKey-})
+                `addArityInfo` exactArity 2)

 
 unpackCStringFoldrId
 
 unpackCStringFoldrId

-  = pcMiscPrelId unpackCStringFoldrIdKey pRELUDE_BUILTIN SLIT("unpackFoldrPS#")
+  = pcMiscPrelId unpackCStringFoldrIdKey pREL_PACK SLIT("unpackFoldrCString#")

                (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)
-                `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):
 \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
 \begin{code}
 integerZeroId

-  = pcMiscPrelId integerZeroIdKey     pRELUDE_CORE SLIT("__integer0")  integerTy noIdInfo
+  = pcMiscPrelId integerZeroIdKey     pREL_NUM SLIT("integer_0")  integerTy noIdInfo

 integerPlusOneId
 integerPlusOneId

-  = pcMiscPrelId integerPlusOneIdKey  pRELUDE_CORE SLIT("__integer1")  integerTy noIdInfo
+  = pcMiscPrelId integerPlusOneIdKey  pREL_NUM SLIT("integer_1")  integerTy noIdInfo

 integerPlusTwoId
 integerPlusTwoId

-  = pcMiscPrelId integerPlusTwoIdKey  pRELUDE_CORE SLIT("__integer2")  integerTy noIdInfo
+  = pcMiscPrelId integerPlusTwoIdKey  pREL_NUM SLIT("integer_2")  integerTy noIdInfo

 integerMinusOneId
 integerMinusOneId

-  = pcMiscPrelId integerMinusOneIdKey pRELUDE_CORE SLIT("__integerm1") integerTy noIdInfo
+  = pcMiscPrelId integerMinusOneIdKey pREL_NUM SLIT("integer_m1") integerTy noIdInfo

 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -165,25 +193,26 @@ 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 pRELUDE SLIT("seq")

                  (mkSigmaTy [alphaTyVar, betaTyVar] []
                    (mkFunTys [alphaTy, betaTy] betaTy))
                  (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 [
   where
     [x, y, z]
       = mkTemplateLocals [

@@ -200,7 +229,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,17 +237,17 @@ 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 cONC_BASE SLIT("par")

                  (mkSigmaTy [alphaTyVar, betaTyVar] []
                    (mkFunTys [alphaTy, betaTy] betaTy))
                  (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 [
   where
     [x, y, z]
       = mkTemplateLocals [

@@ -234,14 +263,14 @@ 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 cONC_BASE SLIT("fork")

                  (mkSigmaTy [alphaTyVar, betaTyVar] []
                    (mkFunTys [alphaTy, betaTy] betaTy))
                  (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 [
   where
     [x, y, z]
       = mkTemplateLocals [

@@ -256,180 +285,211 @@ 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 cONC_BASE SLIT("parLocal")

                  (mkSigmaTy [alphaTyVar, betaTyVar] []
                  (mkSigmaTy [alphaTyVar, betaTyVar] []

-                   (mkFunTys [intPrimTy, alphaTy, betaTy] betaTy))
-                 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parLocal_template))
+                   (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
+                 (noIdInfo `addUnfoldInfo` (mk_inline_unfolding parLocal_template))

   where
   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 cONC_BASE SLIT("parGlobal")

                  (mkSigmaTy [alphaTyVar, betaTyVar] []
                  (mkSigmaTy [alphaTyVar, betaTyVar] []

-                   (mkFunTys [intPrimTy,alphaTy,betaTy] betaTy))
-                 (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parGlobal_template))
+                   (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
+                 (noIdInfo `addUnfoldInfo` (mk_inline_unfolding parGlobal_template))

   where
   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 cONC_BASE SLIT("parAt")
+                 (mkSigmaTy [alphaTyVar, betaTyVar] []
+                   (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy,
+                              alphaTy, betaTy, gammaTy] gammaTy))
+                 (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]
+      = mkTemplateLocals [
+       {-w-} intPrimTy,
+       {-g-} intPrimTy,
+       {-s-} intPrimTy,
+       {-p-} intPrimTy,
+       {-v-} alphaTy,
+       {-x-} betaTy,
+       {-y-} gammaTy,
+       {-z-} intPrimTy
+       ]
+
+    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))))
+
+parAtAbsId = pcMiscPrelId parAtAbsIdKey cONC_BASE SLIT("parAtAbs")
+                 (mkSigmaTy [alphaTyVar, betaTyVar] []
+                   (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
+                 (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]
+      = mkTemplateLocals [
+       {-w-} intPrimTy,
+       {-g-} intPrimTy,
+       {-s-} intPrimTy,
+       {-p-} intPrimTy,
+       {-v-} intPrimTy,
+       {-x-} alphaTy,
+       {-y-} betaTy,
+       {-z-} intPrimTy
+       ]
+
+    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))))

 
 

-map            :: (a -> b) -> [a] -> [b]
-       -- this is up in the here-because-of-unfolding list
+parAtRelId = pcMiscPrelId parAtRelIdKey cONC_BASE SLIT("parAtRel")
+                 (mkSigmaTy [alphaTyVar, betaTyVar] []
+                   (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
+                 (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]
+      = mkTemplateLocals [
+       {-w-} intPrimTy,
+       {-g-} intPrimTy,
+       {-s-} intPrimTy,
+       {-p-} intPrimTy,
+       {-v-} intPrimTy,
+       {-x-} alphaTy,
+       {-y-} betaTy,
+       {-z-} intPrimTy
+       ]

 
 

---??showChar   :: Char -> ShowS
-showSpace      :: ShowS        -- non-std: == "showChar ' '"
-showString     :: String -> ShowS
-showParen      :: Bool -> ShowS -> ShowS
+    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))))

 
 

-(++)           :: [a] -> [a] -> [a]
-readParen      :: Bool -> ReadS a -> ReadS a
-lex            :: ReadS String
+parAtForNowId = pcMiscPrelId parAtForNowIdKey cONC_BASE SLIT("parAtForNow")
+                 (mkSigmaTy [alphaTyVar, betaTyVar] []
+                   (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy,
+                               alphaTy, betaTy, gammaTy] gammaTy))
+                 (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]
+      = mkTemplateLocals [
+       {-w-} intPrimTy,
+       {-g-} intPrimTy,
+       {-s-} intPrimTy,
+       {-p-} intPrimTy,
+       {-v-} alphaTy,
+       {-x-} betaTy,
+       {-y-} gammaTy,
+       {-z-} intPrimTy
+       ]

 
 

-%************************************************************************
-%*                                                                     *
-\subsection[PrelVals-void]{@void#@: Magic value of type @Void#@}
-%*                                                                     *
-%************************************************************************
+    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))))

 
 

-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
-\end{code}
+-- copyable and noFollow are currently merely hooks: they are translated into
+-- calls to the macros COPYABLE and NOFOLLOW                            -- HWL 

 
 

-%************************************************************************
-%*                                                                     *
-\subsection[PrelVals-runST]{@_runST@: Magic start-state-transformer function}
-%*                                                                     *
-%************************************************************************
+copyableId = pcMiscPrelId copyableIdKey cONC_BASE SLIT("copyable")
+                 (mkSigmaTy [alphaTyVar] []
+                   alphaTy)
+                 (noIdInfo `addUnfoldInfo` (mk_inline_unfolding copyable_template))
+  where
+    -- Annotations: x: closure that's tagged to by copyable
+    [x, z]
+      = mkTemplateLocals [
+       {-x-} alphaTy,
+       {-z-} alphaTy
+       ]

 
 

-@_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
+    copyable_template
+      = mkLam [alphaTyVar] [x] ( Prim CopyableOp [TyArg alphaTy, VarArg x] )

 
 

-_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 pRELUDE_BUILTIN SLIT("_runST") run_ST_ty id_info
+noFollowId = pcMiscPrelId noFollowIdKey cONC_BASE SLIT("noFollow")
+                 (mkSigmaTy [alphaTyVar] []
+                   alphaTy)
+                 (noIdInfo `addUnfoldInfo` (mk_inline_unfolding noFollow_template))

   where
   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]
+    -- Annotations: x: closure that's tagged to not follow
+    [x, z]

       = mkTemplateLocals [
       = 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)))
+       {-x-} alphaTy,
+       {-z-} alphaTy
+       ]
+
+    noFollow_template
+      = mkLam [alphaTyVar] [x] ( Prim NoFollowOp [TyArg alphaTy, VarArg x] )

 -}
 \end{code}
 
 -}
 \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
 @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 pRELUDE_BUILTIN SLIT("realWorld#")
+  = pcMiscPrelId realWorldPrimIdKey pREL_GHC SLIT("realWorld#")

        realWorldStatePrimTy
        noIdInfo
 \end{code}
 
        realWorldStatePrimTy
        noIdInfo
 \end{code}
 

+\begin{code}
+voidId = pc_bottoming_Id voidIdKey pREL_BASE SLIT("void") voidTy
+\end{code}
+

 %************************************************************************
 %*                                                                     *
 \subsection[PrelVals-foldr-build]{Values known about for ``foldr/build''}
 %************************************************************************
 %*                                                                     *
 \subsection[PrelVals-foldr-build]{Values known about for ``foldr/build''}

@@ -438,12 +498,12 @@ realWorldPrimId
 
 \begin{code}
 buildId
 
 \begin{code}
 buildId

-  = pcMiscPrelId buildIdKey pRELUDE_CORE SLIT("_build") buildTy
+  = pcMiscPrelId buildIdKey pREL_ERR SLIT("build") buildTy

        ((((noIdInfo
        ((((noIdInfo

-               `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:
        -- cheating, but since _build never actually exists ...
   where
     -- The type of this strange object is:

@@ -452,7 +512,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,11 +543,11 @@ mkBuild ty tv c n g expr
 
 \begin{code}
 augmentId
 
 \begin{code}
 augmentId

-  = pcMiscPrelId augmentIdKey pRELUDE_CORE SLIT("_augment") augmentTy
+  = pcMiscPrelId augmentIdKey pREL_ERR SLIT("augment") augmentTy

        (((noIdInfo
        (((noIdInfo

-               `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:
        -- cheating, but since _augment never actually exists ...
   where
     -- The type of this strange object is:

@@ -496,37 +556,37 @@ 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 pREL_BASE 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)
-                       `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_FB{-not "List"-} SLIT("foldl")
+foldlId = pcMiscPrelId foldlIdKey pREL_LIST 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)
-                       `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:
 
 -- A bit of magic goes no here. We translate appendId into ++,
 -- you have to be carefull when you actually compile append:

@@ -541,17 +601,18 @@ 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
 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
   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}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************

@@ -575,9 +636,9 @@ types passed to the pre-processor with the -genSPECS arg (see ghc.lprl).
 ToDo: Create single mkworld definition which is grabbed here and in ghc.lprl
 
 \begin{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
 pcGenerateSpecs key id info ty

-  = nullSpecEnv
+  = emptySpecEnv

 
 {- LATER:
 
 
 {- LATER: