[project @ 1996-07-25 20:43:49 by partain]
[ghc-hetmet.git] / ghc / compiler / coreSyn / CoreSyn.lhs
index 1cdba66..42830e9 100644 (file)
@@ -1,5 +1,5 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
 %
 \section[CoreSyn]{A data type for the Haskell compiler midsection}
 
 #include "HsVersions.h"
 
 module CoreSyn (
-       CoreBinding(..), CoreExpr(..), CoreAtom(..),
-       CoreCaseAlternatives(..), CoreCaseDefault(..),
-#ifdef DPH
-       CoreParQuals(..),
-       CoreParCommunicate(..),
-#endif {- Data Parallel Haskell -}
-       mkCoTyApp,
-       pprCoreBinding, pprCoreExpr,
-
-       CoreArg(..), applyToArgs, decomposeArgs, collectArgs,
-
-       -- and to make the interface self-sufficient ...
-       Id, UniType, TyVar, TyCon, PrimOp, BasicLit,
-       PprStyle, PrettyRep, CostCentre, Maybe
+       GenCoreBinding(..), GenCoreExpr(..),
+       GenCoreArg(..), GenCoreBinder(..), GenCoreCaseAlts(..),
+       GenCoreCaseDefault(..),
+       Coercion(..),
+
+       bindersOf, pairsFromCoreBinds, rhssOfBind,
+
+       mkGenApp, mkValApp, mkTyApp, mkUseApp,
+       mkApp, mkCon, mkPrim,
+       mkValLam, mkTyLam, mkUseLam,
+       mkLam,
+       collectBinders, collectUsageAndTyBinders, collectValBinders, 
+       isValBinder, notValBinder,
+       
+       collectArgs, initialTyArgs, initialValArgs, isValArg, notValArg, numValArgs,
+
+       mkCoLetAny, mkCoLetNoUnboxed, mkCoLetUnboxedToCase,
+       mkCoLetsAny, mkCoLetsNoUnboxed, mkCoLetsUnboxedToCase,
+       mkCoLetrecAny, mkCoLetrecNoUnboxed,
+
+       rhssOfAlts,
+
+       -- Common type instantiation...
+       SYN_IE(CoreBinding),
+       SYN_IE(CoreExpr),
+       SYN_IE(CoreBinder),
+       SYN_IE(CoreArg),
+       SYN_IE(CoreCaseAlts),
+       SYN_IE(CoreCaseDefault),
+
+       -- And not-so-common type instantiations...
+       SYN_IE(TaggedCoreBinding),
+       SYN_IE(TaggedCoreExpr),
+       SYN_IE(TaggedCoreBinder),
+       SYN_IE(TaggedCoreArg),
+       SYN_IE(TaggedCoreCaseAlts),
+       SYN_IE(TaggedCoreCaseDefault),
+
+       SYN_IE(SimplifiableCoreBinding),
+       SYN_IE(SimplifiableCoreExpr),
+       SYN_IE(SimplifiableCoreBinder),
+       SYN_IE(SimplifiableCoreArg),
+       SYN_IE(SimplifiableCoreCaseAlts),
+       SYN_IE(SimplifiableCoreCaseDefault)
     ) where
 
-import AbsPrel         ( PrimOp, PrimKind
-                         IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
-                         IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
-                       )
-import AbsUniType      ( isPrimType, pprParendUniType, TyVar, TyCon, UniType
-                         IF_ATTACK_PRAGMAS(COMMA cmpTyCon COMMA cmpTyVar)
-                         IF_ATTACK_PRAGMAS(COMMA cmpUniType)
-                       )
-import BasicLit                ( BasicLit )
-import Id              ( getIdUniType, isBottomingId, Id
-                         IF_ATTACK_PRAGMAS(COMMA bottomIsGuaranteed)
-                       )
-import Outputable
-import Pretty
+IMP_Ubiq(){-uitous-}
+
 import CostCentre      ( showCostCentre, CostCentre )
-import Util
+import Id              ( idType, GenId{-instance Eq-} )
+import Type            ( isUnboxedType )
+import Usage           ( SYN_IE(UVar) )
+import Util            ( panic, assertPanic {-pprTrace:ToDo:rm-} )
 \end{code}
 
 %************************************************************************
 %*                                                                     *
-\subsection[CoreTopBinding_and_CoreBinding]{@CoreTopBinding@ and @CoreBinding@}
+\subsection[CoreTopBinding_and_CoreBinding]{@CoreTopBinding@ and @GenCoreBinding@}
 %*                                                                     *
 %************************************************************************
 
 Core programs, bindings, expressions, etc., are parameterised with
 respect to the information kept about binding and bound occurrences of
-variables, called {\em binders} and {\em bindees}, respectively.  [I
+variables, called {\em binders} and {\em val_occ tyvar uvars}, respectively.  [I
 don't really like the pair of names; I prefer {\em binder} and {\em
 bounder}.  Or {\em binder} and {\em var}.]
 
-A @CoreBinding@ is either a single non-recursive binding of a
+A @GenCoreBinding@ is either a single non-recursive binding of a
 ``binder'' to an expression, or a mutually-recursive blob of same.
 \begin{code}
-data CoreBinding binder bindee
-  = CoNonRec   binder (CoreExpr binder bindee)
-  | CoRec      [(binder, CoreExpr binder bindee)]
+data GenCoreBinding val_bdr val_occ tyvar uvar
+  = NonRec     val_bdr (GenCoreExpr val_bdr val_occ tyvar uvar)
+  | Rec                [(val_bdr, GenCoreExpr val_bdr val_occ tyvar uvar)]
 \end{code}
 
-%************************************************************************
-%*                                                                     *
-\subsection[CoreAtom]{Core atoms: @CoreAtom@}
-%*                                                                     *
-%************************************************************************
+\begin{code}
+bindersOf :: GenCoreBinding val_bdr val_occ tyvar uvar -> [val_bdr]
 
-Same deal as @StgAtoms@, except that, for @Core@, the atomic object
-may need to be applied to some types.
+pairsFromCoreBinds ::
+  [GenCoreBinding val_bdr val_occ tyvar uvar] ->
+  [(val_bdr, GenCoreExpr val_bdr val_occ tyvar uvar)]
 
