[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 e97a16d..37d6f6b 100644 (file)
--- a/ghc/compiler/prelude/PrelVals.lhs
+++ b/ghc/compiler/prelude/PrelVals.lhs
@@ -1,5 +1,5 @@
 %
 %

-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996

 %
 \section[PrelVals]{Prelude values the compiler ``knows about''}
 
 %
 \section[PrelVals]{Prelude values the compiler ``knows about''}
 

@@ -8,34 +8,45 @@
 
 module PrelVals where
 
 
 module PrelVals where
 

-import PrelFuns                -- help functions, types and things
-import BasicLit                ( mkMachInt, BasicLit(..), PrimKind )
+IMP_Ubiq()
+IMPORT_DELOOPER(IdLoop)                ( UnfoldingGuidance(..), nullSpecEnv, SpecEnv )
+import Id              ( SYN_IE(Id), GenId, mkImported, mkUserId, mkTemplateLocals )
+IMPORT_DELOOPER(PrelLoop)
+
+-- friends:
+import PrelMods

 import TysPrim
 import TysWiredIn
 import TysPrim
 import TysWiredIn

-#ifdef DPH
-import TyPod           ( mkPodNTy ,mkPodTy )
-import TyProcs         ( mkProcessorTy )
-#endif {- Data Parallel Haskell -}
-
-#ifndef DPH
-import AbsUniType
-import Id              ( mkTemplateLocals, mkTupleCon, getIdUniType,
-                         mkSpecId
-                       )
-#else
-import AbsUniType      ( mkSigmaTy, mkDictTy, mkTyVarTy , SigmaType(..),
-                         applyTyCon, splitType, specialiseTy
-                       )
-import Id              ( mkTemplateLocals, mkTupleCon, getIdUniType,
-                         mkSpecId, mkProcessorCon
-                       )
-#endif {- Data Parallel Haskell -}
-import IdInfo
-
-import Maybes          ( Maybe(..) )
-import PlainCore       -- to make unfolding templates
-import Unique          -- *Key things
-import Util
+
+-- others:
+import CmdLineOpts     ( maybe_CompilingGhcInternals )
+import CoreSyn         -- quite a bit
+import IdInfo          -- quite a bit
+import Literal         ( mkMachInt )
+import Name            ( ExportFlag(..) )
+import PragmaInfo
+import PrimOp          ( PrimOp(..) )
+import Type            ( mkTyVarTy )
+import TyVar           ( openAlphaTyVar, alphaTyVar, betaTyVar, gammaTyVar )
+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
+  = 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}
 
 %************************************************************************

@@ -46,15 +57,15 @@ import Util
 
 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.
 

@@ -66,36 +77,50 @@ 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 [alpha_tv] [] alpha)
+  = pc_bottoming_Id absentErrorIdKey SLIT("GHCerr") SLIT("absentErr")
+       (mkSigmaTy [openAlphaTyVar] [] openAlphaTy)

 
 pAR_ERROR_ID
 
 pAR_ERROR_ID

-  = pcMiscPrelId parErrorIdKey pRELUDE_BUILTIN SLIT("parError#")
-    (mkSigmaTy [alpha_tv] [] alpha) noIdInfo
+  = pcMiscPrelId parErrorIdKey SLIT("GHCerr") SLIT("parError")
+    (mkSigmaTy [openAlphaTyVar] [] openAlphaTy) noIdInfo
+
+openAlphaTy = mkTyVarTy openAlphaTyVar

 
 

-errorTy  :: UniType
-errorTy  = mkSigmaTy [alpha_tv] [] (UniFun (mkListTy charTy) alpha)
+errorTy  :: Type
+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
        (noIdInfo `addInfo` pcGenerateSpecs traceIdKey tRACE_ID noIdInfo traceTy)
   where

-    traceTy = mkSigmaTy [alpha_tv] [] (UniFun (mkListTy charTy) (UniFun alpha alpha))
+    traceTy = mkSigmaTy [alphaTyVar] [] (mkFunTys [mkListTy charTy, alphaTy] alphaTy)

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

@@ -105,48 +130,55 @@ tRACE_ID
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

-{- OLD:
-int2IntegerId
-  = pcMiscPrelId int2IntegerIdKey pRELUDE_BUILTIN SLIT("_int2Integer")
-       (UniFun intTy integerTy)
-       noIdInfo
--}
+packStringForCId
+  = pcMiscPrelId packCStringIdKey{-ToDo:rename-} gHC__ SLIT("packStringForC__")
+       (mkFunTys [stringTy] byteArrayPrimTy) noIdInfo

 
 --------------------------------------------------------------------
 
 unpackCStringId
 
 --------------------------------------------------------------------
 
 unpackCStringId

-  = pcMiscPrelId unpackCStringIdKey pRELUDE_PS SLIT("unpackPS#")
-                (addrPrimTy{-a char *-} `UniFun` stringTy) noIdInfo
+  = 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
 
 unpackCString2Id -- for cases when a string has a NUL in it

-  = pcMiscPrelId unpackCString2IdKey pRELUDE_PS SLIT("unpackPS2#")
-                (addrPrimTy{-a char *-}
-       `UniFun` (intPrimTy -- length
-       `UniFun` stringTy)) noIdInfo
+  = pcMiscPrelId unpackCString2IdKey gHC__ SLIT("unpackPS2__")
+                (mkFunTys [addrPrimTy{-a char *-}, intPrimTy{-length-}] stringTy)
+                noIdInfo

 
 --------------------------------------------------------------------
 unpackCStringAppendId
 
 --------------------------------------------------------------------
 unpackCStringAppendId

-  = pcMiscPrelId unpackCStringAppendIdKey pRELUDE_BUILTIN SLIT("unpackCStringAppend#")
-                               (addrPrimTy{-a "char *" pointer-} 
-               `UniFun`        (stringTy
-               `UniFun`        stringTy)) noIdInfo
-  
---------------------------------------------------------------------
-
-packStringForCId
-  = pcMiscPrelId packCStringIdKey{-ToDo:rename-} pRELUDE_PS SLIT("_packStringForC")
-       (UniFun stringTy byteArrayPrimTy) noIdInfo
+  = pcMiscPrelId unpackCStringAppendIdKey gHC__ SLIT("unpackAppendPS__")
+               (mkFunTys [addrPrimTy{-a "char *" pointer-},stringTy] stringTy)
+               ((noIdInfo
+                {-LATER:`addInfo_UF` mkMagicUnfolding unpackCStringAppendIdKey-})
+                `addInfo` mkArityInfo 2)
+
+unpackCStringFoldrId
+  = pcMiscPrelId unpackCStringFoldrIdKey gHC__ SLIT("unpackFoldrPS__")
+               (mkSigmaTy [alphaTyVar] []
+               (mkFunTys [addrPrimTy{-a "char *" pointer-},
+                          mkFunTys [charTy, alphaTy] alphaTy,
+                          alphaTy]
+                         alphaTy))
+               ((noIdInfo
+                {-LATER:`addInfo_UF` mkMagicUnfolding unpackCStringFoldrIdKey-})
+                `addInfo` mkArityInfo 3)

 \end{code}
 
 OK, this is Will's idea: we should have magic values for Integers 0,
 \end{code}
 
 OK, this is Will's idea: we should have magic values for Integers 0,

-+1, and -1 (go ahead, fire me):
++1, +2, and -1 (go ahead, fire me):

 \begin{code}
 integerZeroId
 \begin{code}
 integerZeroId

-  = pcMiscPrelId integerZeroIdKey     pRELUDE_CORE SLIT("_integer_0")  integerTy noIdInfo
+  = pcMiscPrelId integerZeroIdKey     gHC__ SLIT("integer_0")  integerTy noIdInfo

 integerPlusOneId
 integerPlusOneId

-  = pcMiscPrelId integerPlusOneIdKey  pRELUDE_CORE SLIT("_integer_1")  integerTy noIdInfo
+  = pcMiscPrelId integerPlusOneIdKey  gHC__ SLIT("integer_1")  integerTy noIdInfo
+integerPlusTwoId
+  = pcMiscPrelId integerPlusTwoIdKey  gHC__ SLIT("integer_2")  integerTy noIdInfo

 integerMinusOneId
 integerMinusOneId

-  = pcMiscPrelId integerMinusOneIdKey pRELUDE_CORE SLIT("_integer_m1") integerTy noIdInfo
+  = pcMiscPrelId integerMinusOneIdKey gHC__ SLIT("integer_m1") integerTy noIdInfo

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

@@ -155,52 +187,44 @@ integerMinusOneId
 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 

-In the definitions that follow, we use the @TyVar@-based
-alpha/beta/gamma types---not the usual @TyVarTemplate@ ones.
-
-This is so the @TyVars@ in the @CoTyLams@ (@alpha_tyvar@, etc) match
-up with those in the types of the {\em lambda-bound} template-locals
-we create (using types @alpha_ty@, etc.).
-

 \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_")
-                 (mkSigmaTy [alpha_tv, beta_tv] []
-                   (alpha `UniFun` (beta `UniFun` beta)))
+seqId = pcMiscPrelId seqIdKey gHC__ SLIT("seq")
+                 (mkSigmaTy [alphaTyVar, betaTyVar] []
+                   (mkFunTys [alphaTy, betaTy] betaTy))

                  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding seq_template))
   where
     [x, y, z]
       = mkTemplateLocals [
                  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding seq_template))
   where
     [x, y, z]
       = mkTemplateLocals [

-       {-x-} alpha_ty,
-       {-y-} beta_ty,
-        {-z-} intPrimTy
+       {-x-} alphaTy,
+       {-y-} betaTy,
+       {-z-} intPrimTy

        ]
 
     seq_template
        ]
 
     seq_template

-      = CoTyLam alpha_tyvar
-         (CoTyLam beta_tyvar
-            (mkCoLam [x, y] (
-               CoCase (CoPrim SeqOp [alpha_ty] [CoVarAtom x]) (
-                 CoPrimAlts
-                   [(mkMachInt 0, CoTyApp (CoVar pAR_ERROR_ID) beta_ty)]
-                   (CoBindDefault z (CoVar y))))))
+      = mkLam [alphaTyVar, betaTyVar] [x, y] (
+               Case (Prim SeqOp [TyArg alphaTy, VarArg x]) (
+                 PrimAlts
+                   [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
+                   (BindDefault z (Var y))))

 
 --------------------------------------------------------------------
 
 --------------------------------------------------------------------

--- parId :: "_par_", also used w/ GRIP, etc.
+-- parId :: "par", also used w/ GRIP, etc.

 {-
     OLDER:
 
 {-
     OLDER:
 

@@ -208,330 +232,312 @@ 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_")
-                 (mkSigmaTy [alpha_tv, beta_tv] []
-                   (alpha `UniFun` (beta `UniFun` beta)))
+parId = pcMiscPrelId parIdKey gHC__ SLIT("par")
+                 (mkSigmaTy [alphaTyVar, betaTyVar] []
+                   (mkFunTys [alphaTy, betaTy] betaTy))

                  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding par_template))
   where
     [x, y, z]
       = mkTemplateLocals [
                  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding par_template))
   where
     [x, y, z]
       = mkTemplateLocals [

-       {-x-} alpha_ty,
-       {-y-} beta_ty,
-        {-z-} intPrimTy
+       {-x-} alphaTy,
+       {-y-} betaTy,
+       {-z-} intPrimTy

        ]
 
     par_template
        ]
 
     par_template

-      = CoTyLam alpha_tyvar
-         (CoTyLam beta_tyvar
-            (mkCoLam [x, y] (
-               CoCase (CoPrim ParOp [alpha_ty] [CoVarAtom x]) (
-                 CoPrimAlts
-                   [(mkMachInt 0, CoTyApp (CoVar pAR_ERROR_ID) beta_ty)]
-                   (CoBindDefault z (CoVar y))))))
-
--- forkId :: "_fork_", for *required* concurrent threads
+      = mkLam [alphaTyVar, betaTyVar] [x, y] (
+               Case (Prim ParOp [TyArg alphaTy, VarArg x]) (
+                 PrimAlts
+                   [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
+                   (BindDefault z (Var y))))
+
+-- 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_")
-                 (mkSigmaTy [alpha_tv, beta_tv] []
-                   (alpha `UniFun` (beta `UniFun` beta)))
+forkId = pcMiscPrelId forkIdKey gHC__ SLIT("fork")
+                 (mkSigmaTy [alphaTyVar, betaTyVar] []
+                   (mkFunTys [alphaTy, betaTy] betaTy))

                  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding fork_template))
   where
     [x, y, z]
       = mkTemplateLocals [
                  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding fork_template))
   where
     [x, y, z]
       = mkTemplateLocals [

-       {-x-} alpha_ty,
-       {-y-} beta_ty,
-        {-z-} intPrimTy
+       {-x-} alphaTy,
+       {-y-} betaTy,
+       {-z-} intPrimTy

        ]
 
     fork_template
        ]
 
     fork_template

