[project @ 1997-05-18 23:12:10 by sof]

Removed the attribution of variable arities

diff --git a/ghc/compiler/stgSyn/CoreToStg.lhs b/ghc/compiler/stgSyn/CoreToStg.lhs
index 7aaefe6..1042d3c 100644 (file)
--- a/ghc/compiler/stgSyn/CoreToStg.lhs
+++ b/ghc/compiler/stgSyn/CoreToStg.lhs
@@ -23,12 +23,11 @@ import StgSyn               -- output
 import Bag             ( emptyBag, unitBag, unionBags, unionManyBags, bagToList )
 import CoreUtils       ( coreExprType )
 import CostCentre      ( noCostCentre )
-import Id              ( mkSysLocal, idType, isBottomingId, addIdArity,
+import Id              ( mkSysLocal, idType, isBottomingId,
                          externallyVisibleId,
                          nullIdEnv, addOneToIdEnv, lookupIdEnv, growIdEnvList,
-                         SYN_IE(IdEnv), GenId{-instance NamedThing-}
+                         SYN_IE(IdEnv), GenId{-instance NamedThing-}, SYN_IE(Id)
                        )
-import IdInfo          ( ArityInfo, exactArity )
 import Literal         ( mkMachInt, Literal(..) )
 import PrelVals                ( unpackCStringId, unpackCString2Id,
                          integerZeroId, integerPlusOneId,
@@ -38,7 +37,7 @@ import PrimOp         ( PrimOp(..) )
 import SpecUtils       ( mkSpecialisedCon )
 import SrcLoc          ( noSrcLoc )
 import TyCon           ( TyCon{-instance Uniquable-} )
-import Type            ( maybeAppDataTyCon, getAppDataTyConExpandingDicts )
+import Type            ( maybeAppDataTyCon, getAppDataTyConExpandingDicts, SYN_IE(Type) )
 import TysWiredIn      ( stringTy )
 import Unique          ( integerTyConKey, ratioTyConKey, Unique{-instance Eq-} )
 import UniqSupply      -- all of it, really
@@ -63,12 +62,10 @@ The business of this pass is to convert Core to Stg.  On the way:
        x = y t1 t2
   where t1, t2 are types
 
-* We pin correct arities on each let(rec)-bound binder, and propagate them
-  to their uses.  This is used
-       a) when emitting arity info into interface files
-       b) in the code generator, when deciding if a right-hand side
-                is a saturated application so we can generate a VAP closure.
-  (b) is rather untidy, but the easiest compromise was to propagate arities here.
+* We don't pin on correct arities any more, because they can be mucked up
+  by the lambda lifter.  In particular, the lambda lifter can take a local
+  letrec-bound variable and make it a lambda argument, which shouldn't have
+  an arity.  So SetStgVarInfo sets arities now.
 
 * We do *not* pin on the correct free/live var info; that's done later.
   Instead we use bOGUS_LVS and _FVS as a placeholder.
@@ -137,9 +134,8 @@ coreBindToStg env (NonRec binder rhs)
   = coreRhsToStg env rhs       `thenUs` \ stg_rhs ->
     let
        -- Binds to return if RHS is trivial
-       binder_w_arity = binder `addIdArity` (rhsArity stg_rhs)
-       triv_binds | externallyVisibleId binder = [StgNonRec binder_w_arity stg_rhs]    -- Retain it
-                  | otherwise                  = []                                    -- Discard it
+       triv_binds | externallyVisibleId binder = [StgNonRec binder stg_rhs]    -- Retain it
+                  | otherwise                  = []                            -- Discard it
     in
     case stg_rhs of
       StgRhsClosure cc bi fvs upd [] (StgApp atom [] lvs) ->
@@ -155,10 +151,7 @@ coreBindToStg env (NonRec binder rhs)
                new_env = addOneToIdEnv env binder (StgConArg con_id)
 
       other ->         -- Non-trivial RHS, so don't augment envt
-               returnUs ([StgNonRec binder_w_arity stg_rhs], new_env)
-          where
-               new_env = addOneToIdEnv env binder (StgVarArg binder_w_arity)
-               -- new_env propagates the arity
+               returnUs ([StgNonRec binder stg_rhs], env)
 
 coreBindToStg env (Rec pairs)
   = -- NB: *** WE DO NOT CHECK FOR TRIV_BINDS in REC BIND ****
@@ -167,14 +160,7 @@ coreBindToStg env (Rec pairs)
        (binders, rhss) = unzip pairs
     in
     mapUs (coreRhsToStg env) rhss `thenUs` \ stg_rhss ->
-    let        
-           binders_w_arities = [ b `addIdArity` rhsArity rhs 
-                               | (b,rhs) <- binders `zip` stg_rhss]
-    in
-    returnUs ([StgRec (binders_w_arities `zip` stg_rhss)], env)
-
-rhsArity (StgRhsClosure _ _ _ _ args _) = exactArity (length args)
-rhsArity (StgRhsCon _ _ _)             = exactArity 0
+    returnUs ([StgRec (binders `zip` stg_rhss)], env)
 \end{code}
 
 
@@ -279,7 +265,7 @@ coreExprToStg env expr@(Lam _ _)
     else
        newStgVar (coreExprType expr)   `thenUs` \ var ->
        returnUs
-         (StgLet (StgNonRec (var `addIdArity` exactArity (length binders))
+         (StgLet (StgNonRec var
                                  (StgRhsClosure noCostCentre
                                  stgArgOcc
                                  bOGUS_FVs