[Openmcl-devel] compute values in place

[Pascal J. Bourguignon]

Taoufik Dachraoui <dachraoui.taoufik at gmail.com> writes:

> I am writing a small interpreter for lambda calculus. Within an expression I have some shared expressions
>
> The following explains my need to compute a shared expression exactly once:
>
> (let ((a '(#1=(+ 2 3) #1#)))
>    (setf (first a) (compute (first a)))
>    a)
>
> -> I would like to see (#1=5 #1#)  == (5 5)
>
> Is there a way to compute (+ 2 3) and set the result in the same memory location of the expression

Two solutions:

- Find all the places where the expression you want to evaluate is
  stored, and  update them all.

- wrap all the expressions in a unified box.



The first solution:

(defmacro & (place &environment env)
  "Return a pair of closures (getter . setter) for the given place."
  (multiple-value-bind (vars vals store-vars writer-form reader-form)
       (get-setf-expansion place env)
    `(let (,@(mapcar (function list) vars vals))
       (cons (lambda () ,reader-form)
             (lambda (, at store-vars) ,writer-form)))))


(defgeneric find-all-places (sexp object &optional visited)
  (:documentation
   "Return a list of places represented as pair of closures
    (getter . setter)"))

(defmethod find-all-places ((sexp t) object &optional visited)
  '())

(defmethod find-all-places ((sexp cons) object &optional visited)
  (unless (member sexp visited)
    (nconc (when (eql object (car sexp))
             (list (& (car sexp))))
           (when (eql object (cdr sexp))
             (list (& (cdr sexp))))
           (find-all-places (car sexp) object (cons sexp visited))
           (find-all-places (cdr sexp) object (cons sexp visited)))))

(defmethod find-all-places ((sexp array) object &optional visited)
  (unless (member sexp visited)
    (loop
      :with result = '()
      :with visited = (cons sexp visited)
      :for i :below (array-total-size sexp)
      :do
      (when (eql object (row-major-aref sexp i))
            (push (& (row-major-aref sexp i)) result))
      (setf result (nconc result (find-all-places (row-major-aref sexp i) object visited)))
      :finally (return result))))

;; Add other method to support other objects in your sexps
;; (structures, clos objects, hash-tables, etc).


(let* ((form '#1=(+ 1 2))
       (nv (eval form))
       (sexp '(#1# 3 #1# #(4 #1# #(5 #1# 6) #1#))))
  (values (mapcar (lambda (g.s) (funcall (cdr g.s) nv))
                  (find-all-places sexp form))
          sexp))
--> (3 3 3 3 3)
    (3 3 3 #(4 3 #(5 3 6) 3))


The second solution:

(defstruct box
  form
  value)

;; you may want to remove the boxes eventually:

(defgeneric remove-boxes (sexp))
(defmethod remove-boxes ((object box))
  (box-value object))
(defmethod remove-boxes ((object t))
  object)
(defmethod remove-boxes ((object cons))
  (setf (car object) (remove-boxes (car object))
        (cdr object) (remove-boxes (cdr object)))
  object)
(defmethod remove-boxes ((object array))
  (loop
    :for i :below (array-total-size object)
    :do (setf (row-major-aref object i) (remove-boxes (row-major-aref object i))))
  object)

(let* ((form '(+ 1 2))
       (box  (make-box :form form))
       (sexp `(,box 3 ,box #(4 ,box #(5 ,box 6) ,box))))
  (print sexp) 
  (setf (box-value box) (eval (box-form box)))
  (print sexp) (terpri)
  (remove-boxes sexp)
  sexp)

(#1=#S(box :form (+ 1 2) :value nil) 3 #1# #(4 #1# #(5 #1# 6) #1#)) 
(#1=#S(box :form (+ 1 2) :value 3) 3 #1# #(4 #1# #(5 #1# 6) #1#)) 
--> (3 3 3 #(4 3 #(5 3 6) 3))

or, with (setf *print-circle* nil):

(#S(box :form (+ 1 2) :value nil) 3 #S(box :form (+ 1 2) :value nil) #(4 #S(box :form (+ 1 2) :value nil) #(5 #S(box :form (+ 1 2) :value nil) 6) #S(box :form (+ 1 2) :value nil))) 
(#S(box :form (+ 1 2) :value 3) 3 #S(box :form (+ 1 2) :value 3) #(4 #S(box :form (+ 1 2) :value 3) #(5 #S(box :form (+ 1 2) :value 3) 6) #S(box :form (+ 1 2) :value 3))) 
--> (3 3 3 #(4 3 #(5 3 6) 3))



> I tried the following:
>
> (let ((a '(#1=(+ 2 3) #1#))) (setf (first a) (eval (first a))) a)
> -> (5 (+ 2 3))
>
> I want to avoid storing the expressions in a cons like:

Then you want something like my first solution.

-- 
__Pascal Bourguignon__                     http://www.informatimago.com/
A bad day in () is better than a good day in {}.