[project @ 1999-11-01 17:09:54 by simonpj]

A regrettably-gigantic commit that puts in place what Simon PJ
has been up to for the last month or so, on and off.

The basic idea was to restore unfoldings to *occurrences* of
variables without introducing a space leak.  I wanted to make
sure things improved relative to 4.04, and that proved depressingly
hard.  On the way I discovered several quite serious bugs in the
simplifier.

Here's a summary of what's gone on.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
* No commas between for-alls in RULES.  This makes the for-alls have
  the same syntax as in types.

* Arrange that simplConArgs works in one less pass than before.
  This exposed a bug: a bogus call to completeBeta.

* Add a top-level flag in CoreUnfolding, used in callSiteInline

* Extend w/w to use etaExpandArity, so it does eta/coerce expansion

* Implement inline phases.   The meaning of the inline pragmas is
  described in CoreUnfold.lhs.  You can say things like
	{#- INLINE 2 build #-}
  to mean "inline build in phase 2"

* Don't float anything out of an INLINE.
  Don't float things to top level unless they also escape a value lambda.
	[see comments with SetLevels.lvlMFE
  Without at least one of these changes, I found that
	{-# INLINE concat #-}
	concat = __inline (/\a -> foldr (++) [])
  was getting floated to
	concat = __inline( /\a -> lvl a )
	lvl = ...inlined version of foldr...

  Subsequently I found that not floating constants out of an INLINE
  gave really bad code like
	__inline (let x = e in \y -> ...)
  so I now let things float out of INLINE

* Implement the "reverse-mapping" idea for CSE; actually it turned out to be easier
  to implement it in SetLevels, and may benefit full laziness too.

* It's a good idea to inline inRange. Consider

	index (l,h) i = case inRange (l,h) i of
		  	  True ->  l+i
			  False -> error
  inRange itself isn't strict in h, but if it't inlined then 'index'
  *does* become strict in h.  Interesting!

* Big change to the way unfoldings and occurrence info is propagated in the simplifier
  The plan is described in Subst.lhs with the Subst type
  Occurrence info is now in a separate IdInfo field than user pragmas

* I found that
	(coerce T (coerce S (\x.e))) y
  didn't simplify in one round. First we get to
	(\x.e) y
  and only then do the beta. Solution: cancel the coerces in the continuation

* Amazingly, CoreUnfold wasn't counting the cost of a function an application.

* Disable rules in initial simplifier run.  Otherwise full laziness
  doesn't get a chance to lift out a MFE before a rule (e.g. fusion)
  zaps it.  queens is a case in point

* Improve float-out stuff significantly.  The big change is that if we have

	\x -> ... /\a -> ...let p = ..a.. in let q = ...p...

  where p's rhs doesn't x, we abstract a from p, so that we can get p past x.
  (We did that before.)  But we also substitute (p a) for p in q, and then
  we can do the same thing for q.  (We didn't do that, so q got stuck.)
  This is much better.  It involves doing a substitution "as we go" in SetLevels,
  though.

3 files changed, 27 insertions, 10 deletions

diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs
index b7c092cf93..4e755ca7c1 100644
--- a/ghc/compiler/codeGen/CgCase.lhs
+++ b/ghc/compiler/codeGen/CgCase.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgCase.lhs,v 1.35 1999/10/13 16:39:14 simonmar Exp $
+% $Id: CgCase.lhs,v 1.36 1999/11/01 17:10:06 simonpj Exp $
 %
 %********************************************************
 %*							*
@@ -174,6 +174,7 @@ cgCase (StgCon (PrimOp op) args res_ty)
     } 						`thenC`
 
  	-- bind the default binder if necessary
+	-- The deadness info is set by StgVarInfo
     (if (isDeadBinder bndr)
 	then nopC
 	else bindNewToTemp bndr 		`thenFC` \ bndr_amode ->
diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs
index 71a2c06f4b..dc326087c9 100644
--- a/ghc/compiler/codeGen/CgClosure.lhs
+++ b/ghc/compiler/codeGen/CgClosure.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
-% $Id: CgClosure.lhs,v 1.35 1999/10/13 16:39:15 simonmar Exp $
+% $Id: CgClosure.lhs,v 1.36 1999/11/01 17:10:07 simonpj Exp $
 %
 \section[CgClosure]{Code generation for closures}
 
@@ -46,7 +46,7 @@ import ClosureInfo	-- lots and lots of stuff
 import CmdLineOpts	( opt_GranMacros, opt_SccProfilingOn, opt_DoTickyProfiling )
 import CostCentre	
 import Id		( Id, idName, idType, idPrimRep )
-import Name		( Name )
+import Name		( Name, isLocalName )
 import Module		( Module, pprModule )
 import ListSetOps	( minusList )
 import PrimRep		( PrimRep(..) )
@@ -372,9 +372,10 @@ closureCodeBody binder_info closure_info cc all_args body
 	-- fast_entry_code = forceHeapCheck [] True fast_entry_code'
 
 	fast_entry_code
-	  = profCtrC SLIT("TICK_CTR") [ 
+	  = moduleName		`thenFC` \ mod_name ->
+	    profCtrC SLIT("TICK_CTR") [ 
 		CLbl ticky_ctr_label DataPtrRep,
-		mkCString (_PK_ (showSDocDebug (ppr name))),
+		mkCString (_PK_ (ppr_for_ticky_name mod_name name)),
 		mkIntCLit stg_arity,	-- total # of args
 		mkIntCLit sp_stk_args,	-- # passed on stk
 		mkCString (_PK_ (map (showTypeCategory . idType) all_args))
@@ -437,6 +438,14 @@ closureCodeBody binder_info closure_info cc all_args body
     name       = closureName closure_info
     fast_label = mkFastEntryLabel name stg_arity
     info_label = mkInfoTableLabel name
+
+
+-- When printing the name of a thing in a ticky file, we want to
+-- give the module name even for *local* things.   We print
+-- just "x (M)" rather that "M.x" to distinguish them from the global kind.
+ppr_for_ticky_name mod_name name
+  | isLocalName name = showSDocDebug (ppr name <+> (parens (ppr mod_name)))
+  | otherwise	     = showSDocDebug (ppr name)
 \end{code}
 
 For lexically scoped profiling we have to load the cost centre from
diff --git a/ghc/compiler/codeGen/CgUsages.lhs b/ghc/compiler/codeGen/CgUsages.lhs
index ce20791ee7..6f3353d8dd 100644
--- a/ghc/compiler/codeGen/CgUsages.lhs
+++ b/ghc/compiler/codeGen/CgUsages.lhs
@@ -21,6 +21,7 @@ module CgUsages (
 #include "HsVersions.h"
 
 import AbsCSyn
+import PrimRep		( PrimRep(..) )
 import AbsCUtils	( mkAbstractCs )
 import CgMonad
 \end{code}
@@ -143,9 +144,10 @@ That's done by functions which allocate stack space.
 \begin{code}
 adjustSpAndHp :: VirtualSpOffset 	-- New offset for Arg stack ptr
 	      -> Code
-adjustSpAndHp newRealSp info_down (MkCgState absC binds
-					((vSp,fSp,realSp,hwSp),	
-					 (vHp, rHp)))
+adjustSpAndHp newRealSp (MkCgInfoDown _ _ _ ticky_ctr _)
+			(MkCgState absC binds
+				   ((vSp,fSp,realSp,hwSp),	
+				   (vHp, rHp)))
   = MkCgState (mkAbstractCs [absC,move_sp,move_hp]) binds new_usage
     where
 
@@ -153,9 +155,14 @@ adjustSpAndHp newRealSp info_down (MkCgState absC binds
 	      else (CAssign (CReg Sp)
 			    (CAddr (spRel realSp newRealSp)))
 
+	-- Adjust the heap pointer backwards in case we over-allocated
+	-- Analogously, we also remove bytes from the ticky counter
     move_hp = if (rHp == vHp) then AbsCNop
-	      else (CAssign (CReg Hp)
-			    (CAddr (hpRel rHp vHp)))
+	      else mkAbstractCs [
+			CAssign (CReg Hp) (CAddr (hpRel rHp vHp)),
+			profCtrAbsC SLIT("TICK_ALLOC_HEAP") 
+			    [ mkIntCLit (vHp - rHp), CLbl ticky_ctr DataPtrRep ]
+	      ]
 
     new_usage = ((vSp, fSp, newRealSp, hwSp), (vHp,vHp))
 \end{code}