Quasi-functional arrays (was: Re: Mutation)

[Pierpaolo Bernardi]

   From: "Harvey J. Stein" <abel@netvision.net.il>

   Regarding the use of mutation, isn't it pretty common once you start
   using arrays?  When doing large data analyses in Lisp, I've had to
   replace lists of numbers with typed arrays, and changed computations
   to all work in place so as to reduce garbage creation.  This is to
   increase efficiency, and often helps alot (can give a factor of 2 or 3
   speedup, or even make an intractible problem tractible).  What sort of
   effects are the anti-mutation proposals going to have on this?


This is not exactly what is being discussed in this thread, but may be
useful for experimenting with functional looking arrays.  This code is
based on an implementation presented in L.C.Paulson, 'ML for the
working Programmer'.

This technique works well when there are few versions live at any one
time.

I think it may result useful for implementing unicode readtables.

The book cites as source (I haven't read this):

Annika Aasa, Sören Holmström & Christina Nilsson (1988).  An
efficiency comparison of some representations of purely functional
arrays. BIT, 28:490-503.

I would be curious to know how these arrays perform in abel's typical
applications.


Minimanual:
-----------

USER(106): ,ld varray
; Loading ./varray.lisp
USER(107): (use-package :varray)
T
USER(108): (setf qq (create-varray 10 :initial-element 0))
#(0 0 0 0 0 0 0 0 0 0)
USER(109): (setf ww (update qq 2 'foo))
#(0 0 FOO 0 0 0 0 0 0 0)
USER(110): (setf ee (update qq 6 'bar))
#(0 0 0 0 0 0 BAR 0 0 0)
USER(111): (setf rr (update ee 2 'quux))
#(0 0 QUUX 0 0 0 BAR 0 0 0)
USER(112): qq
#(0 0 0 0 0 0 0 0 0 0)
USER(113): ww
#(0 0 FOO 0 0 0 0 0 0 0)
USER(114): ee
#(0 0 0 0 0 0 BAR 0 0 0)
USER(115): rr
#(0 0 QUUX 0 0 0 BAR 0 0 0)
USER(116): (sub ww 2)
FOO
USER(117): (sub rr 2)
QUUX

================================================================
;;; -*- Package: VArray -*-

(defpackage :VArray
  (:use :cl)
  (:export "CREATE-VARRAY" "REROOT" "SUB" "UPDATE" "JUST-UPDATE"
	   "WRITE-VARRAY" "VARRAY-OF-VECTOR"))

(in-package :VArray)

(defstruct varray
  (index 0 :type fixnum)
  (elem)
  (next))

(defun create-varray (size &rest keys &key &allow-other-keys)
  (declare (dynamic-extent keys)
	   (fixnum size))
  (make-varray :next (apply #'make-array size keys)))

(defun reroot (va)
  (declare (type varray va))
  (let ((index (varray-index va))
	(elem (varray-elem va))
	(next (varray-next va)))
    (declare (fixnum index))
    (etypecase next
      (vector va)
      (varray (let ((bnext (reroot next)))
		(setf (varray-index bnext) index
		      (varray-elem bnext) (aref (varray-next bnext) index)
		      (aref (varray-next bnext) index) elem
		      (varray-next va) (varray-next bnext)
		      (varray-next bnext) va)
		va)))))

(defun sub (va i)
  (declare (type varray va)
	   (fixnum i))
  (let ((index (varray-index va))
	(elem (varray-elem va))
	(next (varray-next va)))
    (declare (fixnum index))
    (etypecase next
      (vector (aref next i))
      (varray (if (= index i)
		  elem
		  (sub next i))))))

(defun just-update (va i x)
  (declare (type varray va)
	   (fixnum i))
  (make-varray :index i
	       :elem x
	       :next va))

(defun update (va i x)
  (declare (type varray va)
	   (fixnum i))
  (reroot (just-update va i x)))

(defun write-varray (va &optional (where *standard-output*))
  (declare (type varray va))
  (let ((va (reroot va)))
    (write (varray-next va) :stream where)))

(defmethod print-object ((va varray) where)
  (write-varray va where))

(defun varray-of-vector (vec)
  (make-varray :next vec))

;;; EOF