[project @ 1996-12-19 09:10:02 by simonpj]

SLPJ new renamer and lots more

6 files changed, 37 insertions, 549 deletions

diff --git a/ghc/compiler/simplStg/LambdaLift.lhs b/ghc/compiler/simplStg/LambdaLift.lhs
index 5f14b609f2..29ed3952b6 100644
--- a/ghc/compiler/simplStg/LambdaLift.lhs
+++ b/ghc/compiler/simplStg/LambdaLift.lhs
@@ -13,12 +13,13 @@ IMP_Ubiq(){-uitous-}
 import StgSyn
 
 import Bag		( emptyBag, unionBags, unitBag, snocBag, bagToList )
-import Id		( idType, mkSysLocal, addIdArity,
+import Id		( idType, mkSysLocal, addIdArity, 
 			  mkIdSet, unitIdSet, minusIdSet,
 			  unionManyIdSets, idSetToList, SYN_IE(IdSet),
 			  nullIdEnv, growIdEnvList, lookupIdEnv, SYN_IE(IdEnv)
 			)
-import SrcLoc		( mkUnknownSrcLoc )
+import IdInfo		( ArityInfo, exactArity )
+import SrcLoc		( noSrcLoc )
 import Type		( splitForAllTy, mkForAllTys, mkFunTys )
 import UniqSupply	( getUnique, splitUniqSupply )
 import Util		( zipEqual, panic, assertPanic )
@@ -441,8 +442,8 @@ newSupercombinator :: Type
 		   -> LiftM Id
 
 newSupercombinator ty arity ci us idenv
-  = (mkSysLocal SLIT("sc") uniq ty mkUnknownSrcLoc)	-- ToDo: improve location
-    `addIdArity` arity
+  = (mkSysLocal SLIT("sc") uniq ty noSrcLoc)	-- ToDo: improve location
+    `addIdArity` exactArity arity
 	-- ToDo: rm the addIdArity?  Just let subsequent stg-saturation pass do it?
   where
     uniq = getUnique us
diff --git a/ghc/compiler/simplStg/SatStgRhs.lhs b/ghc/compiler/simplStg/SatStgRhs.lhs
index 725bf48e65..a61c2c3017 100644
--- a/ghc/compiler/simplStg/SatStgRhs.lhs
+++ b/ghc/compiler/simplStg/SatStgRhs.lhs
@@ -69,8 +69,7 @@ import Id		( idType, getIdArity, addIdArity, mkSysLocal,
 			  nullIdEnv, addOneToIdEnv, growIdEnvList,
 			  lookupIdEnv, SYN_IE(IdEnv)
 			)
-import IdInfo		( arityMaybe )
-import SrcLoc		( mkUnknownSrcLoc )
+import SrcLoc		( noSrcLoc )
 import Type		( splitSigmaTy, splitForAllTy, splitFunTyExpandingDicts )
 import UniqSupply	( returnUs, thenUs, mapUs, getUnique, SYN_IE(UniqSM) )
 import Util		( panic, assertPanic )
@@ -99,6 +98,10 @@ This pass
 
 \begin{code}
 satStgRhs :: [StgBinding] -> UniqSM [StgBinding]
+satStgRhs = panic "satStgRhs"
+
+{- 		NUKED FOR NOW  SLPJ Dec 96
+
 
 satStgRhs p = satProgram nullIdEnv p
 
@@ -305,5 +308,7 @@ lookupVar env v = case lookupIdEnv env v of
 newName :: Type -> UniqSM Id
 newName ut
   = getUnique	`thenUs` \ uniq ->
-    returnUs (mkSysLocal SLIT("sat") uniq ut mkUnknownSrcLoc)
+    returnUs (mkSysLocal SLIT("sat") uniq ut noSrcLoc)
+
+-}
 \end{code}
diff --git a/ghc/compiler/simplStg/SimplStg.lhs b/ghc/compiler/simplStg/SimplStg.lhs
index 1f45f077a0..2718501e6a 100644
--- a/ghc/compiler/simplStg/SimplStg.lhs
+++ b/ghc/compiler/simplStg/SimplStg.lhs
@@ -19,7 +19,6 @@ import Name		( isLocallyDefined )
 import SCCfinal		( stgMassageForProfiling )
 import SatStgRhs	( satStgRhs )
 import StgLint		( lintStgBindings )
-import StgSAT		( doStaticArgs )
 import StgStats	        ( showStgStats )
 import StgVarInfo	( setStgVarInfo )
 import UpdAnal		( updateAnalyse )
@@ -28,8 +27,7 @@ import CmdLineOpts	( opt_EnsureSplittableC, opt_SccGroup,
 			  opt_StgDoLetNoEscapes, opt_D_verbose_stg2stg,
 			  StgToDo(..)
 			)
-import Id		( externallyVisibleId,
-			  nullIdEnv, lookupIdEnv, addOneToIdEnv,
+import Id		( nullIdEnv, lookupIdEnv, addOneToIdEnv,
 			  growIdEnvList, isNullIdEnv, SYN_IE(IdEnv),
 			  GenId{-instance Eq/Outputable -}
 			)
@@ -39,7 +37,6 @@ import Pretty		( ppShow, ppAbove, ppAboves, ppStr )
 import UniqSupply	( splitUniqSupply )
 import Util		( mapAccumL, panic, assertPanic )
 
-unlocaliseId = panic "SimplStg.unlocaliseId (ToDo)"
 \end{code}
 
 \begin{code}
@@ -67,24 +64,23 @@ stg2stg stg_todos module_name ppr_style us binds
 	-- Do the main business!
     foldl_mn do_stg_pass (binds, us4now, ([],[])) stg_todos
 		>>= \ (processed_binds, _, cost_centres) ->
-	-- Do essential wind-up: part (a) is SatStgRhs
 
-	-- Not optional, because correct arity information is used by
-	-- the code generator.  Afterwards do setStgVarInfo; it gives
-	-- the wrong answers if arities are subsequently changed,
-	-- which stgSatRhs might do.  Furthermore, setStgVarInfo
-	-- decides about let-no-escape things, which in turn do a
-	-- better job if arities are correct, which is done by
-	-- satStgRhs.
+	-- 	Do essential wind-up
 
-    case (satStgRhs processed_binds us4later) of { saturated_binds ->
-
-	-- Essential wind-up: part (b), eliminate indirections
-
-    let no_ind_binds = elimIndirections saturated_binds in
+{- Nuked for now	SLPJ Dec 96
+	-- Essential wind-up: part (a), saturate RHSs
+	-- This must occur *after* elimIndirections, because elimIndirections
+	-- can change things' arities.  Consider:
+	--	x_local = f x
+	--	x_global = \a -> x_local a
+	-- Then elimIndirections will change the program to
+	--	x_global = f x
+	-- and lo and behold x_global's arity has changed!
 
+    case (satStgRhs processed_binds us4later) of { saturated_binds ->
+-}
 
-	-- Essential wind-up: part (c), do setStgVarInfo. It has to
+	-- Essential wind-up: part (b), do setStgVarInfo. It has to
 	-- happen regardless, because the code generator uses its
 	-- decorations.
 	--
@@ -94,24 +90,23 @@ stg2stg stg_todos module_name ppr_style us binds
 	-- things, which in turn do a better job if arities are
 	-- correct, which is done by satStgRhs.
 	--
+
+{-	Done in Core now.  Nuke soon. SLPJ Nov 96
     let
 		-- ToDo: provide proper flag control!
 	binds_to_mangle
 	  = if not do_unlocalising
-	    then no_ind_binds
+	    then saturated_binds
 	    else snd (unlocaliseStgBinds unlocal_tag nullIdEnv no_ind_binds)
     in
-    return (setStgVarInfo do_let_no_escapes binds_to_mangle, cost_centres)
-    }}
+-}
+
+    return (setStgVarInfo do_let_no_escapes processed_binds, cost_centres)
+   }
   where
     do_let_no_escapes  = opt_StgDoLetNoEscapes
     do_verbose_stg2stg = opt_D_verbose_stg2stg
 
-    (do_unlocalising, unlocal_tag)
-      = case (opt_EnsureSplittableC) of
-	      Nothing  -> (False, panic "tag")
-	      Just tag -> (True,  _PK_ tag)
-
     grp_name  = case (opt_SccGroup) of
 		  Just xx -> _PK_ xx
 		  Nothing -> module_name -- default: module name
@@ -127,13 +122,7 @@ stg2stg stg_todos module_name ppr_style us binds
 	    (us1, us2) = splitUniqSupply us
 	in
 	case to_do of
-	  StgDoStaticArgs ->
-	     ASSERT(null (fst ccs) && null (snd ccs))
-	     _scc_ "StgStaticArgs"
-	     let
-		 binds3 = doStaticArgs binds us1
-	     in
-	     end_pass us2 "StgStaticArgs" ccs binds3
+	  StgDoStaticArgs ->  panic "STG static argument transformation deleted"
 
 	  StgDoUpdateAnalysis ->
 	     ASSERT(null (fst ccs) && null (snd ccs))
@@ -186,166 +175,4 @@ foldl_mn f z (x:xs) = f z x	>>= \ zz ->
 		     foldl_mn f zz xs
 \end{code}
 
-%************************************************************************
-%*									*
-\subsection[SimplStg-unlocalise]{Unlocalisation in STG code}
-%*									*
-%************************************************************************
-
-The idea of all this ``unlocalise'' stuff is that in certain (prelude
-only) modules we split up the .hc file into lots of separate little
-files, which are separately compiled by the C compiler.  That gives
-lots of little .o files.  The idea is that if you happen to mention
-one of them you don't necessarily pull them all in.  (Pulling in a
-piece you don't need can be v bad, because it may mention other pieces
-you don't need either, and so on.)
-
-Sadly, splitting up .hc files means that local names (like s234) are
-now globally visible, which can lead to clashes between two .hc
-files. So unlocaliseWhatnot goes through making all the local things
-into global things, essentially by giving them full names so when they
-are printed they'll have their module name too.  Pretty revolting
-really.
 
-\begin{code}
-type UnlocalEnv = IdEnv Id
-
-lookup_uenv :: UnlocalEnv -> Id -> Id
-lookup_uenv env id =  case lookupIdEnv env id of
-			Nothing     -> id
-			Just new_id -> new_id
-
-unlocaliseStgBinds :: FAST_STRING -> UnlocalEnv -> [StgBinding] -> (UnlocalEnv, [StgBinding])
-
-unlocaliseStgBinds mod uenv [] = (uenv, [])
-
-unlocaliseStgBinds mod uenv (b : bs)
-  = case (unlocal_top_bind mod uenv b)	      of { (new_uenv, new_b) ->
-    case (unlocaliseStgBinds mod new_uenv bs) of { (uenv3, new_bs) ->
-    (uenv3, new_b : new_bs) }}
-
-------------------
-
-unlocal_top_bind :: FAST_STRING -> UnlocalEnv -> StgBinding -> (UnlocalEnv, StgBinding)
-
-unlocal_top_bind mod uenv bind@(StgNonRec binder _)
-  = let new_uenv = case unlocaliseId mod binder of
-			Nothing		-> uenv
-			Just new_binder -> addOneToIdEnv uenv binder new_binder
-    in
-    (new_uenv, renameTopStgBind (lookup_uenv new_uenv) bind)
-
-unlocal_top_bind mod uenv bind@(StgRec pairs)
-  = let maybe_unlocaliseds  = [ (b, unlocaliseId mod b) | (b, _) <- pairs ]
-	new_uenv	    = growIdEnvList uenv [ (b,new_b)
-						 | (b, Just new_b) <- maybe_unlocaliseds]
-    in
-    (new_uenv, renameTopStgBind (lookup_uenv new_uenv) bind)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[SimplStg-indirections]{Eliminating indirections in STG code}
-%*									*
-%************************************************************************
-
-In @elimIndirections@, we look for things at the top-level of the form...
-\begin{verbatim}
-    x_local = ....rhs...
-    ...
-    x_exported = x_local
-    ...
-\end{verbatim}
-In cases we find like this, we go {\em backwards} and replace
-\tr{x_local} with \tr{...rhs...}, to produce
-\begin{verbatim}
-    x_exported = ...rhs...
-    ...
-    ...
-\end{verbatim}
-This saves a gratuitous jump
-(from \tr{x_exported} to \tr{x_local}), and makes strictness
-information propagate better.
-
-If more than one exported thing is equal to a local thing (i.e., the
-local thing really is shared), then we eliminate only the first one.  Thus:
-\begin{verbatim}
-    x_local = ....rhs...
-    ...
-    x_exported1 = x_local
-    ...
-    x_exported2 = x_local
-    ...
-\end{verbatim}
-becomes
-\begin{verbatim}
-    x_exported1 = ....rhs...
-    ...
-    ...
-    x_exported2 = x_exported1
-    ...
-\end{verbatim}
-
-We also have to watch out for
-
-	f = \xyz -> g x y z
-
-This can arise post lambda lifting; the original might have been
-
-	f = \xyz -> letrec g = [xy] \ [k] -> e
-		    in
-		    g z
-
-Strategy: first collect the info; then make a \tr{Id -> Id} mapping.
-Then blast the whole program (LHSs as well as RHSs) with it.
-
-\begin{code}
-elimIndirections :: [StgBinding] -> [StgBinding]
-
-elimIndirections binds_in
-  = if isNullIdEnv blast_env then
-	binds_in	    -- Nothing to do
-    else
-	[renameTopStgBind lookup_fn bind | Just bind <- reduced_binds]
-  where
-    lookup_fn id = case lookupIdEnv blast_env id of
-			Just new_id -> new_id
-			Nothing     -> id
-
-    (blast_env, reduced_binds) = mapAccumL try_bind nullIdEnv binds_in
-
-    try_bind :: IdEnv Id -> StgBinding -> (IdEnv Id, Maybe StgBinding)
-    try_bind env_so_far
-	     (StgNonRec exported_binder
-		       (StgRhsClosure _ _ _ _
-				lambda_args
-				(StgApp (StgVarArg local_binder) fun_args _)
-	     ))
-	| externallyVisibleId exported_binder && -- Only if this is exported
-	  not (externallyVisibleId local_binder) && -- Only if this one is defined in this
-	  isLocallyDefined local_binder &&  -- module, so that we *can* change its
-					    -- binding to be the exported thing!
-	  not (in_dom env_so_far local_binder) && -- Only if we havn't seen it before
-	  args_match lambda_args fun_args   -- Just an eta-expansion
-
-	= (addOneToIdEnv env_so_far local_binder exported_binder,
-	   Nothing)
-	where
-	  args_match [] [] = True
-	  args_match (la:las) (StgVarArg fa:fas) = la == fa && args_match las fas
-	  args_match _  _  = False
-
-    try_bind env_so_far bind
-	= (env_so_far, Just bind)
-
-    in_dom env id = maybeToBool (lookupIdEnv env id)
-\end{code}
-
-@renameTopStgBind@ renames top level binders and all occurrences thereof.
-
-\begin{code}
-renameTopStgBind :: (Id -> Id) -> StgBinding -> StgBinding
-
-renameTopStgBind fn (StgNonRec b rhs) = StgNonRec (fn b) (mapStgBindeesRhs fn rhs)
-renameTopStgBind fn (StgRec pairs)    = StgRec [ (fn b, mapStgBindeesRhs fn r) | (b, r) <- pairs ]
-\end{code}
diff --git a/ghc/compiler/simplStg/StgSAT.lhs b/ghc/compiler/simplStg/StgSAT.lhs
deleted file mode 100644
index 9e356f0b87..0000000000
--- a/ghc/compiler/simplStg/StgSAT.lhs
+++ /dev/null
@@ -1,178 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
-%
-%************************************************************************
-%*									*
-\section[SAT]{Static Argument Transformation pass}
-%*									*
-%************************************************************************
-
-May be seen as removing invariants from loops:
-Arguments of recursive functions that do not change in recursive
-calls are removed from the recursion, which is done locally
-and only passes the arguments which effectively change.
-
-Example:
-map = /\ ab -> \f -> \xs -> case xs of
-			     []	   -> []
-			     (a:b) -> f a : map f b
-
-as map is recursively called with the same argument f (unmodified)
-we transform it to
-
-map = /\ ab -> \f -> \xs -> let map' ys = case ys of
-					   []	 -> []
-					   (a:b) -> f a : map' b
-			    in map' xs
-
-Notice that for a compiler that uses lambda lifting this is
-useless as map' will be transformed back to what map was.
-
-\begin{code}
-#include "HsVersions.h"
-
-module StgSAT (	doStaticArgs ) where
-
-IMP_Ubiq(){-uitous-}
-
-import StgSyn
-import UniqSupply	( SYN_IE(UniqSM) )
-import Util		( panic )
-\end{code}
-
-\begin{code}
-doStaticArgs :: [StgBinding] -> UniqSupply -> [StgBinding]
-
-doStaticArgs = panic "StgSAT.doStaticArgs"
-
-{- LATER: to end of file:
-doStaticArgs binds
-  = initSAT (mapSAT sat_bind binds)
-  where
-    sat_bind (StgNonRec binder expr)
-      = emptyEnvSAT  `thenSAT_`
-	satRhs expr `thenSAT` (\ expr' ->
-	returnSAT (StgNonRec binder expr'))
-    sat_bind (StgRec [(binder,rhs)])
-      = emptyEnvSAT			  `thenSAT_`
-	insSAEnv binder (getArgLists rhs) `thenSAT_`
-	satRhs rhs			  `thenSAT` (\ rhs' ->
-	saTransform binder rhs')
-    sat_bind (StgRec pairs)
-      = emptyEnvSAT		`thenSAT_`
-	mapSAT satRhs rhss	`thenSAT` \ rhss' ->
-	returnSAT (StgRec (binders `zip` rhss'))
-      where
-	(binders, rhss)	= unzip pairs
-\end{code}
-
-\begin{code}
-satAtom (StgVarArg v)
-  = updSAEnv (Just (v,([],[]))) `thenSAT_`
-    returnSAT ()
-
-satAtom _ = returnSAT ()
-\end{code}
-
-\begin{code}
-satExpr :: StgExpr -> SatM StgExpr
-
-satExpr e@(StgCon con args lvs)
-  = mapSAT satAtom args	    `thenSAT_`
-    returnSAT e
-
-satExpr e@(StgPrim op args lvs)
-  = mapSAT satAtom args	    `thenSAT_`
-    returnSAT e
-
-satExpr e@(StgApp (StgLitArg _) _ _)
-  = returnSAT e
-
-satExpr e@(StgApp (StgVarArg v) args _)
-  = updSAEnv (Just (v,([],map tagArg args)))	`thenSAT_`
-    mapSAT satAtom args				`thenSAT_`
-    returnSAT e
-  where
-    tagArg (StgVarArg v) = Static v
-    tagArg _              = NotStatic
-
-satExpr (StgCase expr lv1 lv2 uniq alts)
-  = satExpr expr	`thenSAT` \ expr' ->
-    sat_alts alts	`thenSAT` \ alts' ->
-    returnSAT (StgCase expr' lv1 lv2 uniq alts')
-  where
-    sat_alts (StgAlgAlts ty alts deflt)
-      = mapSAT satAlgAlt alts	    `thenSAT` \ alts' ->
-	sat_default deflt	    `thenSAT` \ deflt' ->
-	returnSAT (StgAlgAlts ty alts' deflt')
-      where
-	satAlgAlt (con, params, use_mask, rhs)
-	  = satExpr rhs		 `thenSAT` \ rhs' ->
-	    returnSAT (con, params, use_mask, rhs')
-
-    sat_alts (StgPrimAlts ty alts deflt)
-      = mapSAT satPrimAlt alts	    `thenSAT` \ alts' ->
-	sat_default deflt	    `thenSAT` \ deflt' ->
-	returnSAT (StgPrimAlts ty alts' deflt')
-      where
-	satPrimAlt (lit, rhs)
-	  = satExpr rhs `thenSAT` \ rhs' ->
-	    returnSAT (lit, rhs')
-
-    sat_default StgNoDefault
-      = returnSAT StgNoDefault
-    sat_default (StgBindDefault binder used rhs)
-      = satExpr rhs		     `thenSAT` \ rhs' ->
-	returnSAT (StgBindDefault binder used rhs')
-
-satExpr (StgLetNoEscape lv1 lv2 (StgNonRec binder rhs) body)
-  = satExpr body		`thenSAT` \ body' ->
-    satRhs rhs			`thenSAT` \ rhs' ->
-    returnSAT (StgLetNoEscape lv1 lv2 (StgNonRec binder rhs') body')
-
-satExpr (StgLetNoEscape lv1 lv2 (StgRec [(binder,rhs)]) body)
-  = satExpr body		      `thenSAT` \ body' ->
-    insSAEnv binder (getArgLists rhs) `thenSAT_`
-    satRhs rhs			      `thenSAT` \ rhs' ->
-    saTransform binder rhs'	      `thenSAT` \ binding ->
-    returnSAT (StgLetNoEscape lv1 lv2 binding body')
-
-satExpr (StgLetNoEscape lv1 lv2 (StgRec binds) body)
-  = let (binders, rhss) = unzip binds
-    in
-    satExpr body		    `thenSAT` \ body' ->
-    mapSAT satRhs rhss		    `thenSAT` \ rhss' ->
-    returnSAT (StgLetNoEscape lv1 lv2 (StgRec (binders `zip` rhss')) body')
-
-satExpr (StgLet (StgNonRec binder rhs) body)
-  = satExpr body		`thenSAT` \ body' ->
-    satRhs rhs			`thenSAT` \ rhs' ->
-    returnSAT (StgLet (StgNonRec binder rhs') body')
-
-satExpr (StgLet (StgRec [(binder,rhs)]) body)
-  = satExpr body		      `thenSAT` \ body' ->
-    insSAEnv binder (getArgLists rhs) `thenSAT_`
-    satRhs rhs			      `thenSAT` \ rhs' ->
-    saTransform binder rhs'	      `thenSAT` \ binding ->
-    returnSAT (StgLet binding body')
-
-satExpr (StgLet (StgRec binds) body)
-  = let (binders, rhss) = unzip binds
-    in
-    satExpr body		    `thenSAT` \ body' ->
-    mapSAT satRhs rhss		    `thenSAT` \ rhss' ->
-    returnSAT (StgLet (StgRec (binders `zip` rhss')) body')
-
-satExpr (StgSCC ty cc expr)
-  = satExpr expr		    `thenSAT` \ expr' ->
-    returnSAT (StgSCC ty cc expr')
-\end{code}
-
-\begin{code}
-satRhs rhs@(StgRhsCon cc v args) = returnSAT rhs
-
-satRhs (StgRhsClosure cc bi fvs upd args body)
-  = satExpr body		`thenSAT` \ body' ->
-    returnSAT (StgRhsClosure cc bi fvs upd args body')
--}
-\end{code}
diff --git a/ghc/compiler/simplStg/StgSATMonad.lhs b/ghc/compiler/simplStg/StgSATMonad.lhs
deleted file mode 100644
index 66e138ee60..0000000000
--- a/ghc/compiler/simplStg/StgSATMonad.lhs
+++ /dev/null
@@ -1,167 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
-%
-%************************************************************************
-%*									*
-\section[SATMonad]{The Static Argument Transformation pass Monad}
-%*									*
-%************************************************************************
-
-\begin{code}
-#include "HsVersions.h"
-
-module StgSATMonad ( getArgLists, saTransform ) where
-
-IMP_Ubiq(){-uitous-}
-
-import Util		( panic )
-
-getArgLists = panic "StgSATMonad.getArgLists"
-saTransform = panic "StgSATMonad.saTransform"
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Utility Functions}
-%*									*
-%************************************************************************
-
-\begin{code}
-{- LATER: to end of file:
-
-newSATNames :: [Id] -> SatM [Id]
-newSATNames [] = returnSAT []
-newSATNames (id:ids) = newSATName id (idType id)	`thenSAT` \ id' ->
-		       newSATNames ids			`thenSAT` \ ids' ->
-		       returnSAT (id:ids)
-
-getArgLists :: StgRhs -> ([Arg Type],[Arg Id])
-getArgLists (StgRhsCon _ _ _)
-  = ([],[])
-getArgLists (StgRhsClosure _ _ _ _ args _)
-  = ([], [Static v | v <- args])
-
-\end{code}
-
-\begin{code}
-saTransform :: Id -> StgRhs -> SatM StgBinding
-saTransform binder rhs
-  = getSATInfo binder `thenSAT` \ r ->
-    case r of
-      Just (_,args) | any isStatic args
-      -- [Andre] test: do it only if we have more than one static argument.
-      --Just (_,args) | length (filter isStatic args) > 1
-	-> newSATName binder (new_ty args)	`thenSAT` \ binder' ->
-	   let non_static_args = get_nsa args (snd (getArgLists rhs))
-	   in
-	   newSATNames non_static_args		`thenSAT` \ non_static_args' ->
-	   mkNewRhs binder binder' args rhs non_static_args' non_static_args
-						`thenSAT` \ new_rhs ->
-	   trace ("SAT(STG) "++ show (length (filter isStatic args))) (
-	   returnSAT (StgNonRec binder new_rhs)
-	   )
-      _ -> returnSAT (StgRec [(binder, rhs)])
-
-  where
-    get_nsa :: [Arg a] -> [Arg a] -> [a]
-    get_nsa []			_		= []
-    get_nsa _			[]		= []
-    get_nsa (NotStatic:args)	(Static v:as)	= v:get_nsa args as
-    get_nsa (_:args)		(_:as)		=   get_nsa args as
-
-    mkNewRhs binder binder' args rhs@(StgRhsClosure cc bi fvs upd rhsargs body) non_static_args' non_static_args
-      = let
-	  local_body = StgApp (StgVarArg binder')
-			 [StgVarArg a | a <- non_static_args] emptyUniqSet
-
-	  rec_body = StgRhsClosure cc bi fvs upd non_static_args'
-		       (doStgSubst binder args subst_env body)
-
-	  subst_env = mkIdEnv
-			((binder,binder'):zip non_static_args non_static_args')
-	in
-	returnSAT (
-	    StgRhsClosure cc bi fvs upd rhsargs
-	      (StgLet (StgRec [(binder',rec_body)]) {-in-} local_body)
-	)
-
-    new_ty args
-      = instantiateTy [] (mkSigmaTy [] dict_tys' tau_ty')
-      where
-	-- get type info for the local function:
-	(tv_tmpl, dict_tys, tau_ty) = (splitSigmaTy . idType) binder
-	(reg_arg_tys, res_type)	    = splitFunTy tau_ty
-
-	-- now, we drop the ones that are
-	-- static, that is, the ones we will not pass to the local function
-	l   	     = length dict_tys
-	dict_tys'    = dropStatics (take l args) dict_tys
-	reg_arg_tys' = dropStatics (drop l args) reg_arg_tys
-	tau_ty'	     = glueTyArgs reg_arg_tys' res_type
-\end{code}
-
-NOTE: This does not keep live variable/free variable information!!
-
-\begin{code}
-doStgSubst binder orig_args subst_env body
-  = substExpr body
-  where
-    substExpr (StgCon con args lvs)
-      = StgCon con (map substAtom args) emptyUniqSet
-    substExpr (StgPrim op args lvs)
-      = StgPrim op (map substAtom args) emptyUniqSet
-    substExpr expr@(StgApp (StgLitArg _) [] _)
-      = expr
-    substExpr (StgApp atom@(StgVarArg v)  args lvs)
-      | v `eqId` binder
-      = StgApp (StgVarArg (lookupNoFailIdEnv subst_env v))
-	       (remove_static_args orig_args args) emptyUniqSet
-      | otherwise
-      = StgApp (substAtom atom) (map substAtom args) lvs
-    substExpr (StgCase scrut lv1 lv2 uniq alts)
-      = StgCase (substExpr scrut) emptyUniqSet emptyUniqSet uniq (subst_alts alts)
-      where
-	subst_alts (StgAlgAlts ty alg_alts deflt)
-	  = StgAlgAlts ty (map subst_alg_alt alg_alts) (subst_deflt deflt)
-	subst_alts (StgPrimAlts ty prim_alts deflt)
-	  = StgPrimAlts ty (map subst_prim_alt prim_alts) (subst_deflt deflt)
-	subst_alg_alt (con, args, use_mask, rhs)
-	  = (con, args, use_mask, substExpr rhs)
-	subst_prim_alt (lit, rhs)
-	  = (lit, substExpr rhs)
-	subst_deflt StgNoDefault
-	  = StgNoDefault
-	subst_deflt (StgBindDefault var used rhs)
-	  = StgBindDefault var used (substExpr rhs)
-    substExpr (StgLetNoEscape fv1 fv2 b body)
-      = StgLetNoEscape emptyUniqSet emptyUniqSet (substBinding b) (substExpr body)
-    substExpr (StgLet b body)
-      = StgLet (substBinding b) (substExpr body)
-    substExpr (StgSCC ty cc expr)
-      = StgSCC ty cc (substExpr expr)
-    substRhs (StgRhsCon cc v args)
-      = StgRhsCon cc v (map substAtom args)
-    substRhs (StgRhsClosure cc bi fvs upd args body)
-      = StgRhsClosure cc bi [] upd args (substExpr body)
-
-    substBinding (StgNonRec binder rhs)
-      = StgNonRec binder (substRhs rhs)
-    substBinding (StgRec pairs)
-      = StgRec (zip binders (map substRhs rhss))
-      where
-	(binders,rhss) = unzip pairs
-
-    substAtom atom@(StgLitArg lit) = atom
-    substAtom atom@(StgVarArg v)
-      = case lookupIdEnv subst_env v of
-	  Just v' -> StgVarArg v'
-	  Nothing -> atom
-
-    remove_static_args _ []
-      = []
-    remove_static_args (Static _:origs) (_:as)
-      = remove_static_args origs as
-    remove_static_args (NotStatic:origs) (a:as)
-      = substAtom a:remove_static_args origs as
--}
-\end{code}
diff --git a/ghc/compiler/simplStg/UpdAnal.lhs b/ghc/compiler/simplStg/UpdAnal.lhs
index 5a98a3e8d7..2b75497728 100644
--- a/ghc/compiler/simplStg/UpdAnal.lhs
+++ b/ghc/compiler/simplStg/UpdAnal.lhs
@@ -27,7 +27,7 @@
 > --import Id
 > --import IdInfo
 > --import Pretty
-> --import SrcLoc 	( mkUnknownSrcLoc )
+> --import SrcLoc 	( noSrcLoc )
 > --import StgSyn
 > --import UniqSet
 > --import Unique 	( getBuiltinUniques )
@@ -479,7 +479,7 @@ Convert a Closure into a representation that can be placed in a .hi file.
 >	    where
 >		(c,b,_)     = foldl doApp f ids
 >	      	ids         = map mkid (getBuiltinUniques arity)
->	      	mkid u      = mkSysLocal SLIT("upd") u noType mkUnknownSrcLoc
+>	      	mkid u      = mkSysLocal SLIT("upd") u noType noSrcLoc
 >	      	countUses u = if u `elemRefs` b then 2 else min (lookupc c u) 2
 >	      	noType      = panic "UpdAnal: no type!"
 >