-\begin{code}
-data CoreAtom bindee
-  = CoVarAtom  bindee
-  | CoLitAtom   BasicLit
+rhssOfBind :: GenCoreBinding val_bdr val_occ tyvar uvar -> [GenCoreExpr val_bdr val_occ tyvar uvar]
+
+bindersOf (NonRec binder _) = [binder]
+bindersOf (Rec pairs)       = [binder | (binder, _) <- pairs]
+
+pairsFromCoreBinds []                 = []
+pairsFromCoreBinds ((NonRec b e) : bs) = (b,e) :  pairsFromCoreBinds bs
+pairsFromCoreBinds ((Rec  pairs) : bs) = pairs ++ pairsFromCoreBinds bs
+
+rhssOfBind (NonRec _ rhs) = [rhs]
+rhssOfBind (Rec pairs)    = [rhs | (_,rhs) <- pairs]
 \end{code}
 
 %************************************************************************
 %*                                                                     *
-\subsection[CoreExpr]{Core expressions: @CoreExpr@}
+\subsection[GenCoreExpr]{Core expressions: @GenCoreExpr@}
 %*                                                                     *
 %************************************************************************
 
-@CoreExpr@ is the heart of the ``core'' data types; it is
+@GenCoreExpr@ is the heart of the ``core'' data types; it is
 (more-or-less) boiled-down second-order polymorphic lambda calculus.
-For types in the core world, we just keep using @UniTypes@.
+For types in the core world, we just keep using @Types@.
 \begin{code}
-data CoreExpr binder bindee
-     = CoVar    bindee
-     | CoLit    BasicLit       -- literal constants
+data GenCoreExpr val_bdr val_occ tyvar uvar
+     = Var    val_occ
+     | Lit    Literal  -- literal constants
 \end{code}
 
-@CoCons@ and @CoPrims@ are saturated constructor and primitive-op
-applications (see the comment).  Note: @CoCon@s are only set up by the
+@Cons@ and @Prims@ are saturated constructor and primitive-op
+applications (see the comment).  Note: @Con@s are only set up by the
 simplifier (and by the desugarer when it knows what it's doing).  The
-desugarer sets up constructors as applications of global @CoVars@s.
+desugarer sets up constructors as applications of global @Vars@s.
+
 \begin{code}
-     | CoCon       Id [UniType] [CoreAtom bindee]
-                   -- saturated constructor application:
-                   -- the constructor is a function of the form:
-                   --  /\ a1 -> ... /\ am -> \ b1 -> ... \ bn ->
-                   -- <expr> where "/\" is a type lambda and "\" the
-                   -- regular kind; there will be "m" UniTypes and
-                   -- "n" bindees in the CoCon args.
-
-     | CoPrim      PrimOp [UniType] [CoreAtom bindee]
-                   -- saturated primitive operation;
-                   -- comment on CoCons applies here, too.
-                   -- The types work the same way
-                   -- (PrimitiveOps may be polymorphic).
+     | Con     Id [GenCoreArg val_occ tyvar uvar]
+               -- Saturated constructor application:
+               -- The constructor is a function of the form:
+               --      /\ a1 -> ... /\ am -> \ b1 -> ... \ bn ->
+               -- <expr> where "/\" is a type lambda and "\" the
+               -- regular kind; there will be "m" Types and
+               -- "n" bindees in the Con args.
+
+     | Prim    PrimOp [GenCoreArg val_occ tyvar uvar]
+               -- saturated primitive operation;
+               -- comment on Cons applies here, too.
 \end{code}
 
-Lambdas have multiple binders; this is good for the lambda lifter.
-Single binders may be simulated easily with multiple binders; vice
-versa is a pain.
+Ye olde abstraction and application operators.
 \begin{code}
-     | CoLam       [binder]    -- lambda var_1 ... var_n -> CoreExpr
-                   (CoreExpr binder bindee)
-     | CoTyLam     TyVar       -- Lambda TyVar -> CoreExpr
-                   (CoreExpr binder bindee)
-
-     | CoApp       (CoreExpr binder bindee)
-                   (CoreAtom bindee)
-     | CoTyApp      (CoreExpr binder bindee)
-                   UniType     -- type application
+     | Lam     (GenCoreBinder val_bdr tyvar uvar)
+               (GenCoreExpr   val_bdr val_occ tyvar uvar)
+
+     | App     (GenCoreExpr val_bdr val_occ tyvar uvar)
+               (GenCoreArg  val_occ tyvar uvar)
 \end{code}
 
-Case expressions (\tr{case CoreExpr of <List of alternatives>}): there
+Case expressions (\tr{case <expr> of <List of alternatives>}): there
 are really two flavours masquerading here---those for scrutinising
 {\em algebraic} types and those for {\em primitive} types.  Please see
-under @CoreCaseAlternatives@.
+under @GenCoreCaseAlts@.
 \begin{code}
-     | CoCase      (CoreExpr binder bindee)
-                   (CoreCaseAlternatives binder bindee)
+     | Case    (GenCoreExpr val_bdr val_occ tyvar uvar)
+               (GenCoreCaseAlts val_bdr val_occ tyvar uvar)
 \end{code}
 
 A Core case expression \tr{case e of v -> ...} implies evaluation of
 \tr{e}; it is not equivalent to \tr{let v = in ...} (as with a Haskell
 \tr{case}).
 
-Non-recursive @CoLets@ only have one binding; having more than one
+Non-recursive @Lets@ only have one binding; having more than one
 doesn't buy you much, and it is an easy way to mess up variable
 scoping.
 \begin{code}
-     | CoLet       (CoreBinding binder bindee)
-                   (CoreExpr binder bindee)
-                   -- both recursive and non-.
-                   -- The "CoreBinding" records that information
+     | Let     (GenCoreBinding val_bdr val_occ tyvar uvar)
+               (GenCoreExpr val_bdr val_occ tyvar uvar)
+               -- both recursive and non-.
+               -- The "GenCoreBinding" records that information
 \end{code}
 
-@build@ as a function is a *PAIN*. See Andy's thesis for
-futher details. This is equivalent to:
-@
-       build unitype (/\ tyvar \ c n -> expr)
-@
+For cost centre scc expressions we introduce a new core construct
+@SCC@ so transforming passes have to deal with it explicitly. The
+alternative of using a new PrimativeOp may result in a bad
+transformations of which we are unaware.
 \begin{code}
---ANDY:
---   | CoBuild UniType TyVar binder binder (CoreExpr binder bindee)
+     | SCC     CostCentre                                  -- label of scc
+               (GenCoreExpr val_bdr val_occ tyvar uvar)    -- scc expression
 \end{code}
 
-@CoZfExpr@ exist in the core language, along with their qualifiers. After
-succesive optimisations to the sequential bindings, we desugar the 
-@CoZfExpr@ into a subset of the core language without them - ``podization''.
-\begin{code}
-#ifdef DPH
-     | CoZfExpr     (CoreExpr binder bindee) 
-                   (CoreParQuals binder bindee)
-#endif {- Data Parallel Haskell -}
-\end{code}
+Coercions arise from uses of the constructor of a @newtype@
+declaration, either in construction (resulting in a @CoreceIn@) or
+pattern matching (resulting in a @CoerceOut@).
 
-@CoParCon@ is the parallel equivalent to the sequential @CoCon@ expression. 
-They are introduced into the core syntax by a pass of the compiler that
-removes the parallel ZF expressions, and {\em vectorises} ordinary sequential
-functions.
 \begin{code}
-#ifdef DPH
-      | CoParCon  Id Int [UniType] [CoreExpr binder bindee] --ToDo:DPH: CoreAtom
-#endif {- Data Parallel Haskell -}
+    | Coerce   Coercion
+               (GenType tyvar uvar)            -- Type of the whole expression
+               (GenCoreExpr val_bdr val_occ tyvar uvar)
 \end{code}
 
-@CoParCommunicate@ constructs are introduced by the desugaring of parallel
-ZF expressions. 
 \begin{code}
-#ifdef DPH
-     | CoParComm
-                    Int
-                   (CoreExpr binder bindee)
-                   (CoreParCommunicate binder bindee)
-#endif {- Data Parallel Haskell -}
+data Coercion  = CoerceIn Id           -- Apply this constructor
+               | CoerceOut Id          -- Strip this constructor
 \end{code}
 
-@CoParZipWith@ constructs are introduced whenever podization fails during the
-desuagring of ZF expressions. These constructs represent zipping the function
-represented by the first @CoreExpr@ with the list of @CoreExpr@'s (hopefully
-we wont see this that often in the resultant program :-).
 
