<html><head><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"></head><body><div>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.</div><div><br></div><div><br></div><div><br></div><div id="composer_signature"><meta http-equiv="Content-Type" content="text/html; charset=UTF-8"><div style="font-size:85%;color:#575757">David Feuer</div><div style="font-size:85%;color:#575757">Well-Typed, LLP</div></div><div><br></div><div style="font-size:100%;color:#000000"><!-- originalMessage --><div>-------- Original message --------</div><div>From: David Feuer <david@well-typed.com> </div><div>Date: 3/27/18 11:28 PM (GMT+01:00) </div><div>To: Simon Peyton Jones <simonpj@microsoft.com> </div><div>Cc: ghc-devs@haskell.org </div><div>Subject: Re: Missed beta reductions </div><div><br></div></div>On Tuesday, March 27, 2018 7:55:02 AM EDT Simon Peyton Jones wrote:<br>> 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?<br>> <br>> Since this function might be applied to many different arguments, it’s probably not a good idea to do anything unconditionally…<br><br>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.<br><br>-- The basic function<br>fromListNArray :: Int -> [a] -> Array a<br>fromListNArray !n l =<br> createArray n fromListN_too_short $ \mi -><br> let go i (x:xs)<br> | i < n = writeArray mi i x >> go (i+1) xs<br> | otherwise = fromListN_too_long<br> go i [] = unless (i == n) fromListN_too_short<br> in go 0 l<br>{-# NOINLINE fromListNArray #-}<br><br>fromListN_too_short, fromListN_too_long :: a<br>fromListN_too_short = error "barf"<br>fromListN_too_long = error "die"<br>{-# NOINLINE fromListN_too_short #-}<br>{-# NOINLINE fromListN_too_long #-}<br><br>{-# RULES<br>-- The rule to let it fuse<br>"fromListNArray/foldr" [~1] forall n xs.<br> fromListNArray n xs = createArray n fromListN_too_short $ \mary -><br> foldr (fillArray_go n mary) (fillArray_stop n) xs 0<br><br>-- The attempted write-back rule<br>"fillArrayN/list" [1] forall n mary xs i.<br> foldr (fillArray_go n mary) (fillArray_stop n) xs i = fillArrayN n mary xs i<br> #-}<br><br>fillArrayN :: Int -> MutableArray s a -> [a] -> Int -> ST s ()<br>fillArrayN !n !mary xs0 !i0 = go i0 xs0<br> where<br> go i (x:xs)<br> | i < n = writeArray mary i x >> go (i+1) xs<br> | otherwise = fromListN_too_long<br> go i [] = unless (i == n) fromListN_too_short<br>{-# NOINLINE fillArrayN #-}<br><br>fillArray_go :: Int<br> -> MutableArray s a<br> -> a<br> -> (Int -> ST s ())<br> -> Int<br> -> ST s ()<br>fillArray_go !n !mary = \x r i -><br> if i < n<br> then writeArray mary i x >> r (i + 1)<br> else fromListN_too_long<br>{-# INLINE [0] fillArray_go #-}<br><br>fillArray_stop :: Int -> Int -> ST s ()<br>fillArray_stop !n = \i -> unless (i == n) fromListN_too_short<br>{-# INLINE [0] fillArray_stop #-}<br><br><br>My test case, which has nothing to fuse with:<br><br>bye :: Int -> [Int] -> Array Int<br>bye n xs = fmap (+1) $ fromListNArray n xs<br><br>The fromListNArray/foldr rule fires:<br><br>Rule fired<br> Rule: fromListNArray/foldr<br> Module: (FL)<br> Before: fromListNArray TyArg Int ValArg n_a6aF ValArg xs_a6aG<br> After: (\ (@ a_a6XO) (n_a6ba :: Int) (xs_a6bb :: [a_a6XO]) -><br> $ (createArray n_a6ba fromListN_too_short)<br> (\ (@ s_a6XV) (mary_a6bc :: MutableArray s_a6XV a_a6XO) -><br> foldr<br> (fillArray_go n_a6ba mary_a6bc)<br> (fillArray_stop n_a6ba)<br> xs_a6bb<br> (I# 0#)))<br> n_a6aF xs_a6aG<br> Cont: StrictArg $fApplicativeArray_$cfmap<br> Stop[BoringCtxt] Array Int<br><br>But the fromListArrayN/list rule never does. We go from<br><br>bye :: Int -> [Int] -> Array Int<br>bye<br> = \ (n_a6aF :: Int) (xs_a6aG :: [Int]) -><br> case n_a6aF of wild_Xl { I# ds_d70d -><br> case ds_d70d of ds_X70p {<br> __DEFAULT -><br> case runRW#<br> (\ (s_i72w :: State# RealWorld) -><br> case newArray# ds_X70p fromListN_too_short (s_i72w `cast` <Co:97>)<br> of<br> { (# ipv_i72X, ipv1_i72Y #) -><br> case ((foldr<br> (fillArray_go wild_Xl ((MutableArray ipv1_i72Y) `cast` <Co:97>))<br> (fillArray_stop wild_Xl)<br> xs_a6aG<br> lvl_s7h1)<br> `cast` <Co:3>)<br> (ipv_i72X `cast` <Co:97>)<br> of<br> { (# ipv_i73A, ipv1_i73B #) -><br> unsafeFreezeArray# (ipv1_i72Y `cast` <Co:197>) ipv_i73A<br> }<br> })<br> of<br> { (# ipv_i72I, ipv1_i72J #) -><br> $fApplicativeArray_$cfmap lvl_s7h0 (Array ipv1_i72J)<br> };<br> 0# -><br> case emptyArray# (##) of wild_Xd { __DEFAULT -><br> $fApplicativeArray_$cfmap lvl_s7h0 (Array wild_Xd)<br> }<br> }<br> }<br><br>to something where everything inlines except errors.<br>_______________________________________________<br>ghc-devs mailing list<br>ghc-devs@haskell.org<br>http://mail.haskell.org/cgi-bin/mailman/listinfo/ghc-devs<br></body></html>