Simon,

On Thu, 2006-11-30 at 02:13 +0000, Simon Peyton-Jones wrote:
>
> Rather than do fancy things with a Rebox class, I think it's better for now 
> to make SpecConstr more aggressive, just like the strictness analyser, so 
> that it does not care about reboxing.  I did this a week or two ago, but I 
> think I forgot to tell you.   The above 'foo' now compiles to a nice tight 
> loop.

This is a big help but doesn't solve all problems, unfortunately.
Example:

------
module Foo where

data a :*: b = !a :*: !b

infixl 7 :*:

foo1 :: Int :*: (Int :*: Int) -> Int
foo1 (0 :*: _) = 0
foo1 (i :*: (m :*: n)) | even i    = foo1 ((i-m) :*: (m :*: n))
                       | otherwise = foo1 ((i-n) :*: (m :*: n))

foo2 :: Int :*: (Int :*: Int) -> Int
foo2 (0 :*: _) = 0
foo2 (i :*: p@(m :*: n)) | even i    = foo2 ((i-m) :*: p)
                         | otherwise = foo2 ((i-n) :*: p)

foo3 :: Int :*: (Int :*: Int) -> Int
foo3 (0 :*: _) = 0
foo3 (i :*: p) | even i    = case p of
                               m :*: _ -> foo3 ((i-m) :*: p)
               | otherwise = case p of
                               _ :*: n -> foo3 ((i-n) :*: p)
------

Of these, foo1 compiles into a nice tight loop:

