is it possible to have something like this:<div><br></div><div>(let ((a '(#1=expr #1#))</div><div> (setmemloc (getmemloc (car a)) (eval (car a))))</div><div><br></div><div>-Taoufik</div><div><br><br><div class="gmail_quote">
On Sun, Sep 30, 2012 at 11:11 AM, Pascal J. Bourguignon <span dir="ltr"><<a href="mailto:pjb@informatimago.com" target="_blank">pjb@informatimago.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">
<div class="im">Taoufik Dachraoui <<a href="mailto:dachraoui.taoufik@gmail.com">dachraoui.taoufik@gmail.com</a>> writes:<br>
<br>
> I am writing a small interpreter for lambda calculus. Within an expression I have some shared expressions<br>
><br>
> The following explains my need to compute a shared expression exactly once:<br>
><br>
> (let ((a '(#1=(+ 2 3) #1#)))<br>
> (setf (first a) (compute (first a)))<br>
> a)<br>
><br>
> -> I would like to see (#1=5 #1#) == (5 5)<br>
><br>
> Is there a way to compute (+ 2 3) and set the result in the same memory location of the expression<br>
<br>
</div>Two solutions:<br>
<br>
- Find all the places where the expression you want to evaluate is<br>
stored, and update them all.<br>
<br>
- wrap all the expressions in a unified box.<br>
<br>
<br>
<br>
The first solution:<br>
<br>
(defmacro & (place &environment env)<br>
"Return a pair of closures (getter . setter) for the given place."<br>
(multiple-value-bind (vars vals store-vars writer-form reader-form)<br>
(get-setf-expansion place env)<br>
`(let (,@(mapcar (function list) vars vals))<br>
(cons (lambda () ,reader-form)<br>
(lambda (,@store-vars) ,writer-form)))))<br>
<br>
<br>
(defgeneric find-all-places (sexp object &optional visited)<br>
(:documentation<br>
"Return a list of places represented as pair of closures<br>
(getter . setter)"))<br>
<br>
(defmethod find-all-places ((sexp t) object &optional visited)<br>
'())<br>
<br>
(defmethod find-all-places ((sexp cons) object &optional visited)<br>
(unless (member sexp visited)<br>
(nconc (when (eql object (car sexp))<br>
(list (& (car sexp))))<br>
(when (eql object (cdr sexp))<br>
(list (& (cdr sexp))))<br>
(find-all-places (car sexp) object (cons sexp visited))<br>
(find-all-places (cdr sexp) object (cons sexp visited)))))<br>
<br>
(defmethod find-all-places ((sexp array) object &optional visited)<br>
(unless (member sexp visited)<br>
(loop<br>
:with result = '()<br>
:with visited = (cons sexp visited)<br>
:for i :below (array-total-size sexp)<br>
:do<br>
(when (eql object (row-major-aref sexp i))<br>
(push (& (row-major-aref sexp i)) result))<br>
(setf result (nconc result (find-all-places (row-major-aref sexp i) object visited)))<br>
:finally (return result))))<br>
<br>
;; Add other method to support other objects in your sexps<br>
;; (structures, clos objects, hash-tables, etc).<br>
<br>
<br>
(let* ((form '#1=(+ 1 2))<br>
(nv (eval form))<br>
(sexp '(#1# 3 #1# #(4 #1# #(5 #1# 6) #1#))))<br>
(values (mapcar (lambda (g.s) (funcall (cdr g.s) nv))<br>
(find-all-places sexp form))<br>
sexp))<br>
--> (3 3 3 3 3)<br>
(3 3 3 #(4 3 #(5 3 6) 3))<br>
<br>
<br>
The second solution:<br>
<br>
(defstruct box<br>
form<br>
value)<br>
<br>
;; you may want to remove the boxes eventually:<br>
<br>
(defgeneric remove-boxes (sexp))<br>
(defmethod remove-boxes ((object box))<br>
(box-value object))<br>
(defmethod remove-boxes ((object t))<br>
object)<br>
(defmethod remove-boxes ((object cons))<br>
(setf (car object) (remove-boxes (car object))<br>
(cdr object) (remove-boxes (cdr object)))<br>
object)<br>
(defmethod remove-boxes ((object array))<br>
(loop<br>
:for i :below (array-total-size object)<br>
:do (setf (row-major-aref object i) (remove-boxes (row-major-aref object i))))<br>
object)<br>
<br>
(let* ((form '(+ 1 2))<br>
(box (make-box :form form))<br>
(sexp `(,box 3 ,box #(4 ,box #(5 ,box 6) ,box))))<br>
(print sexp)<br>
(setf (box-value box) (eval (box-form box)))<br>
(print sexp) (terpri)<br>
(remove-boxes sexp)<br>
sexp)<br>
<br>
(#1=#S(box :form (+ 1 2) :value nil) 3 #1# #(4 #1# #(5 #1# 6) #1#))<br>
(#1=#S(box :form (+ 1 2) :value 3) 3 #1# #(4 #1# #(5 #1# 6) #1#))<br>
--> (3 3 3 #(4 3 #(5 3 6) 3))<br>
<br>
or, with (setf *print-circle* nil):<br>
<br>
(#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)))<br>
(#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)))<br>
--> (3 3 3 #(4 3 #(5 3 6) 3))<br>
<div class="im"><br>
<br>
<br>
> I tried the following:<br>
><br>
> (let ((a '(#1=(+ 2 3) #1#))) (setf (first a) (eval (first a))) a)<br>
> -> (5 (+ 2 3))<br>
><br>
> I want to avoid storing the expressions in a cons like:<br>
<br>
</div>Then you want something like my first solution.<br>
<span class="HOEnZb"><font color="#888888"><br>
--<br>
__Pascal Bourguignon__ <a href="http://www.informatimago.com/" target="_blank">http://www.informatimago.com/</a><br>
A bad day in () is better than a good day in {}.<br>
<br>
_______________________________________________<br>
Openmcl-devel mailing list<br>
<a href="mailto:Openmcl-devel@clozure.com">Openmcl-devel@clozure.com</a><br>
<a href="http://clozure.com/mailman/listinfo/openmcl-devel" target="_blank">http://clozure.com/mailman/listinfo/openmcl-devel</a><br>
</font></span></blockquote></div><br></div>