-\begin{code}
-#ifdef DPH
-     | CoParZipWith
-                  Int
-                  (CoreExpr binder bindee)
-                  [CoreExpr binder bindee]
-#endif {- Data Parallel Haskell -}
-\end{code}
+%************************************************************************
+%*                                                                     *
+\subsection{Core-constructing functions with checking}
+%*                                                                     *
+%************************************************************************
+
+When making @Lets@, we may want to take evasive action if the thing
+being bound has unboxed type. We have different variants ...
+
+@mkCoLet(s|rec)Any@            let-binds any binding, regardless of type
+@mkCoLet(s|rec)NoUnboxed@      prohibits unboxed bindings
+@mkCoLet(s)UnboxedToCase@      converts an unboxed binding to a case
+                               (unboxed bindings in a letrec are still prohibited)
 
-For cost centre scc expressions we introduce a new core construct
-@CoSCC@ so transforming passes have to deal with it explicitly. The
-alternative of using a new PrimativeOp may result in a bad
-transformations of which we are unaware.
 \begin{code}
-     | CoSCC       CostCentre                  -- label of scc
-                   (CoreExpr binder bindee)    -- scc expression
+mkCoLetAny :: GenCoreBinding Id Id tyvar uvar
+          -> GenCoreExpr    Id Id tyvar uvar
+          -> GenCoreExpr    Id Id tyvar uvar
+mkCoLetsAny :: [GenCoreBinding Id Id tyvar uvar] ->
+               GenCoreExpr Id Id tyvar uvar ->
+               GenCoreExpr Id Id tyvar uvar
 
--- end of CoreExpr
-\end{code}
+mkCoLetrecAny :: [(val_bdr, GenCoreExpr val_bdr val_occ tyvar uvar)]
+             -> GenCoreExpr val_bdr val_occ tyvar uvar
+             -> GenCoreExpr val_bdr val_occ tyvar uvar
 
+mkCoLetrecAny []    body = body
+mkCoLetrecAny binds body = Let (Rec binds) body
 
-%************************************************************************
-%*                                                                     *
-\subsection[CoreParQualifiers]{Parallel qualifiers in @CoreExpr@}
-%*                                                                     *
-%************************************************************************
+mkCoLetsAny []    expr = expr
+mkCoLetsAny binds expr = foldr mkCoLetAny expr binds
+
+mkCoLetAny bind@(Rec binds)         body = mkCoLetrecAny binds body
+mkCoLetAny bind@(NonRec binder rhs) body = Let bind body
+\end{code}
 
 \begin{code}
-#ifdef DPH
-data CoreParQuals binder bindee
-   = CoAndQuals  (CoreParQuals binder bindee)
-                (CoreParQuals binder bindee)
-   | CoParFilter (CoreExpr binder bindee)
-   | CoDrawnGen  [binder]
-                (binder)
-                (CoreExpr binder bindee)       
-   | CoIndexGen  [CoreExpr binder bindee]
-                (binder)
-                (CoreExpr binder bindee)       
-#endif {- Data Parallel Haskell -}
+mkCoLetNoUnboxed bind@(Rec binds) body
+  = mkCoLetrecNoUnboxed binds body
+
+mkCoLetNoUnboxed bind@(NonRec binder rhs) body
+  = --ASSERT (not (isUnboxedType (idType binder)))
+    case body of
+      Var binder2 | binder == binder2
+        -> rhs   -- hey, I have the rhs
+      other
+        -> Let bind body
+
+mkCoLetsNoUnboxed []    expr = expr
+mkCoLetsNoUnboxed binds expr = foldr mkCoLetNoUnboxed expr binds
+
+mkCoLetrecNoUnboxed []    body = body
+mkCoLetrecNoUnboxed binds body
+  = ASSERT (all is_boxed_bind binds)
+    Let (Rec binds) body
+  where
+    is_boxed_bind (binder, rhs)
+      = (not . isUnboxedType . idType) binder
 \end{code}
 
-%************************************************************************
-%*                                                                     *
-\subsection[ParCommunicate]{Parallel Communication primitives}
-%*                                                                     *
-%************************************************************************
 \begin{code}
-#ifdef DPH
-data CoreParCommunicate binder bindee
-  = CoParSend  [CoreExpr binder bindee]     -- fns of form Integer -> Integer
-  | CoParFetch  [CoreExpr binder bindee]     -- to determine where moved
-  | CoToPodized
-  | CoFromPodized
-#endif {- Data Parallel Haskell -}
+mkCoLetUnboxedToCase bind@(Rec binds) body
+  = mkCoLetrecNoUnboxed binds body
+
+mkCoLetUnboxedToCase bind@(NonRec binder rhs) body
+  = case body of
+      Var binder2 | binder == binder2
+        -> rhs   -- hey, I have the rhs
+      other
+        -> if (not (isUnboxedType (idType binder))) then
+               Let bind body            -- boxed...
+           else
+               Case rhs                  -- unboxed...
+                 (PrimAlts []
+                   (BindDefault binder body))
+
+mkCoLetsUnboxedToCase []    expr = expr
+mkCoLetsUnboxedToCase binds expr = foldr mkCoLetUnboxedToCase expr binds
 \end{code}
 
 %************************************************************************
 %*                                                                     *
