Re: RFC: Overloaded arrays

2000-03-29 Thread Chris Okasaki

Simon Marlow wrote:
 class HasBounds a = IArray a e where
 (!) :: Ix ix = a ix e - ix - e
 array   :: Ix ix = (ix,ix) - [(ix,e)] - a ix e
 
 class (Monad m, HasBounds a) = MArray a e m where
 read:: Ix ix = a ix e - ix - m e
 write   :: Ix ix = a ix e - ix - e - m ()
 marray  :: Ix ix = (ix,ix) - m (a ix e)

My main comment is please don't ignore a simple update operation
on immutable arrays, with a type something like
  update :: Ix ix = a ix e - ix - e - a ix e
I don't care about the name but I do care about the functionality.
I'm perfectly happy with the naive, dirt simple, O(n) implementation 
that copies the whole array and makes the update in the copy.  Yes,
there is the // operation, but 95% of the time I just want to
update a single element.

Most functional languages leave this operation out, I presume because
the feeling is that it is so expensive that no one would ever
want to call it.  But I've found myself wanting it lots of times,
usually with very short arrays (say, length 4 or 8).

Chris




Re: RFC: Overloaded arrays

2000-03-29 Thread Chris Okasaki

Simon Marlow wrote:
 Actually, I'm slightly concerned about your use of small arrays: the static
 (one-off) cost of allocating an array is quite high compared to eg. tuples
 or records.  Are arrays the only solution here?

You're right of course that arrays are quite expensive, but 
it is not clear to me whether this is an inherent property of
arrays or an artifact of the current implementation.

At least part of it is inherent, because of the extremely
general nature of Haskell's arrays (use of Ix, arbitrary
bounds).  I've never understood the advantages of these
arrays over a more primitive mechanism (indexed by integers
starting at 0), with the fancier arrays built on top of
the primitive arrays in a library.  But this is not a battle
I'm prepared to fight right now!

As to whether arrays are the only solution, well, no.
Tuples are out because the size is not necessarily known
in advance.  Or even if the size is known, you may
expect it to change several times during development.
Lists are a posibility, but, when I say "short,
that might be as high as maybe 256.  Some tree-like
implementation of arrays, such as Braun trees would 
not be unreasonable.  But arrays seem like the most
natural choice.  It would be a shame it steer programmers
away from arrays just because they are disproportionately
expensive.

Chris




RE: RFC: Overloaded arrays

2000-03-29 Thread Simon Marlow

 Some commented type signatures in MArray interface mention ST instead
 of the generic monad. Signatures of MArray class operations have
 "a s ix e" instead of "a ix e".

Oh, thanks.  As you can see, I've been through a few iterations with the
design already :)

 A proposal to resolve name clashes between IArray and MArray: suffix
 mutable with M, like currently mapM, zipWithM, filterM etc. It's not
 clear if M would come from *M*onad or from *M*utable.

I was hoping that the module system might help out here: ie. MArray.assoc
vs. IArray.assoc etc., but it might turn out that this is just too painful.
Your proposal is noted.

 For consistency references could be overloaded wrt. the monad too.
 It leads to a conflict among generic names for arrays and references:
 read and write.

agreed, I was going to try this too.

 Why do ArrayBase.newUArray and fill use foldr instead of mapM_?
 Does GHC generate worse code for mapM_ (which would be a pity itself)?

For foldr/build fusion:  eg.  (array ixs . map) is supposed to fuse.

I've still to do some proper experiments to check that all this abstraction
can be properly optimised away, and that includes making sure that fusion
works too.  Initial tests seem fairly positive though.

 It looks like complexity of IArray.accumArray is O(n^2).

Yep, I haven't bothered importing GHC's efficient version yet.

Thanks for the comments,

Simon