-      = CoTyLam alpha_tyvar
-         (CoTyLam beta_tyvar
-            (mkCoLam [x, y] (
-               CoCase (CoPrim ForkOp [alpha_ty] [CoVarAtom x]) (
-                 CoPrimAlts
-                   [(mkMachInt 0, CoTyApp (CoVar pAR_ERROR_ID) beta_ty)]
-                   (CoBindDefault z (CoVar y))))))
-
+      = mkLam [alphaTyVar, betaTyVar] [x, y] (
+               Case (Prim ForkOp [TyArg alphaTy, VarArg x]) (
+                 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_")
-                 (mkSigmaTy [alpha_tv, beta_tv] []
-                   (intPrimTy `UniFun` (alpha `UniFun` (beta `UniFun` beta))))
+{- OUT:
+parLocalId = pcMiscPrelId parLocalIdKey gHC__ SLIT("parLocal")
+                 (mkSigmaTy [alphaTyVar, betaTyVar] []
+                   (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,

-       {-x-} alpha_ty,
-       {-y-} beta_ty,
-       {-z-} beta_ty
+       {-g-} intPrimTy,
+       {-s-} intPrimTy,
+       {-p-} intPrimTy,
+       {-x-} alphaTy,
+       {-y-} betaTy,
+       {-z-} intPrimTy

        ]
 
     parLocal_template
        ]
 
     parLocal_template

-      = CoTyLam alpha_tyvar
-         (CoTyLam beta_tyvar
-            (mkCoLam [w, x, y] (
-               CoCase (CoPrim ParLocalOp [alpha_ty, beta_ty] [CoVarAtom x, CoVarAtom w, CoVarAtom y]) (
-                 CoAlgAlts
-                   [(liftDataCon, [z], CoVar z)]
-                   (CoNoDefault)))))
-
-parGlobalId = pcMiscPrelId parGlobalIdKey pRELUDE_BUILTIN SLIT("_parGlobal_")
-                 (mkSigmaTy [alpha_tv, beta_tv] []
-                   (intPrimTy `UniFun` (alpha `UniFun` (beta `UniFun` beta))))
+      = 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 gHC__ SLIT("parGlobal")
+                 (mkSigmaTy [alphaTyVar, betaTyVar] []
+                   (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,

-       {-x-} alpha_ty,
-       {-y-} beta_ty,
-       {-z-} beta_ty
+       {-g-} intPrimTy,
+       {-s-} intPrimTy,
+       {-p-} intPrimTy,
+       {-x-} alphaTy,
+       {-y-} betaTy,
+       {-z-} intPrimTy

        ]
 
     parGlobal_template
        ]
 
     parGlobal_template

-      = CoTyLam alpha_tyvar
-         (CoTyLam beta_tyvar
-            (mkCoLam [w, x, y] (
-               CoCase (CoPrim ParGlobalOp [alpha_ty, beta_ty] [CoVarAtom x, CoVarAtom w, CoVarAtom y]) (
-                 CoAlgAlts
-                   [(liftDataCon, [z], CoVar z)]
-                   (CoNoDefault)))))
-
-#endif {-GRAN-}
-\end{code}
-
-\begin{code}
-#ifdef DPH
-vectorMapId = pcChooseToKnowId vectorMapU pRELUDE "vectorMap"
-              (mkSigmaTy [alpha_tv, beta_tv , gamma_tv]
-                        [(pidClass,alpha)]
-             ((beta `UniFun` gamma)                     `UniFun`
-                ((mkPodTy (mkProcessorTy [alpha] beta)) `UniFun`
-                   (mkPodTy (mkProcessorTy [alpha] gamma)))))
-             (panic "vectorMap:unfolding")--ToDo:DPH: (mkUnfoldTemplate vector_map_template)
-             [(2,"","")]
- where
-{-
-vectorMap fn vec = << (|x;fn y|) | (|x;y|) <<- vec >>
-
-Simplified :
-vectorMap :: for all a.83, b.82, c.86. <Pid a.83>
-         -> (b.82 -> c.86)
-         -> <<a.83;b.82>>
-         -> <<a.83;c.86>>
-vectorMap =
-    /\ t83 t82 o86 -> \ dict.127 ->
-        let
-          vecMap.128 =
-              \ fn.129 vec.130 ->
-                  << let si.133 = fn.129 ds.132 in
-                     let
-                       si.134 =
-                           (fromDomain t82)
-                               dict.127 ((toDomain t82) dict.127 ds.131)
-                     in  MkProcessor1! Integer o86 si.134 si.133 |
-                      (| ds.131 ; ds.132 |) <<- vec.130 >>
-        in  vecMap.128
-
- NOTE : no need to bother with overloading in class Pid; because the result
-       PID (si.133) is wrapped in fromDomain.toDomain == id . Therefore we
-       use the simplification below.
-
-Simplified:
-vectorMap ::
-    for all d.83, e.82, f.86.
-        <Pid e.82> -> (d.83 -> f.86) -> <<e.82;d.83>> -> <<e.82;f.86>>
-vectorMap =
-    /\ t83 t82 o86 -> \ dict.127 fn.129 vec.130 ->
-    << MkProcessor1! Integer o86 ds.131 (fn.129 ds.132) |
-                      (| ds.131 ; ds.132 |) <<- vec.130 >>
--}
+      = 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))))
+
+
+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
+       ]

 
 