-\subsection[CoreCaseAlternatives]{Case alternatives in @CoreExpr@}
+\subsection{Case alternatives in @GenCoreExpr@}
 %*                                                                     *
 %************************************************************************
 
@@ -271,468 +292,283 @@ let# x=e in b
 \end{verbatim}
 becomes
 \begin{verbatim}
-CoCase e [ CoBindDefaultAlt x -> b ]
+Case e [ BindDefaultAlt x -> b ]
 \end{verbatim}
 
 \begin{code}
-data CoreCaseAlternatives binder bindee
-
-  = CoAlgAlts  [(Id,                           -- alts: data constructor,
-                 [binder],                     -- constructor's parameters,
-                 CoreExpr binder bindee)]      -- rhs.
-               (CoreCaseDefault binder bindee)
-
-  | CoPrimAlts [(BasicLit,                     -- alts: unboxed literal,
-                 CoreExpr binder bindee)]      -- rhs.
-               (CoreCaseDefault binder bindee)
-#ifdef DPH
-  | CoParAlgAlts 
-               TyCon
-               Int
-               [binder]
-               [(Id,
-                 CoreExpr binder bindee)]
-               (CoreCaseDefault binder bindee)
-
-  | CoParPrimAlts
-               TyCon
-               Int
-               [(BasicLit,
-                 CoreExpr binder bindee)]
-               (CoreCaseDefault binder bindee)
-#endif {- Data Parallel Haskell -}
+data GenCoreCaseAlts val_bdr val_occ tyvar uvar
+  = AlgAlts    [(Id,                           -- alts: data constructor,
+                 [val_bdr],                    -- constructor's parameters,
+                 GenCoreExpr val_bdr val_occ tyvar uvar)]      -- rhs.
+               (GenCoreCaseDefault val_bdr val_occ tyvar uvar)
+
+  | PrimAlts   [(Literal,                      -- alts: unboxed literal,
+                 GenCoreExpr val_bdr val_occ tyvar uvar)]      -- rhs.
+               (GenCoreCaseDefault val_bdr val_occ tyvar uvar)
 
 -- obvious things: if there are no alts in the list, then the default
--- can't be CoNoDefault.
+-- can't be NoDefault.
 
-data CoreCaseDefault binder bindee
-  = CoNoDefault                                        -- small con family: all
+data GenCoreCaseDefault val_bdr val_occ tyvar uvar
+  = NoDefault                                  -- small con family: all
                                                -- constructor accounted for
-  | CoBindDefault   binder                     -- form: var -> expr;
-                   (CoreExpr binder bindee)    -- "binder" may or may not
+  | BindDefault val_bdr                                -- form: var -> expr;
+               (GenCoreExpr val_bdr val_occ tyvar uvar)        -- "val_bdr" may or may not
                                                -- be used in RHS.
 \end{code}
 
+\begin{code}
+rhssOfAlts (AlgAlts alts deflt)  = rhssOfDeflt deflt ++ [rhs | (_,_,rhs) <- alts]
+rhssOfAlts (PrimAlts alts deflt) = rhssOfDeflt deflt ++ [rhs | (_,rhs)   <- alts]
+
+rhssOfDeflt NoDefault          = []
+rhssOfDeflt (BindDefault _ rhs) = [rhs]
+\end{code}
+
 %************************************************************************
 %*                                                                     *
-\subsection[CoreSyn-arguments]{Core ``argument'' wrapper type}
+\subsection{Core binders}
 %*                                                                     *
 %************************************************************************
 
 \begin{code}
-data CoreArg bindee
-  = TypeArg UniType
-  | ValArg  (CoreAtom bindee)
+data GenCoreBinder val_bdr tyvar uvar
+  = ValBinder  val_bdr
+  | TyBinder   tyvar
+  | UsageBinder        uvar
 
-instance Outputable bindee => Outputable (CoreArg bindee) where
-  ppr sty (ValArg atom) = ppr sty atom
-  ppr sty (TypeArg ty)  = ppr sty ty
+isValBinder (ValBinder _) = True
+isValBinder _            = False
+
+notValBinder = not . isValBinder
 \end{code}
 
+Clump Lams together if possible.
+
 \begin{code}
-mkCoTyApp expr ty = CoTyApp expr ty
+mkValLam :: [val_bdr]
+        -> GenCoreExpr val_bdr val_occ tyvar uvar
+        -> GenCoreExpr val_bdr val_occ tyvar uvar
+mkTyLam  :: [tyvar]
+        -> GenCoreExpr val_bdr val_occ tyvar uvar
+        -> GenCoreExpr val_bdr val_occ tyvar uvar
+mkUseLam :: [uvar]
+        -> GenCoreExpr val_bdr val_occ tyvar uvar
+        -> GenCoreExpr val_bdr val_occ tyvar uvar
 
-{- OLD: unboxed tyapps now allowed!
-mkCoTyApp expr ty
-#ifdef DEBUG
-  | isPrimType ty && not (error_app expr)
-  = pprPanic "mkCoTyApp:" (ppr PprDebug ty)
-#endif
-  | otherwise = ty_app
-  where
-    ty_app = CoTyApp expr ty
+mkValLam binders body = foldr (Lam . ValBinder)   body binders
+mkTyLam  binders body = foldr (Lam . TyBinder)    body binders
+mkUseLam binders body = foldr (Lam . UsageBinder) body binders
 
-    error_app (CoVar id) {-| isBottomingId id-} = True -- debugging
-       -- OOPS! can't do this because it forces
-       -- the bindee type to be Id (ToDo: what?) WDP 95/02
-    error_app _ = False
--}
-\end{code}
+mkLam :: [tyvar] -> [val_bdr] -- ToDo: could add a [uvar] arg...
+        -> GenCoreExpr val_bdr val_occ tyvar uvar
+        -> GenCoreExpr val_bdr val_occ tyvar uvar
 
-\begin{code}
-applyToArgs :: CoreExpr binder bindee
-           -> [CoreArg bindee]
-           -> CoreExpr binder bindee
-
-applyToArgs fun []                 = fun
-applyToArgs fun (ValArg val : args) = applyToArgs (CoApp     fun val) args
-applyToArgs fun (TypeArg ty : args) = applyToArgs (mkCoTyApp fun ty)  args
+mkLam tyvars valvars body
+  = mkTyLam tyvars (mkValLam valvars body)
 \end{code}
 
-@decomposeArgs@ just pulls of the contiguous TypeArg-then-ValArg block
-on the front of the args.  Pretty common.
+We often want to strip off leading lambdas before getting down to
+business.  @collectBinders@ is your friend.
+
+We expect (by convention) usage-, type-, and value- lambdas in that
+order.
 
 \begin{code}