------
$s$wfoo1 :: Int# -> Int# -> Int# -> Int#
$s$wfoo1 =
  \ (y_aqK :: Int#) (ipv_srl :: Int#) (sc_su5 :: Int#) ->
    case sc_su5 of ds_XjT {
      __DEFAULT ->
        case remInt# ds_XjT 2 of wild1_ajN {
          __DEFAULT -> $s$wfoo1 y_aqK ipv_srl (-# ds_XjT y_aqK);
          0 -> $s$wfoo1 y_aqK ipv_srl (-# ds_XjT ipv_srl)
        };
      0 -> 0
    }

$wfoo1 :: Int# -> (:*:) Int Int -> Int#
$wfoo1 =
  \ (ww_ssv :: Int#) (ww1_ssx :: (:*:) Int Int) ->
    case ww_ssv of ds_XjT {
      __DEFAULT ->
        case ww1_ssx of wild_Xl { :*: m_a7C n_a7D ->
        case remInt# ds_XjT 2 of wild1_ajN {
          __DEFAULT ->
            case n_a7D of wild11_aqI { I# y_aqK ->
            case m_a7C of tpl_X16 { I# ipv_srl ->
            $s$wfoo1 y_aqK ipv_srl (-# ds_XjT y_aqK)
            }
            };
          0 ->
            case m_a7C of wild11_aqI { I# y_aqK ->
            case n_a7D of tpl_X18 { I# ipv_srq ->
            $s$wfoo1 ipv_srq y_aqK (-# ds_XjT y_aqK)
            }
            }
        }
        };
      0 -> 0
    }

------

For foo2, however, we get

------
$s$wfoo2 :: Int -> Int# -> Int# -> Int#
$s$wfoo2 =
  \ (n_a9o :: Int) (y_aqK :: Int#) (sc_su0 :: Int#) ->
    case sc_su0 of ds_XjI {
      __DEFAULT ->
        case remInt# ds_XjI 2 of wild1_ajN {
          __DEFAULT ->
            case n_a9o of wild11_aqI { I# y1_Xrm ->
            $s$wfoo2 wild11_aqI y_aqK (-# ds_XjI y1_Xrm)
            };
          0 -> $s$wfoo2 n_a9o y_aqK (-# ds_XjI y_aqK)
        };
      0 -> 0
    }

$s$wfoo21 :: Int -> Int# -> Int# -> Int#
$s$wfoo21 =
  \ (m_a9n :: Int) (y_aqK :: Int#) (sc_stZ :: Int#) ->
    case sc_stZ of ds_XjI {
      __DEFAULT ->
        case remInt# ds_XjI 2 of wild1_ajN {
          __DEFAULT -> $s$wfoo21 m_a9n y_aqK (-# ds_XjI y_aqK);
          0 ->
            case m_a9n of wild11_aqI { I# y1_Xro ->
            $s$wfoo2 (I# y_aqK) y1_Xro (-# ds_XjI y1_Xro)
            }
        };
      0 -> 0
    }

$wfoo2 :: Int# -> (:*:) Int Int -> Int#
$wfoo2 =
  \ (ww_ssh :: Int#) (ww1_ssj :: (:*:) Int Int) ->
    case ww_ssh of ds_XjI {
      __DEFAULT ->
        case ww1_ssj of wild_Xk { :*: m_a9n n_a9o ->
        case remInt# ds_XjI 2 of wild1_ajN {
          __DEFAULT ->
            case n_a9o of wild11_aqI { I# y_aqK ->
            $s$wfoo21 m_a9n y_aqK (-# ds_XjI y_aqK)
            };
          0 ->
            case m_a9n of wild11_aqI { I# y_aqK ->
            $s$wfoo2 n_a9o y_aqK (-# ds_XjI y_aqK)
            }
        }
        };
      0 -> 0
    }
------

The code generated for foo3 is similar. Why does this happen? For foo1,
we have (before SpecConstr):

------
$wfoo1_ssG :: Int# -> (:*:) Int Int -> Int#
$wfoo1_ssG =
  \ (ww_ssv :: Int#) (ww_ssx :: (:*:) Int Int) ->
    case ww_ssv of ds_XjT {
      __DEFAULT ->
        case ww_ssx of wild_Xl { :*: m_a7C n_a7D ->
        case remInt# ds_XjT 2 of wild1_ajN {
          __DEFAULT ->
            case n_a7D of wild1_aqI { I# y_aqK ->
            case m_a7C of tpl_X16 { I# ipv_srl ->
            $wfoo1_ssG (-# ds_XjT y_aqK) wild_Xl
            }
            };
          0 ->
            case m_a7C of wild1_aqI { I# y_aqK ->
            case n_a7D of tpl_X18 { I# ipv_srq ->
            $wfoo1_ssG (-# ds_XjT y_aqK) wild_Xl
            }
            }
        }
        };
      0 -> 0
    }
------

Note that both m and n are scrutinised in both alternatives. This is
because they are used as arguments to the strict (:*:) and although CSE
has removed (m :*: n), the cases remain. With foo2, however, we have

------
$wfoo2_ssF :: Int# -> (:*:) Int Int -> Int#
$wfoo2_ssF =
  \ (ww_ssh :: Int#) (ww_ssj :: (:*:) Int Int) ->
    case ww_ssh of ds_XjI {
      __DEFAULT ->
        case ww_ssj of wild_Xk { :*: m_a9n n_a9o ->
        case remInt# ds_XjI 2 of wild1_ajN {
          __DEFAULT ->
            case n_a9o of wild1_aqI { I# y_aqK ->
            $wfoo2_ssF (-# ds_XjI y_aqK) wild_Xk
            };
          0 ->
            case m_a9n of wild1_aqI { I# y_aqK ->
            $wfoo2_ssF (-# ds_XjI y_aqK) wild_Xk
            }
        }
        };
      0 -> 0
    }
------

Here, SpecConstr doesn't see the entire structure of ww_ssj since,
although it is hyperstrict, parts of it are not inspected. This is
precisely the problem my reboxing setup is supposed to solve - with
stream fusion, we usually do not inspect the entire seed in each
iteration, but seeds are usually hyperstrict and can be unboxed. Thanks
to your changes, I can probably replace rebox by some form of deepSeq on
the strict part of the seed, though.

I'm not sure if anything can be done about it. Perhaps, if we have

  data T a = T !a

and see

  case e1 of T x -> e2

and e1 has the type T t where t is a single-constructor data type, we
could transform this to

  case e1 of T x ->
  case x  of C y -> e2

to make the structure of x explicit and then eliminate unnecessary cases
after SpecConstr etc. have run. This is too much work, probably.

Roman



_______________________________________________
Cvs-ghc mailing list
[EMAIL PROTECTED]
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to