Shimon%SRI-KL@sri-unix.UUCP (07/26/84)
From: Shimon Cohen <Shimon@SRI-KL>
1] I get more than a 100 (yes: one zero zero) requests
for the working paper about the language for the FAIM
machine. It will take a little while before we will
send it to you. If you have sent only your electronic
address it is not enough.
2] If you remember the debate we had about arrays in Prolog
WELL I have looked closely into the algorithm by Kahn,
if you recall when you update an array (in his method)
you copy the entire list of changes. This copying is
expensive both in time and place, but I think I can do it
in constant time and place ! Namely, update will
generate just one more element to add to the list.
Access is affected just a little bit by this
NEW, IMPROVED, SUPER, DUPER, EXTRA method ...
It preserves the property of the old algorithm: Old unreferenced
versions are left to the mercy of the GC. Also access time for the
most new version is also constant. The only thing is that I am still
checking if there are no bugs, if you are interested try it yourself
and report any bugs to me (THANKS)
-- Shimon Cohen
(the code for the Symbolics 3600 follows)
; ; for the benefit of portability I will define an abstarct ;
data-type for element in the modification list. ; ; The structure has
4 field: ; index - of element chnaged ; value - of element ; next -
in list to escape ; next-skip - skip this element in your search ; qn
- query number ; (defstruct (new-element :conc-name (:type
:named-array))
index value next next-skip (qn 0))
(defmacro get-index (e) (list 'aref e 1)) (defmacro get-value (e)
(list 'aref e 2)) (defmacro get-next (e) (list 'aref e 3)) (defmacro
get-next-skip (e) (list 'aref e 4)) (defmacro get-qn (e) (list 'aref e
5))
(defmacro set-index (e x) `(aset ,x ,e 1)) (defmacro set-value (e x)
`(aset ,x ,e 2)) (defmacro set-next (e x) `(aset ,x ,e 3)) (defmacro
set-next-skip (e x) `(aset ,x ,e 4)) (defmacro set-qn (e x) `(aset ,x
,e 5))
(defmacro new-physical-mva (a e) `(cons ,a ,e))
(defun new-last-element (ae)
(prog (newe newe)
(setq newe (make-new-element))
(set-qn newe (get-qn (cdr ae)))
(set-next (cdr ae) newe)
(rplacd ae newe)
(return newe) ))
(defmacro get-last-element (ae) (list 'cdr ae)) (defmacro
get-physical-array (ae) (list 'car ae))
(defstruct (mva-pointer :conc-name (:type :named-array))
pa-le last-ele list-changes)
(defmacro get-pa-le (aee) `(aref ,aee 1)) (defmacro get-last-ele (aee)
`(aref ,aee 2)) (defmacro get-list-changes (aee) `(aref ,aee 3))
(defun new-mva-pointer (p e l)
(prog (x)
(setq x (make-mva-pointer ))
(aset p x 1)
(aset e x 2)
(aset l x 3)
(return x)))
(defun new-mva (size)
(prog (a e ae)
(setq a (make-array size))
(setq e (make-new-element ))
(setq ae (new-physical-mva a e))
(return (new-mva-pointer ae nil (cdr ae))) ))
(defun update-mva (mva i v)
(prog (ae e pmva laste newlaste)
(setq ae (get-pa-le mva))
(setq pmva (get-physical-array ae)) ; pmva the physical
mva
(setq laste (get-last-element ae))
; last ele. now will hold modification
(setq e (get-last-ele mva))
(set-index laste i)
(set-value laste (aref pmva i)) ; store value
(aset v pmva i) ; update (in zeta-lisp)
(setq newlaste (new-last-element ae) ); create new
element
(set-next-skip laste e )
(return (if (eq laste (get-list-changes mva))
(new-mva-pointer ae nil newlaste)
(new-mva-pointer ae laste (get-list-changes
mva))
))
))
(defun ref-mva (mva i)
(prog (ae e pmva x laste flag )
(setq ae (get-pa-le mva))
(setq pmva (get-physical-array ae)) ; pmva the physical mva
(setq laste (get-last-element ae)) ; last ele. now hold
modification
(setq e (get-last-ele mva)) ; to skip
(set-qn laste (setq qn (1+ (get-qn laste)))) ; incr. query
number
(loop while (and e (neq i (get-index e)))
do (set-qn e qn)
do (setq e (get-next-skip e))
; do (describe e)
)
(loop initially (setq x (if e (get-next e) (get-list-changes
mva)))
while (neq x laste)
do (if (and (eq i (get-index x)) (neq qn (get-qn x)))
(return (setq flag t))
(setq x (get-next x))
))
(return (if flag (get-value x) (aref pmva i)))
))
(defvar x nil) (defvar a nil) (defvar b nil) (defvar c nil) (defvar d
nil) (defvar e nil) (defvar f nil) (defvar g nil) (defvar h nil)
(defvar i nil) (defun test ()
(prog ()
(setq a (new-mva 10))
(setq b (update-mva a 1 'b))
(setq c (update-mva b 3 'c))
(setq d (update-mva c 3 'd))
(setq e (update-mva d 2 'e))
(setq f (update-mva d 1 'f))
(setq g (update-mva c 2 'g))
(setq h (update-mva f 2 'h))
(setq i (update-mva g 1 'i))
(setq x (list a b c d e f g h))
(return x)
))