-decomposeArgs :: [CoreArg bindee]
-             -> ([UniType], [CoreAtom bindee], [CoreArg bindee])
+collectBinders ::
+  GenCoreExpr val_bdr val_occ tyvar uvar ->
+  ([uvar], [tyvar], [val_bdr], GenCoreExpr val_bdr val_occ tyvar uvar)
 
-decomposeArgs [] = ([],[],[])
+collectBinders expr
+  = (usages, tyvars, vals, body)
+  where
+    (usages, tyvars, body1) = collectUsageAndTyBinders expr
+    (vals, body)           = collectValBinders body1
 
-decomposeArgs (TypeArg ty : args)
-  = case (decomposeArgs args) of { (tys, vals, rest) ->
-    (ty:tys, vals, rest) }
 
-decomposeArgs (ValArg val : args)
-  = case (do_vals args) of { (vals, rest) ->
-    ([], val:vals, rest) }
+collectUsageAndTyBinders expr
+  = usages expr []
   where
-    do_vals (ValArg val : args)
-      = case (do_vals args) of { (vals, rest) ->
-       (val:vals, rest) }
-       
-    do_vals args = ([], args)
-\end{code}
+    usages (Lam (UsageBinder u) body) uacc = usages body (u:uacc)
+    usages other uacc
+      = case (tyvars other []) of { (tacc, expr) ->
+       (reverse uacc, tacc, expr) }
 
-@collectArgs@ takes an application expression, returning the function
-and the arguments to which it is applied.
+    tyvars (Lam (TyBinder t) body) tacc = tyvars body (t:tacc)
+    tyvars other tacc
+      = ASSERT(not (usage_lambda other))
+       (reverse tacc, other)
 
-\begin{code}
-collectArgs :: CoreExpr binder bindee
-           -> (CoreExpr binder bindee, [CoreArg bindee])
+    ---------------------------------------
+    usage_lambda (Lam (UsageBinder _) _) = True
+    usage_lambda _                      = False
 
-collectArgs expr
-  = collect expr []
+    tyvar_lambda (Lam (TyBinder _) _)    = True
+    tyvar_lambda _                      = False
+
+
+collectValBinders :: GenCoreExpr val_bdr val_occ tyvar uvar ->
+                    ([val_bdr], GenCoreExpr val_bdr val_occ tyvar uvar)
+collectValBinders expr
+  = go [] expr
   where
-    collect (CoApp fun arg)  args = collect fun (ValArg arg : args)
-    collect (CoTyApp fun ty) args = collect fun (TypeArg ty : args)
-    collect other_expr args      = (other_expr, args)
+    go acc (Lam (ValBinder v) b) = go (v:acc) b
+    go acc body                 = (reverse acc, body)
+
 \end{code}
 
 %************************************************************************
 %*                                                                     *
-\subsection[CoreSyn-output]{Instance declarations for output}
+\subsection{Core arguments (atoms)}
 %*                                                                     *
 %************************************************************************
 
-@pprCoreBinding@ and @pprCoreExpr@ let you give special printing
-function for ``major'' binders (those next to equal signs :-),
-``minor'' ones (lambda-bound, case-bound), and bindees.  They would
-usually be called through some intermediary.
-
 \begin{code}
-pprCoreBinding
-       :: PprStyle
-       -> (PprStyle -> bndr -> Pretty) -- to print "major" binders
-       -> (PprStyle -> bndr -> Pretty) -- to print "minor" binders
-       -> (PprStyle -> bdee -> Pretty) -- to print bindees
-       -> CoreBinding bndr bdee
-       -> Pretty
-
-pprCoreBinding sty pbdr1 pbdr2 pbdee (CoNonRec binder expr)
-  = ppHang (ppCat [pbdr1 sty binder, ppEquals])
-        4 (pprCoreExpr sty pbdr1 pbdr2 pbdee expr)
-
-pprCoreBinding sty pbdr1 pbdr2 pbdee (CoRec binds)
-  = ppAboves [ifPprDebug sty (ppStr "{- CoRec -}"),
-             ppAboves (map ppr_bind binds),
-             ifPprDebug sty (ppStr "{- end CoRec -}")]
-  where
-    ppr_bind (binder, expr)
-      = ppHang (ppCat [pbdr1 sty binder, ppEquals])
-            4 (pprCoreExpr sty pbdr1 pbdr2 pbdee expr)
-\end{code}
+data GenCoreArg val_occ tyvar uvar
+  = LitArg     Literal
+  | VarArg     val_occ
+  | TyArg      (GenType tyvar uvar)
+  | UsageArg   (GenUsage uvar)
+\end{code}
+
+General and specific forms:
+\begin{code}
+mkGenApp :: GenCoreExpr val_bdr val_occ tyvar uvar
+        -> [GenCoreArg val_occ tyvar uvar]
+        -> GenCoreExpr val_bdr val_occ tyvar uvar
+mkTyApp  :: GenCoreExpr val_bdr val_occ tyvar uvar
+        -> [GenType tyvar uvar]
+        -> GenCoreExpr val_bdr val_occ tyvar uvar
+mkUseApp :: GenCoreExpr val_bdr val_occ tyvar uvar
+        -> [GenUsage uvar]
+        -> GenCoreExpr val_bdr val_occ tyvar uvar
+mkValApp :: GenCoreExpr val_bdr val_occ tyvar uvar
+        -> [GenCoreArg val_occ tyvar uvar] -- but we ASSERT they are LitArg or VarArg
+        -> GenCoreExpr val_bdr val_occ tyvar uvar
+
+mkGenApp f args = foldl App                               f args
+mkTyApp  f args = foldl (\ e a -> App e (TyArg a))        f args
+mkUseApp f args = foldl (\ e a -> App e (UsageArg a))     f args
+mkValApp f args = foldl (\ e a -> App e (is_Lit_or_Var a)) f args
+
+#ifndef DEBUG
+is_Lit_or_Var a = a
+#else
+is_Lit_or_Var a
+  = if isValArg a then a else panic "CoreSyn.mkValApps:not LitArg or VarArg"
+#endif
 
-\begin{code}
-instance (Outputable bndr, Outputable bdee)
-               => Outputable (CoreBinding bndr bdee) where
-    ppr sty bind = pprCoreBinding sty ppr ppr ppr bind
+isValArg (LitArg _) = True  -- often used for sanity-checking
+isValArg (VarArg _) = True
+isValArg _         = False
 
-instance (Outputable bndr, Outputable bdee)
-               => Outputable (CoreExpr bndr bdee) where
-    ppr sty expr = pprCoreExpr sty ppr ppr ppr expr
+notValArg = not . isValArg -- exists only because it's a common use of isValArg
 
