[Openmcl-devel] compute values in place

[Taoufik Dachraoui]

is it possible to have something like this:

(let ((a '(#1=expr #1#))
       (setmemloc (getmemloc (car a)) (eval (car a))))

-Taoufik


On Sun, Sep 30, 2012 at 11:11 AM, Pascal J. Bourguignon <
pjb at informatimago.com> wrote:

> 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 {}.
>
> _______________________________________________
> Openmcl-devel mailing list
> Openmcl-devel at clozure.com
> http://clozure.com/mailman/listinfo/openmcl-devel
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://lists.clozure.com/pipermail/openmcl-devel/attachments/20120930/8dab99da/attachment.htm>