-    vector_map_template
-      = let
-          [dict,fn,vec,ds131,ds132]
-            = mkTemplateLocals
-                   [mkDictTy pidClass alpha_ty,
-                    beta_ty `UniFun` gamma_ty,
-                    mkPodTy (mkProcessorTy [alpha_ty] beta_ty),
-                    integerTy,
-                    beta_ty]
-       in
-         CoTyLam alpha_tyvar
-           (CoTyLam beta_tyvar
-              (CoTyLam gamma_tyvar
-               (mkCoLam [dict,fn,vec]
-                 (CoZfExpr
-                   (CoCon (mkProcessorCon 1)
-                          [integerTy,mkTyVarTy gamma_tyvar]
-                          [CoVar ds131,
-                           (CoApp (CoVar fn) (CoVar ds132))])
-                   (CoDrawnGen [ds131] ds132 (CoVar vec)) ))))
-
-#endif {- Data Parallel Haskell -}
-\end{code}
+    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 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
+       ]

 
 

-\begin{code}
-#ifdef DPH
--- A function used during podization that produces an index POD for a given
--- POD as argument.
-
-primIfromPodNSelectorId :: Int -> Int -> Id
-primIfromPodNSelectorId i n
-   = pcMiscPrelId
-       podSelectorIdKey
-       pRELUDE_BUILTIN
-        ("prim"++ show i ++ "fromPod" ++ show n ++ "Selector")
-        (UniFun
-          (mkPodNTy n alpha)
-          (mkPodNTy n alpha))
-       noIdInfo
-#endif {- Data Parallel Haskell -}
-\end{code}
+    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))))
+
+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
+       ]

 
 

-%************************************************************************
-%*                                                                     *
-\subsection[PrelVals-deriving]{Values known about mainly for doing derived instance decls}
-%*                                                                     *
-%************************************************************************
+    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
+       ]

 
 

-map            :: (a -> b) -> [a] -> [b]
-       -- this is up in the here-because-of-unfolding list
+    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))))

 
 

---??showChar   :: Char -> ShowS
-showSpace      :: ShowS        -- non-std: == "showChar ' '"
-showString     :: String -> ShowS
-showParen      :: Bool -> ShowS -> ShowS
+-- copyable and noFollow are currently merely hooks: they are translated into
+-- calls to the macros COPYABLE and NOFOLLOW                            -- HWL 

 
 

-(++)           :: [a] -> [a] -> [a]
-readParen      :: Bool -> ReadS a -> ReadS a
-lex            :: ReadS String
+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
+       ]

 
 

-\begin{code}
-{- OLD:
-readS_ty :: UniType -> UniType
-readS_ty ty
-  = UniFun stringTy (mkListTy (mkTupleTy 2 [ty, stringTy]))
+    copyable_template
+      = mkLam [alphaTyVar] [x] ( Prim CopyableOp [TyArg alphaTy, VarArg x] )

 
 

-showS_ty :: UniType
-showS_ty = UniFun stringTy stringTy
--}
-\end{code}
+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
+       ]

 
 

