
hello -- this is mostly a question for roman, or don, i guess. suppose i have a list of similarly-sized vectors, and i want to add them up (possibly with coefficients), to yield a result vector. something like module Main where import qualified Data.Vector.Generic as V import qualified Data.Vector.Unboxed as UV type Vec = UV.Vector Double axpy :: Double -> Vec -> Vec -> Vec axpy a x y = V.zipWith (+) (V.map (* a) x) y sumVecs :: [(Double, Vec)] -> Vec sumVecs axs = let (a, x) = head axs in foldl adder (V.map (* a) x) (tail axs) where adder :: Vec -> (Double, Vec) -> Vec adder v1 (a, x) = axpy a x v1 how to i write this in a way which ensures recycling / fusion, e.g. in-place updates? best regards, ben

On Fri, Apr 16, 2010 at 8:32 PM, Ben
hello --
this is mostly a question for roman, or don, i guess. suppose i have a list of similarly-sized vectors, and i want to add them up (possibly with coefficients), to yield a result vector. something like
module Main where
import qualified Data.Vector.Generic as V import qualified Data.Vector.Unboxed as UV
type Vec = UV.Vector Double
axpy :: Double -> Vec -> Vec -> Vec axpy a x y = V.zipWith (+) (V.map (* a) x) y
sumVecs :: [(Double, Vec)] -> Vec sumVecs axs = let (a, x) = head axs in foldl adder (V.map (* a) x) (tail axs) where adder :: Vec -> (Double, Vec) -> Vec adder v1 (a, x) = axpy a x v1
how to i write this in a way which ensures recycling / fusion, e.g. in-place updates?
One thing you can always do is check what the optimizer produces. Don wrote ghc-core (on hackage) specifically for this task. You should also try with -Odph, when -O2 isn't giving you the results you need. Hopefully Don or Roman can give you tips on exploiting fusion when the optimizer doesn't do the right thing. Jason

On 17/04/2010, at 13:32, Ben wrote:
module Main where
import qualified Data.Vector.Generic as V import qualified Data.Vector.Unboxed as UV
type Vec = UV.Vector Double
axpy :: Double -> Vec -> Vec -> Vec axpy a x y = V.zipWith (+) (V.map (* a) x) y
sumVecs :: [(Double, Vec)] -> Vec sumVecs axs = let (a, x) = head axs in foldl adder (V.map (* a) x) (tail axs) where adder :: Vec -> (Double, Vec) -> Vec adder v1 (a, x) = axpy a x v1
how to i write this in a way which ensures recycling / fusion, e.g. in-place updates?
Unfortunately, recycling won't help you here. It is a purely local optimisation which doesn't work across function boundaries (inlining notwithstanding) and recursive calls. Your best bet is to use a mutable vector and do the fold in the ST monad. That said, it would be quite possible to provide something like the following: fold_inplace :: Vector v a => (v a -> b -> v a) -> v a -> [b] -> v a This could use the recycling framework to safely do as much in-place as possible while still preserving a purely functional interface. I have to think about it. Really, this looks like just a poor man's substitute for linear types. Roman

On Fri, Apr 16, 2010 at 11:19 PM, Roman Leshchinskiy
That said, it would be quite possible to provide something like the following:
fold_inplace :: Vector v a => (v a -> b -> v a) -> v a -> [b] -> v a
as far as i understand there would be two ways of writing such a function : 1) to use mutable vectors monadically underneath and hide them inside some kind of unsafeX, or 2) to give a specialized fold with sufficient hints to the compiler to use the rewriting framework. i attempted to start 1, but it seems like this function can not have an entirely pure interface and still avoid copying. more specifically, the signature for the update function (v a -> b -> v a) seems like it necessarily creates a copy, unless i misunderstand? wouldn't you need some kind of monadic update function (v a -> b -> m () ) which modifies the vector in place?
This could use the recycling framework to safely do as much in-place as possible while still preserving a purely functional interface. I have to think about it. Really, this looks like just a poor man's substitute for linear types.
although i am supposed to know something about category theory, since my training is in math, i don't know about girard's later work. is there a short precis you can give (or a pointer?) thanks and best regards, ben

On 18/04/2010, at 08:07, Ben wrote:
On Fri, Apr 16, 2010 at 11:19 PM, Roman Leshchinskiy
wrote: That said, it would be quite possible to provide something like the following:
fold_inplace :: Vector v a => (v a -> b -> v a) -> v a -> [b] -> v a
as far as i understand there would be two ways of writing such a function : 1) to use mutable vectors monadically underneath and hide them inside some kind of unsafeX, or 2) to give a specialized fold with sufficient hints to the compiler to use the rewriting framework.
Right, I meant 2. I'm not saying it's necessarily a good idea, just that it would be possible.
This could use the recycling framework to safely do as much in-place as possible while still preserving a purely functional interface. I have to think about it. Really, this looks like just a poor man's substitute for linear types.
although i am supposed to know something about category theory, since my training is in math, i don't know about girard's later work. is there a short precis you can give (or a pointer?)
This is a nice introduction: http://homepages.inf.ed.ac.uk/wadler/papers/linear/linear.ps Also, Clean's uniqueness types are quite similar. Roman
participants (3)
-
Ben
-
Jason Dagit
-
Roman Leshchinskiy