-instance Outputable bdee => Outputable (CoreAtom bdee) where
-    ppr sty atom = pprCoreAtom sty ppr atom
+numValArgs as = length [ a | a <- as, isValArg a ] -- again, convenience
 \end{code}
 
 \begin{code}
-pprCoreAtom
-       :: PprStyle
-       -> (PprStyle -> bdee -> Pretty) -- to print bindees
-       -> CoreAtom bdee
-       -> Pretty
-
-pprCoreAtom sty pbdee (CoLitAtom lit) = ppr sty lit
-pprCoreAtom sty pbdee (CoVarAtom v)   = pbdee sty v
+mkApp  fun = mk_thing (mkGenApp fun)
+mkCon  con = mk_thing (Con      con)
+mkPrim op  = mk_thing (Prim     op)
+
+mk_thing thing uses tys vals
+  = thing (map UsageArg uses ++ map TyArg tys ++ map is_Lit_or_Var vals)
 \end{code}
 
+@collectArgs@ takes an application expression, returning the function
+and the arguments to which it is applied.
+
 \begin{code}
-pprCoreExpr, pprParendCoreExpr
-       :: PprStyle
-       -> (PprStyle -> bndr -> Pretty) -- to print "major" binders
-       -> (PprStyle -> bndr -> Pretty) -- to print "minor" binders
-       -> (PprStyle -> bdee -> Pretty) -- to print bindees
-       -> CoreExpr bndr bdee
-       -> Pretty
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (CoVar name) = pbdee sty name
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (CoLit literal) = ppr sty literal
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (CoCon con [] []) = ppr sty con
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (CoCon con types args)
-  = ppHang (ppBesides [ppr sty con, ppChar '!'])
-        4 (ppSep (  (map (pprParendUniType sty) types)
-                 ++ (map (pprCoreAtom sty pbdee) args)))
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (CoPrim prim tys args)
-  = ppHang (ppBesides [ppr sty prim, ppChar '!'])
-        4 (ppSep (  (map (pprParendUniType sty) tys)
-                 ++ (map (pprCoreAtom sty pbdee) args) ))
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (CoLam binders expr)
-  = ppHang (ppCat [ppStr "\\", ppInterleave ppSP (map (pbdr2 sty) binders), ppStr "->"])
-        4 (pprCoreExpr sty pbdr1 pbdr2 pbdee expr)
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (CoTyLam tyvar expr)
-  = ppHang (ppCat [ppStr "/\\", interppSP sty (tyvar:tyvars),
-                  ppStr "->", pp_varss var_lists])
-          4 (pprCoreExpr sty pbdr1 pbdr2 pbdee expr_after)
-  where
-    (tyvars, var_lists, expr_after) = collect_tyvars expr
-
-    collect_tyvars (CoTyLam tyv e) = ( tyv:tyvs, vs, e_after )
-      where (tyvs, vs, e_after) = collect_tyvars e
-    collect_tyvars e@(CoLam _ _)   = ( [], vss, e_after )
-      where (vss, e_after) = collect_vars e
-    collect_tyvars other_e        = ( [], [], other_e )
-
-    collect_vars (CoLam vars e) = (vars:varss, e_after)
-      where (varss, e_after) = collect_vars e
-    collect_vars other_e          = ( [], other_e )
-
-    pp_varss [] = ppNil
-    pp_varss (vars:varss)
-      = ppCat [ppStr "\\", ppInterleave ppSP (map (pbdr2 sty) vars),
-              ppStr "->", pp_varss varss]
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee expr@(CoApp fun_expr atom)
-  = let
-       (fun, args) = collect_args expr []
-    in
-    ppHang (pprParendCoreExpr sty pbdr1 pbdr2 pbdee fun)
-        4 (ppSep (map (pprCoreAtom sty pbdee) args))
-  where
-    collect_args (CoApp fun arg) args = collect_args fun (arg:args)
-    collect_args fun            args = (fun, args)
+collectArgs :: GenCoreExpr val_bdr val_occ tyvar uvar
+           -> (GenCoreExpr val_bdr val_occ tyvar uvar,
+               [GenUsage uvar],
+               [GenType tyvar uvar],
+               [GenCoreArg val_occ tyvar uvar]{-ValArgs-})
 
-pprCoreExpr sty pbdr1 pbdr2 pbdee (CoTyApp expr ty)
-  = ppHang (ppBeside pp_note (pprParendCoreExpr sty pbdr1 pbdr2 pbdee expr))
-        4 (pprParendUniType sty ty)
+collectArgs expr
+  = valvars expr []
   where
-    pp_note = ifPprShowAll sty (ppStr "{-CoTyApp-} ")
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (CoCase expr alts)
-  = ppSep [ppSep [ppStr "case", ppNest 4 (pprParendCoreExpr sty pbdr1 pbdr2 pbdee expr),
-                    ppStr "of {"],
-          ppNest 2 (pprCoreCaseAlts sty pbdr1 pbdr2 pbdee alts),
-          ppStr "}"]
-
--- special cases: let ... in let ...
--- ("disgusting" SLPJ)
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (CoLet bind@(CoNonRec binder rhs@(CoLet _ _)) body)
-  = ppAboves [
-      ppCat [ppStr "let {", pbdr1 sty binder, ppEquals],
-      ppNest 2 (pprCoreExpr sty pbdr1 pbdr2 pbdee rhs),
-      ppStr "} in",
-      pprCoreExpr sty pbdr1 pbdr2 pbdee body ]
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (CoLet bind@(CoNonRec binder rhs) expr@(CoLet _ _))
-  = ppAbove
-      (ppHang (ppStr "let {")
-           2 (ppCat [ppHang (ppCat [pbdr1 sty binder, ppEquals])
-                          4 (pprCoreExpr sty pbdr1 pbdr2 pbdee rhs),
-       ppStr "} in"]))
-      (pprCoreExpr sty pbdr1 pbdr2 pbdee expr)
-
--- general case (recursive case, too)
-pprCoreExpr sty pbdr1 pbdr2 pbdee (CoLet bind expr)
-  = ppSep [ppHang (ppStr "let {") 2 (pprCoreBinding sty pbdr1 pbdr2 pbdee bind),
-          ppHang (ppStr "} in ") 2 (pprCoreExpr    sty pbdr1 pbdr2 pbdee expr)]
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (CoSCC cc expr)
-  = ppSep [ ppCat [ppStr "_scc_", ppStr (showCostCentre sty True{-as string-} cc)],
-           pprParendCoreExpr sty pbdr1 pbdr2 pbdee expr ]
-#ifdef DPH
-pprCoreExpr sty pbdr1 pbdr2 pbdee (CoZfExpr expr quals)
-    = ppHang (ppCat [ppStr "<<" , pprCoreExpr sty pbdr1 pbdr2 pbdee expr , ppStr "|"])
-         4 (ppSep [pprParQuals sty pbdr1 pbdr2 pbdee quals, ppStr ">>"])
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (CoParCon con dim types args)
-  = ppHang (ppBesides [ppr sty con, ppStr "!<<" , ppr sty dim , ppStr ">>"])
-          4 (ppSep (  (map (pprParendUniType sty) types)
-                   ++ (map (pprParendCoreExpr sty pbdr1 pbdr2 pbdee) args) ))
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (CoParComm dim expr comType)
-  = ppSep [ppSep [ppStr "COMM",
-                 ppNest 2 (pprParendCoreExpr sty pbdr1 pbdr2 pbdee expr),ppStr "{"],
-          ppNest 2 (ppr sty comType),
-          ppStr "}"]
-
-pprCoreExpr sty pbdr1 pbdr2 pbdee (CoParZipWith dim expr exprs)
-  = ppHang (ppBesides [ ppStr "CoParZipWith {" , ppr sty dim , ppStr "}",
-                       pprParendCoreExpr sty pbdr1 pbdr2 pbdee expr])
-          4 (ppr sty exprs)
-#endif {- Data Parallel Haskell -}
-\end{code}
+    valvars (App fun v) vacc | isValArg v = valvars fun (v:vacc)
+    valvars fun vacc
+      = case (tyvars fun []) of { (expr, uacc, tacc) ->
+       (expr, uacc, tacc, vacc) }
 