-\begin{code}
-{- OLD:
-showSpaceId = pcMiscPrelId showSpaceIdKey pRELUDE_TEXT SLIT("_showSpace")
-                               showS_ty
-                               noIdInfo
-
-showParenId = pcMiscPrelId showParenIdKey pRELUDE_TEXT SLIT("showParen")
-                               (boolTy `UniFun` (showS_ty `UniFun` showS_ty))
-                               noIdInfo
-
-readParenId = pcMiscPrelId readParenIdKey pRELUDE_TEXT SLIT("readParen")
-                               (mkSigmaTy [alpha_tv] [] (
-                                boolTy `UniFun` (
-                                (readS_ty alpha) `UniFun` (readS_ty alpha))))
-                               noIdInfo
-
-lexId = pcMiscPrelId lexIdKey pRELUDE_TEXT SLIT("lex")
-                               (readS_ty (mkListTy charTy))
-                               noIdInfo
+    noFollow_template
+      = mkLam [alphaTyVar] [x] ( Prim NoFollowOp [TyArg alphaTy, VarArg x] )

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

-\subsection[PrelVals-void]{@void#@: Magic value of type @Void#@}
+\subsection[PrelVals-runST]{@runST@: Magic start-state-transformer function}

 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 

-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}
-
-%************************************************************************
-%*                                                                     *
-\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
-               (r :: a, wild :: _State _RealWorld) -> r
+runST a m = case m _RealWorld (S# _RealWorld realWorld#) of
+              (r :: a, wild :: _State _RealWorld) -> r

 \end{verbatim}
 \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
   where

-    s_tv = beta_tv
-    s   = beta
+    s_tv = betaTyVar
+    s   = betaTy

 
     st_ty a = mkSigmaTy [s_tv] [] (mkStateTransformerTy s a)
 
     run_ST_ty
 
     st_ty a = mkSigmaTy [s_tv] [] (mkStateTransformerTy s a)
 
     run_ST_ty

-      = mkSigmaTy [alpha_tv] [] (st_ty alpha `UniFun` alpha)
+      = mkSigmaTy [alphaTyVar] [] (mkFunTys [st_ty alphaTy] alphaTy)

            -- NB: rank-2 polymorphism! (forall inside the st_ty...)
 
     id_info
       = noIdInfo
        `addInfo` mkArityInfo 1
            -- NB: rank-2 polymorphism! (forall inside the st_ty...)
 
     id_info
       = noIdInfo
        `addInfo` mkArityInfo 1

-        `addInfo` mkStrictnessInfo [WwStrict] Nothing
+       `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 [
        -- ABSOLUTELY NO UNFOLDING, e.g.: (mkUnfolding EssentialUnfolding run_ST_template)
        -- see example below
 {- OUT:
     [m, t, r, wild]
       = mkTemplateLocals [

-       {-m-} st_ty alpha_ty,
+       {-m-} st_ty alphaTy,

        {-t-} realWorldStateTy,
        {-t-} realWorldStateTy,

-       {-r-} alpha_ty,
+       {-r-} alphaTy,

        {-_-} realWorldStateTy
        ]
 
     run_ST_template
        {-_-} realWorldStateTy
        ]
 
     run_ST_template

-      = CoTyLam alpha_tyvar
-        (mkCoLam [m] (
-           CoLet (CoNonRec t (CoCon stateDataCon [realWorldTy] [CoVarAtom realWorldPrimId])) (
-             CoCase (CoApp (mkCoTyApp (CoVar m) realWorldTy) (CoVarAtom t)) (
-               CoAlgAlts
-                 [(mkTupleCon 2, [r, wild], CoVar r)]
-                 CoNoDefault))))
+      = 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}
 
 -}
 \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-}

@@ -552,14 +558,18 @@ f = let
 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
 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 (@BasicLit@).
+nasty as-is, change it back to a literal (@Literal@).

 \begin{code}
 realWorldPrimId
 \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''}

@@ -568,21 +578,21 @@ realWorldPrimId
 
 \begin{code}
 buildId
 
 \begin{code}
 buildId

-  = pcMiscPrelId buildIdKey pRELUDE_CORE SLIT("_build") buildTy
-       (((noIdInfo 
-               `addInfo_UF` mkMagicUnfolding SLIT("build"))
+  = pcMiscPrelId buildIdKey SLIT("GHCerr") SLIT("build") buildTy
+       ((((noIdInfo
+               {-LATER:`addInfo_UF` mkMagicUnfolding buildIdKey-})

                `addInfo` mkStrictnessInfo [WwStrict] Nothing)
                `addInfo` mkArgUsageInfo [ArgUsage 2])
                `addInfo` mkStrictnessInfo [WwStrict] Nothing)
                `addInfo` mkArgUsageInfo [ArgUsage 2])

+               `addInfo` pcGenerateSpecs buildIdKey buildId noIdInfo{-ToDo-} buildTy)

        -- cheating, but since _build never actually exists ...
   where
     -- The type of this strange object is:
     --  \/ a . (\/ b . (a -> b -> b) -> b -> b) -> [a]
 
        -- cheating, but since _build never actually exists ...
   where
     -- The type of this strange object is:
     --  \/ a . (\/ b . (a -> b -> b) -> b -> b) -> [a]
 

-    buildTy = mkSigmaTy [alpha_tv] [] (buildUniTy `UniFun` (mkListTy alpha))
+    buildTy = mkSigmaTy [alphaTyVar] [] (mkFunTys [build_ty] (mkListTy alphaTy))

        where
        where

-           buildUniTy = mkSigmaTy [beta_tv] []
-                   ((alpha `UniFun` (beta `UniFun` beta))
-                           `UniFun` (beta `UniFun` beta))
+           build_ty = mkSigmaTy [betaTyVar] []
+                       (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!

@@ -598,61 +608,151 @@ buildId
 @e@ is the object right inside the @build@
 
 \begin{code}
 @e@ is the object right inside the @build@
 
 \begin{code}

-mkBuild :: UniType
+mkBuild :: Type

        -> TyVar
        -> Id
        -> Id
        -> Id
        -> TyVar
        -> Id
        -> Id
        -> Id

-       -> PlainCoreExpr -- template
-       -> PlainCoreExpr -- template
+       -> CoreExpr -- template
+       -> CoreExpr -- template

 
 mkBuild ty tv c n g expr
 
 mkBuild ty tv c n g expr

- = CoLet (CoNonRec g (CoTyLam tv (mkCoLam [c,n] expr)))
-        (CoApp (mkCoTyApp (CoVar buildId) ty) (CoVarAtom g))
+  = Let (NonRec g (mkLam [tv] [c,n] expr))
+       (App (mkTyApp (Var buildId) [ty]) (VarArg g))

 \end{code}
 
 \end{code}
 

-mkFoldr ty_a ty_b [x,y...] => foldr ty_a ty_b x y ..
+\begin{code}
+augmentId
+  = pcMiscPrelId augmentIdKey SLIT("GHCerr") SLIT("augment") augmentTy
+       (((noIdInfo
+               {-LATER:`addInfo_UF` mkMagicUnfolding augmentIdKey-})
+               `addInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
+               `addInfo` mkArgUsageInfo [ArgUsage 2,UnknownArgUsage])
+       -- cheating, but since _augment never actually exists ...
+  where
+    -- The type of this strange object is:
+    --  \/ a . (\/ b . (a -> b -> b) -> b -> b) -> [a] -> [a]
+
+    augmentTy = mkSigmaTy [alphaTyVar] [] (mkFunTys [aug_ty, mkListTy alphaTy] (mkListTy alphaTy))
+       where
+           aug_ty = mkSigmaTy [betaTyVar] []
+                       (mkFunTys [mkFunTys [alphaTy, betaTy] betaTy, betaTy] betaTy)
+\end{code}

 
 \begin{code}
 
 \begin{code}

-foldrId = pcMiscPrelId foldrIdKey pRELUDE_FB{-not "List"-} SLIT("foldr")
+foldrId = pcMiscPrelId foldrIdKey pRELUDE SLIT("foldr")

                 foldrTy idInfo
   where
        foldrTy =
                 foldrTy idInfo
   where
        foldrTy =

-         mkSigmaTy [alpha_tv, beta_tv] []
-               ((alpha `UniFun` (beta `UniFun` beta))
-               `UniFun` (beta
-               `UniFun` ((mkListTy alpha)
-               `UniFun` beta)))
-
-       idInfo = ((((noIdInfo 
-                       `addInfo_UF` mkMagicUnfolding SLIT("foldr"))
+         mkSigmaTy [alphaTyVar, betaTyVar] []
+               (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` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
                        `addInfo` mkArityInfo 3)
                        `addInfo` mkUpdateInfo [2,2,1])

+                       `addInfo` pcGenerateSpecs foldrIdKey foldrId noIdInfo{-ToDo-} foldrTy)

 
 

-mkFoldr a b f z xs = foldl CoApp
-                          (mkCoTyApps (CoVar foldrId) [a, b]) 
-                          [CoVarAtom f,CoVarAtom z,CoVarAtom xs]
-
-foldlId = pcMiscPrelId foldlIdKey pRELUDE_FB{-not "List"-} SLIT("foldl")
+foldlId = pcMiscPrelId foldlIdKey pRELUDE SLIT("foldl")

                 foldlTy idInfo
   where
        foldlTy =
                 foldlTy idInfo
   where
        foldlTy =

-         mkSigmaTy [alpha_tv, beta_tv] []
-               ((alpha `UniFun` (beta `UniFun` alpha))
-               `UniFun` (alpha
-               `UniFun` ((mkListTy beta)
-               `UniFun` alpha)))
-
-       idInfo = ((((noIdInfo 
-                       `addInfo_UF` mkMagicUnfolding SLIT("foldl"))
+         mkSigmaTy [alphaTyVar, betaTyVar] []
+               (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` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
                        `addInfo` mkArityInfo 3)
                        `addInfo` mkUpdateInfo [2,2,1])

+                       `addInfo` 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:
+--     xs ++ ys = augment (\ c n -> foldr c n xs) ys
+--              {- unfold augment -}
+--              = foldr (:) ys xs
+--              {- fold foldr to append -}
+--              = ys `appendId` xs
+--              = ys ++ xs             -- ugg!
+-- *BUT* you want (++) and not _append in your interfaces.
+--
+-- 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
+    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])
+-}
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+\subsection[PrelUtils-specialisations]{Specialisations for builtin values}
+%*                                                                     *
+%************************************************************************
+
+The specialisations which exist for the builtin values must be recorded in
+their IdInfos.
+
+NOTE: THE USES OF THE pcGenerate... FUNCTIONS MUST CORRESPOND
+      TO THE SPECIALISATIONS DECLARED IN THE PRELUDE !!!
+
+HACK: We currently use the same unique for the specialised Ids.
+
+The list @specing_types@ determines the types for which specialised
+versions are created. Note: This should correspond with the
+types passed to the pre-processor with the -genSPECS arg (see ghc.lprl).

 
 

