Problem: LiberateCase with two or more free variables

[Manuel M. T. Chakravarty]

LiberateCase works very nicely as long as there is only one
variable whose access has to be liberated.  However, already
with two variables, there are problems.  Given

  import PrelGHC
  import PrelBase

  data AccessPath = Cont  AccessPath
		  | Value Int

  accessLen0#, accessLen1#, accessLen2# :: AccessPath -> Int#
  accessLen0# (Value i) = case i of {I# i -> i}
  accessLen1# (Cont ap) = accessLen0# ap
  accessLen2# (Cont ap) = accessLen1# ap

  main = print $ ((demandSome (bar 0#) (foo 1# ap) (foo 5# ap)))
	 where
	   ap = Cont (Value 10)

  foo 0# x = x
  foo n# x = foo (n# -# 1#) x

  bar 0# = 0#
  bar n# = bar (n# -# 1#)

Let us assume I have the following for `demandSome':

  demandSome :: Int# -> AccessPath -> AccessPath -> Int
  demandSome n# ap1 ap2  = demandSome' n#
    where
      demandSome' n# = 
	case n# of
	  0# -> 1
	  n# | n# <# 10# -> I# (accessLen1# ap1) + demandSome' (n# -# 1#)
	  n# | otherwise -> I# (accessLen1# ap2) + demandSome' (n# -# 1#)

When compiled with 

  ghc -fglasgow-exts -O2 -fliberate-case-threshold100 -c DemandTree.hs

I get for the inner loop

  $wdemandSome'
    = \ w2 :: PrelGHC.Int# ->
	  case w2 of ds1 {
	      0 -> 1;
	      __DEFAULT ->
		  case PrelGHC.<# ds1 10 of wild4 {
		      PrelBase.True ->
			  case $wdemandSome'
				   (PrelGHC.-# ds1 1)
			  of ww { __DEFAULT ->
			  PrelGHC.+# i1 ww
			  };
		      PrelBase.False ->
			  case ap2 of wild5 {
			      Main.Value a ->
				  PrelErr.patError
				      @ PrelGHC.Int#
				      lvl_s1NP;
			      Main.Cont ap21 ->
				  case ap21 of wild6 {
				      Main.Cont a ->
					  PrelErr.patError
					      @ PrelGHC.Int#
					      lvl1_s1NO;
				      Main.Value i2 ->
					  case i2
					  of wild7 { PrelBase.I# i3 ->
					  case $wdemandSome'
						   (PrelGHC.-#
							ds1
							1)
					  of ww { __DEFAULT ->
					  PrelGHC.+# i3 ww
					  }
					  }
				  }
			  }
		  }
	  };

So, access to `ap1' has been pulled out of the loop nicely,
but `ap2' is decomposed in every recursion where the third
alternative is selected.  

However, given that we don't know whether access to `ap2'
will terminate, ghc has to be conservative here.  Now my
problem is that sometimes, *I* know that access to ap2 is
problematic.  The question is, how to tell the compiler?

The first thing that came to my mind was using `seq' like in

  demandSome :: Int# -> AccessPath -> AccessPath -> Int
  demandSome n# ap1 ap2  = demandSome' n#
    where
      demandSome' n# = 
	case n# of
	  0# -> 1
	  n# | n# <# 10# -> ap2 `seq` 
			      I# (accessLen1# ap1) + demandSome' (n# -# 1#)
	  n# | otherwise -> I# (accessLen1# ap2) + demandSome' (n# -# 1#)

However, this only makes things worse, because now I am
getting

  $wdemandSome'
    = \ w2 :: PrelGHC.Int# ->
	  case w2 of ds2 {
	      0 -> 1;
	      __DEFAULT ->
		  case PrelGHC.<# ds2 10
		  of wild4 {
		      PrelBase.True ->
			  case PrelGHC.seq#
				   @ Main.AccessPath
				   ap2
			  of ds3 {
			      0 ->
				  __coerce
				      PrelGHC.Int#
				  (PrelErr.seqError
				       @ PrelBase.Int);
			      __DEFAULT ->
				  case $wdemandSome'
					   (PrelGHC.-#
						ds2
						1)
				  of ww { __DEFAULT ->
				  PrelGHC.+# i1 ww
				  }
			  };
		      PrelBase.False ->
			  case ap2 of wild5 {
			      Main.Value a ->
				  PrelErr.patError
				      @ PrelGHC.Int#
				      lvl_s1PF;
			      Main.Cont ap21 ->
				  case ap21
				  of wild6 {
				      Main.Cont a ->
					  PrelErr.patError
					      @ PrelGHC.Int#
					      lvl1_s1PE;
				      Main.Value i2 ->
					  case i2
					  of wild7 { PrelBase.I# i3 ->
					  case $wdemandSome'
						   (PrelGHC.-#
							ds2
							1)
					  of ww { __DEFAULT ->
					  PrelGHC.+#
					      i3
					      ww
					  }
					  }
				  }
			  }
		  }
	  };

The `seq' is dynamically evaluated (slowing down the second
alternative) instead of leading to liberation of `case ap2
of wild5 {...}'.

Even if the trick with `seq' would have worked, it would
only have solved half of the problem, because I would still
have `case ap21 of wild6 {...}' in the inner loop.
Sometimes, I can't do much else than applying `seq', namely
when `AccessPath' is imported abstractly by the module
including the recursion.

I have this problem in the array library, only worse.  A
frequently executed recursive definition has *five*
variables whose unboxing should be liberated (which includes
the traversal of an access path like the one above).
Furthermore, the function corresponding to `accessLen1' is
overloaded and the type on which it operates is abstract.
The lack of case liberation, unfortunately, causes a massive
performance loss.

Cheers,
Manuel