-\begin{code}
-pprParendCoreExpr sty pbdr1 pbdr2 pbdee e@(CoVar _) = pprCoreExpr sty pbdr1 pbdr2 pbdee e
-pprParendCoreExpr sty pbdr1 pbdr2 pbdee e@(CoLit _) = pprCoreExpr sty pbdr1 pbdr2 pbdee e
-pprParendCoreExpr sty pbdr1 pbdr2 pbdee other_e
-  = ppBesides [ppLparen, pprCoreExpr sty pbdr1 pbdr2 pbdee other_e, ppRparen]
-\end{code}
+    tyvars (App fun (TyArg t))    tacc = tyvars fun (t:tacc)
+    tyvars fun tacc
+      = case (usages fun []) of { (expr, uacc) ->
+       (expr, uacc, tacc) }
 
-\begin{code}
-instance (Outputable bndr, Outputable bdee)
-               => Outputable (CoreCaseAlternatives bndr bdee) where
-    ppr sty alts = pprCoreCaseAlts sty ppr ppr ppr alts
+    usages (App fun (UsageArg u)) uacc = usages fun (u:uacc)
+    usages fun uacc
+      = (fun,uacc)
 \end{code}
 
+
 \begin{code}
-pprCoreCaseAlts
-       :: PprStyle
-       -> (PprStyle -> bndr -> Pretty) -- to print "major" binders
-       -> (PprStyle -> bndr -> Pretty) -- to print "minor" binders
-       -> (PprStyle -> bdee -> Pretty) -- to print bindees
-       -> CoreCaseAlternatives bndr bdee
-       -> Pretty
-
-pprCoreCaseAlts sty pbdr1 pbdr2 pbdee (CoAlgAlts alts deflt)
-  = ppAboves [ ppAboves (map ppr_alt alts),
-              pprCoreCaseDefault sty pbdr1 pbdr2 pbdee deflt ]
-  where
-    ppr_alt (con, params, expr)
-      = ppHang (ppCat [ppr_con con,
-                      ppInterleave ppSP (map (pbdr2 sty) params),
-                      ppStr "->"])
-               4 (pprCoreExpr sty pbdr1 pbdr2 pbdee expr)
-      where
-       ppr_con con
-         = if isOpLexeme con
-           then ppBesides [ppLparen, ppr sty con, ppRparen]
-           else ppr sty con
-
-pprCoreCaseAlts sty pbdr1 pbdr2 pbdee (CoPrimAlts alts deflt)
-  = ppAboves [ ppAboves (map ppr_alt alts),
-              pprCoreCaseDefault sty pbdr1 pbdr2 pbdee deflt ]
-  where
-    ppr_alt (lit, expr)
-      = ppHang (ppCat [ppr sty lit, ppStr "->"])
-            4 (pprCoreExpr sty pbdr1 pbdr2 pbdee expr)
-
-#ifdef DPH
--- ToDo: niceties of printing
--- using special binder/bindee printing funs, rather than just "ppr"
-
-pprCoreCaseAlts sty pbdr1 pbdr2 pbdee (CoParAlgAlts tycon dim params alts deflt)
-  = ppAboves [ ifPprShowAll sty (ppr sty tycon),
-              ppBeside (ppCat (map (ppr sty) params))
-                       (ppCat [ppStr "|" , ppr sty dim , ppStr "|"]),
-              ppAboves (map (ppr_alt sty) alts),
-              ppr sty deflt ]
-  where
-    ppr_alt sty (con, expr)
-      = ppHang (ppCat [ppStr "\\/", ppr_con sty con, ppStr "->"])
-               4 (ppr sty expr)
-      where
-       ppr_con sty con
-         = if isOpLexeme con
-           then ppBesides [ppLparen, ppr sty con, ppRparen]
-           else ppr sty con
-
-pprCoreCaseAlts sty pbdr1 pbdr2 pbdee (CoParPrimAlts tycon dim alts deflt)
-  = ppAboves [ ifPprShowAll sty (ppr sty tycon),
-              ppCat [ppStr "|" , ppr sty dim , ppStr "|"],
-              ppAboves (map (ppr_alt sty) alts),
-              ppr sty deflt ]
-  where
-    ppr_alt sty (lit, expr)
-      = ppHang (ppCat [ppStr "\\/", ppr sty lit, ppStr "->"]) 4 (ppr sty expr)
+initialTyArgs :: [GenCoreArg val_occ tyvar uvar]
+             -> ([GenType tyvar uvar], [GenCoreArg val_occ tyvar uvar])
+initialTyArgs (TyArg ty : args) = (ty:tys, args') 
+                               where
+                                 (tys, args') = initialTyArgs args
+initialTyArgs other            = ([],other)
 
-#endif /* Data Parallel Haskell */
+initialValArgs :: [GenCoreArg val_occ tyvar uvar]
+             -> ([GenCoreArg val_occ tyvar uvar], [GenCoreArg val_occ tyvar uvar])
+initialValArgs args = span isValArg args
 \end{code}
 
-\begin{code}
-instance (Outputable bndr, Outputable bdee)
-               => Outputable (CoreCaseDefault bndr bdee) where
-    ppr sty deflt  = pprCoreCaseDefault sty ppr ppr ppr deflt
-\end{code}
+
+%************************************************************************
+%*                                                                     *
+\subsection{The main @Core*@ instantiation of the @GenCore*@ types}
+%*                                                                     *
+%************************************************************************
 
 \begin{code}
-pprCoreCaseDefault
-       :: PprStyle
-       -> (PprStyle -> bndr -> Pretty) -- to print "major" binders
-       -> (PprStyle -> bndr -> Pretty) -- to print "minor" binders
-       -> (PprStyle -> bdee -> Pretty) -- to print bindees
-       -> CoreCaseDefault bndr bdee
-       -> Pretty
-
-pprCoreCaseDefault sty pbdr1 pbdr2 pbdee CoNoDefault = ppNil
-
-pprCoreCaseDefault sty pbdr1 pbdr2 pbdee (CoBindDefault binder expr)
-  = ppHang (ppCat [pbdr2 sty binder, ppStr "->"])
-        4 (pprCoreExpr sty pbdr1 pbdr2 pbdee expr)
+type CoreBinding = GenCoreBinding  Id Id TyVar UVar
+type CoreExpr    = GenCoreExpr     Id Id TyVar UVar
+type CoreBinder         = GenCoreBinder   Id    TyVar UVar
+type CoreArg     = GenCoreArg         Id TyVar UVar
+
+type CoreCaseAlts    = GenCoreCaseAlts    Id Id TyVar UVar
+type CoreCaseDefault = GenCoreCaseDefault Id Id TyVar UVar
 \end{code}
 
+%************************************************************************
+%*                                                                     *
+\subsection{The @TaggedCore*@ instantiation of the @GenCore*@ types}
+%*                                                                     *
+%************************************************************************
+
+Binders are ``tagged'' with a \tr{t}:
 \begin{code}
-#ifdef DPH
-instance (Outputable bndr, Outputable bdee)
-               => Outputable (CoreParQuals bndr bdee) where
-    ppr sty qual = pprParQuals sty ppr ppr ppr qual
-
-pprParQuals sty pbdr1 pbdr2 pbdee (CoAndQuals x y) 
-     = ppAboves [(ppBesides [pprParQuals sty pbdr1 pbdr2 pbdee x , ppComma]) , pprParQuals sty pbdr1 pbdr2 pbdee y]
-
-pprParQuals sty pbdr1 pbdr2 pbdee (CoDrawnGen pats pat expr)
-     = ppCat [ppStr "(|",
-              ppInterleave ppComma (map (ppr sty) pats),
-              ppSemi, ppr sty pat,ppStr "|)",
-              ppStr "<<-", pprCoreExpr sty pbdr1 pbdr2 pbdee expr]
-
-pprParQuals sty pbdr1 pbdr2 pbdee (CoIndexGen exprs pat expr)
-     = ppCat [ppStr "(|",
-              ppInterleave ppComma (map (pprCoreExpr sty pbdr1 pbdr2 pbdee) exprs),
-              ppSemi, ppr sty pat,ppStr "|)",
-              ppStr "<<=", pprCoreExpr sty pbdr1 pbdr2 pbdee expr]
-
-pprParQuals sty pbdr1 pbdr2 pbdee (CoParFilter expr)
-     = pprParendCoreExpr sty pbdr1 pbdr2 pbdee expr
-#endif {- Data Parallel Haskell -}
+type Tagged t = (Id, t)
+
+type TaggedCoreBinding t = GenCoreBinding (Tagged t) Id TyVar UVar
+type TaggedCoreExpr    t = GenCoreExpr    (Tagged t) Id TyVar UVar
+type TaggedCoreBinder  t = GenCoreBinder  (Tagged t)    TyVar UVar
+type TaggedCoreArg     t = GenCoreArg                Id TyVar UVar
+
+type TaggedCoreCaseAlts    t = GenCoreCaseAlts    (Tagged t) Id TyVar UVar
+type TaggedCoreCaseDefault t = GenCoreCaseDefault (Tagged t) Id TyVar UVar
 \end{code}
 
+%************************************************************************
+%*                                                                     *
+\subsection{The @SimplifiableCore*@ instantiation of the @GenCore*@ types}
+%*                                                                     *
+%************************************************************************
+
+Binders are tagged with @BinderInfo@:
 \begin{code}
-#ifdef DPH
-instance (Outputable bndr, Outputable bdee)
-               => Outputable (CoreParCommunicate bndr bdee) where
-    ppr sty c = pprCoreParCommunicate sty ppr ppr ppr c
-
-pprCoreParCommunicate sty pbdr1 pbdr2 pbdee (CoParSend fns)
-  = ppHang 
-       (ppStr "SEND") 
-       4 
-       (ppAboves (zipWith ppSendFns fns ([1..]::[Int])))
-  where
-     ppSendFns expr dim 
-        = ppCat [ppStr "Dim" , ppr sty dim , ppStr "=" , 
-                pprParendCoreExpr sty pbdr1 pbdr2 pbdee expr ]
-
-pprCoreParCommunicate sty pbdr1 pbdr2 pbdee (CoParFetch fns)
-  = ppHang 
-       (ppStr "FETCH") 
-       4 
-       (ppAboves (zipWith ppSendFns fns ([1..]::[Int])))
-  where
-     ppSendFns expr dim 
-        = ppCat [ppStr "Dim" , ppr sty dim , ppStr "=" , 
-                pprParendCoreExpr sty pbdr1 pbdr2 pbdee expr ]
+type Simplifiable = (Id, BinderInfo)
 
-pprCoreParCommunicate sty pbdr1 pbdr2 pbdee (CoToPodized)
-  = ppStr "ConvertToPodized"
+type SimplifiableCoreBinding = GenCoreBinding Simplifiable Id TyVar UVar
+type SimplifiableCoreExpr    = GenCoreExpr    Simplifiable Id TyVar UVar
+type SimplifiableCoreBinder  = GenCoreBinder  Simplifiable    TyVar UVar
+type SimplifiableCoreArg     = GenCoreArg                  Id TyVar UVar
 
-pprCoreParCommunicate sty pbdr1 pbdr2 pbdee (CoFromPodized)
-  = ppStr "ConvertFromPodized"
-#endif {- Data Parallel Haskell -}
+type SimplifiableCoreCaseAlts    = GenCoreCaseAlts    Simplifiable Id TyVar UVar
+type SimplifiableCoreCaseDefault = GenCoreCaseDefault Simplifiable Id TyVar UVar
 \end{code}