-mkFoldl a b f z xs = foldl CoApp
-                          (mkCoTyApps (CoVar foldlId) [a, b]) 
-                          [CoVarAtom f,CoVarAtom z,CoVarAtom xs]
+ToDo: Create single mkworld definition which is grabbed here and in ghc.lprl

 
 

-pRELUDE_FB = SLIT("PreludeFoldrBuild")
+\begin{code}
+pcGenerateSpecs :: Unique -> Id -> IdInfo -> Type -> SpecEnv
+pcGenerateSpecs key id info ty
+  = nullSpecEnv
+
+{- LATER:
+
+pc_gen_specs True key id info ty
+
+pc_gen_specs is_id key id info ty
+ = mkSpecEnv spec_infos
+ where
+   spec_infos = [ let spec_ty = specialiseTy ty spec_tys 0
+                     spec_id = if is_id
+                               then mkSpecId key {- HACK WARNING: same unique! -}
+                                             id spec_tys spec_ty info
+                               else panic "SpecData:SpecInfo:SpecId"
+                 in
+                 SpecInfo spec_tys (length ctxts) spec_id
+               | spec_tys <- specialisations ]
+
+   (tyvars, ctxts, _) = splitSigmaTy ty
+   no_tyvars         = length tyvars
+
+   specialisations    = if no_tyvars == 0
+                       then []
+                       else tail (cross_product no_tyvars specing_types)
+
+                       -- N.B. tail removes fully polymorphic specialisation
+
+cross_product 0 tys = []
+cross_product 1 tys = map (:[]) tys
+cross_product n tys = concat [map (:cp) tys | cp <- cross_product (n-1) tys]
+
+
+specing_types = [Nothing,
+                Just charPrimTy,
+                Just doublePrimTy,
+                Just intPrimTy ]
+-}

 \end{code}
 \end{code}