Suppose we have the situation, perhaps not too far distant, where Haskell
  compilers generate highly efficient code.  I tend to think that even though
  Haskell is (becoming) quite general purpose, there is still going to be
  some resistance from programmers at large, because many are concerned with
  being able to reasonably predict complexity.

  Perhaps this can be dealt with, at least partially, at the language level.
  Proposal: introduce a substitution operator which preserves safe semantics
  but explicitly indicates where updates may occur, so an analysis phase is
  still needed.  Such an operator could be applied to general data structures.
  Example:

  Instead of:
    change (_:xs) 0 y = y:xs
    change (x:xs) i y = x:change xs (i-1) y

  Use (with more or less arbitrary syntax):
    change xs@(x:_) 0 y = xs[x->y]
    change xs@(_:xs') i y = xs[xs'->change xs' (i-1) y]

  Comments?

George, I think you are implying that if an unshared list is passed to
this function then it can be mutated instead of copied.  But
determining that it is unshared can be very difficult (of course it is
undecideable in general).  Note in particular that you have to
determine if any of the list's SUBSTRUCTURE is shared.  So how does
this help solve your original problem?  I.e. it will STILL be very
hard for the programmer to understand the efficiency of her program,
and even worse, she will have to understand this for EVERY COMPILER
and thus it is not even a portable behavior.

But, there has been progress in dealing with problems like this
in recent years.  Two ideas in particular:

1) The use of some kind of type system to ensure that the state
   is not shared.

2) The use of information hiding to ensure that the state is
   not shared.

The latter approach is manifested in several styles, the most popular
being "monadic", but of equal interest are what I call "direct" and
"continuation-passing" (CPS).  I've written a paper recently that
basically solves the following problem:

  You give me an ADT axiomatization that satisfies a certain linearity
  property, and I will return to you an equivalent ADT in direct, monadic,
  or CPS style that GUARANTEES that the updates can be done destructively.

The resulting ADT I call a MUTABLE ADT (MADT).  Because the new
axiomatization can be generated automatically, it is possible to
design this into a language: A user defines an ADT in the usual way,
and provided that it satisfies the linearity property, the MADT is
derived automatically.  The user of such a MADT can be guaranteed
efficient updates, in every single place that the update is used, with
no analysis required.

As an example, let's axiomatize monomorphic (for simplicity) lists to
include your "change" and "select" functions:

nil    :: [Int]
cons   :: Int -> [Int] -> [Int]
select :: Int -> [Int] -> Int
change :: Int -> Int -> [Int] -> [Int]

select 0 (cons x xs) = x
select i (cons x xs) = select (i-1) xs

change 0 y (cons x xs) = cons y xs
change i y (cons x xs) = cons (i-1) y (cons

("select" subsumes the usual "head" function.  We should probably also
include a "tail" function to make lists shorter, but I'll omit that
for now.  I'm also ignoring the errors that "nil" might generate!)

A CPS MADT for this is as follows (I actually cranked through the CPS
transformation in my paper to generate these axioms):

type Cont = [Int] -> Int
nilC    :: Cont -> Int
consC   :: Int -> Cont -> Cont
selectC :: Int -> (Int -> Cont) -> Cont
changeC :: Int -> Int -> Cont -> Cont

consC x (selectC 0 k)   = consC x (k x)
consC x (selectC i k)   = selectC (i-1) (\y-> consC x (k y))
consC x (changeC 0 y c) = consC y c
consC x (changeC i y c) = changeC (i-1) y (consC x c)

Here the new operators are named changeC, selectC, consC, and nilC.
You should read these in "continuation-passing-style".  For example,
the last equation says: "changing the i'th element after having just
consed x, is the same as consing x after changing the (i-1)'th element."

Here's how this might be used:

nilC        $       -- allocate new list
consC 1     $       -- cons 1 onto it
consC 1     $       -- cons another 1 onto it
changeC 1 5 $       -- change the 2nd element to 5 (0-based index)
selectC 1   $ \y->  -- grab the 2nd element; it's value will be 5
...

Of course, you may not like this coding style, but it's the price to
be paid with this method.  You can consult my paper to see how the
"hidden" list can indeed be "updated in place", along the lines of
your original suggestion.  I have used this same technique to
axiomatize things like arrays and graphs, although this is the first
time I tried something like your "change" function on lists.  Let me
know if you'd like a copy of the paper.

  -Paul

Professor Paul Hudak
Department of Computer Science
Yale University
New Haven, CT 06520
(203) 432-4715
[EMAIL PROTECTED]

Reply via email to