1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950 |
- ;;;; pvector.lisp
- (in-package #:gamao-impl)
- ;;; PERSISTENT VECTORS
- #|
- A simple diff-based persistent vector implementation. API:
- Type pvector
- make-pvector &rest arguments => value: accepts arguments as make-array, but must be one-dimensional
- pvector-ref pvector index => value
- pvector-update pvector index value => new-pvector
- pvector-reroot pvector => pvector
- |#
- (defstruct (pvector (:constructor %make-pvector)
- (:conc-name %pvector-))
- index value next)
- (defun make-pvector (&rest arguments)
- (%make-pvector :index nil :value nil :next (apply #'make-array arguments)))
- (defun pvector-ref (pvector index)
- (loop for v = pvector then (%pvector-next v)
- for vidx = (%pvector-index v)
- when (null vidx) do (return (aref (%pvector-next v) index))
- when (= vidx index) do (return (%pvector-value v))))
- (defun pvector-update (pvector index value)
- (%make-pvector :index index :value value :next pvector))
- (defun pvector-reroot (pvector)
- (let ((lineage '() ))
- (do ((v pvector (%pvector-next v)))
- ((null (%pvector-index v)))
- (push v lineage))
- (dolist (pvector lineage)
- (let ((next (%pvector-next pvector))
- (index (%pvector-index pvector)))
- (pvector-reroot next)
- (let ((vector (%pvector-next next)))
- (setf (%pvector-next pvector) vector
- (%pvector-next next) pvector
- (%pvector-index next) (%pvector-index pvector)
- (%pvector-value next) (aref vector index)
- (aref vector index) (%pvector-value pvector)
- (%pvector-index pvector) nil
- (%pvector-value pvector) nil)))))
- pvector)
|