I dug into this some more. My first problem was a stupid mistake: matching on Data.Foldable.foldr instead of GHC.List.foldr. That makes the write-back rule work when there's no fusion at all. However, if there's partial fusion with augment, then I actually get a problem from a failure to inline. That inlining failure strikes me as somewhat surprising. The function involved is actually a *partial application* of a one-shot function. I don't see how we could ever win much by not inlining it. I'll provide further details soon.
David FeuerWell-Typed, LLP
-------- Original message --------From: David Feuer
Yes, it’s possible that he sequence you are seeing is what is happening to you. But why is that not what you want to see? What are you trying to achieve?
Since this function might be applied to many different arguments, it’s probably not a good idea to do anything unconditionally…
I gave rather poor guesses in my last message. I'm trying to get fromListN for Data.Primitive.Array to participate in list fusion. I'm rewriting to a foldr form so it can fuse with build. This is actually working. The trouble is the write-back rule, that's supposed to fire if fusion doesn't happen. That's not working, and I'm quite mystified about why. -- The basic function fromListNArray :: Int -> [a] -> Array a fromListNArray !n l = createArray n fromListN_too_short $ \mi -> let go i (x:xs) | i < n = writeArray mi i x >> go (i+1) xs | otherwise = fromListN_too_long go i [] = unless (i == n) fromListN_too_short in go 0 l {-# NOINLINE fromListNArray #-} fromListN_too_short, fromListN_too_long :: a fromListN_too_short = error "barf" fromListN_too_long = error "die" {-# NOINLINE fromListN_too_short #-} {-# NOINLINE fromListN_too_long #-} {-# RULES -- The rule to let it fuse "fromListNArray/foldr" [~1] forall n xs. fromListNArray n xs = createArray n fromListN_too_short $ \mary -> foldr (fillArray_go n mary) (fillArray_stop n) xs 0 -- The attempted write-back rule "fillArrayN/list" [1] forall n mary xs i. foldr (fillArray_go n mary) (fillArray_stop n) xs i = fillArrayN n mary xs i #-} fillArrayN :: Int -> MutableArray s a -> [a] -> Int -> ST s () fillArrayN !n !mary xs0 !i0 = go i0 xs0 where go i (x:xs) | i < n = writeArray mary i x >> go (i+1) xs | otherwise = fromListN_too_long go i [] = unless (i == n) fromListN_too_short {-# NOINLINE fillArrayN #-} fillArray_go :: Int -> MutableArray s a -> a -> (Int -> ST s ()) -> Int -> ST s () fillArray_go !n !mary = \x r i -> if i < n then writeArray mary i x >> r (i + 1) else fromListN_too_long {-# INLINE [0] fillArray_go #-} fillArray_stop :: Int -> Int -> ST s () fillArray_stop !n = \i -> unless (i == n) fromListN_too_short {-# INLINE [0] fillArray_stop #-} My test case, which has nothing to fuse with: bye :: Int -> [Int] -> Array Int bye n xs = fmap (+1) $ fromListNArray n xs The fromListNArray/foldr rule fires: Rule fired Rule: fromListNArray/foldr Module: (FL) Before: fromListNArray TyArg Int ValArg n_a6aF ValArg xs_a6aG After: (\ (@ a_a6XO) (n_a6ba :: Int) (xs_a6bb :: [a_a6XO]) -> $ (createArray n_a6ba fromListN_too_short) (\ (@ s_a6XV) (mary_a6bc :: MutableArray s_a6XV a_a6XO) -> foldr (fillArray_go n_a6ba mary_a6bc) (fillArray_stop n_a6ba) xs_a6bb (I# 0#))) n_a6aF xs_a6aG Cont: StrictArg $fApplicativeArray_$cfmap Stop[BoringCtxt] Array Int But the fromListArrayN/list rule never does. We go from bye :: Int -> [Int] -> Array Int bye = \ (n_a6aF :: Int) (xs_a6aG :: [Int]) -> case n_a6aF of wild_Xl { I# ds_d70d -> case ds_d70d of ds_X70p { __DEFAULT -> case runRW# (\ (s_i72w :: State# RealWorld) -> case newArray# ds_X70p fromListN_too_short (s_i72w `cast` Co:97) of { (# ipv_i72X, ipv1_i72Y #) -> case ((foldr (fillArray_go wild_Xl ((MutableArray ipv1_i72Y) `cast` Co:97)) (fillArray_stop wild_Xl) xs_a6aG lvl_s7h1) `cast` Co:3) (ipv_i72X `cast` Co:97) of { (# ipv_i73A, ipv1_i73B #) -> unsafeFreezeArray# (ipv1_i72Y `cast` Co:197) ipv_i73A } }) of { (# ipv_i72I, ipv1_i72J #) -> $fApplicativeArray_$cfmap lvl_s7h0 (Array ipv1_i72J) }; 0# -> case emptyArray# (##) of wild_Xd { __DEFAULT -> $fApplicativeArray_$cfmap lvl_s7h0 (Array wild_Xd) } } } to something where everything inlines except errors. _______________________________________________ ghc-devs mailing list ghc-devs@haskell.org http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs