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 <[email protected]> Date: 3/27/18 11:28 PM (GMT+01:00) To: Simon Peyton Jones <[email protected]> Cc: [email protected] Subject: Re: Missed beta reductions On Tuesday, March 27, 2018 7:55:02 AM EDT Simon Peyton Jones wrote: > 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 [email protected] http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
_______________________________________________ ghc-devs mailing list [email protected] http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs
