"Pascal J. Bourguignon" <
p...@informatimago.com> writes:
> "Pascal J. Bourguignon" <
p...@informatimago.com> writes:
>
>> zermelo <
zer...@nospam.teletu.it> writes:
>>
>>> I need to code something like this:
>>> (let ((n 2))
>>> (tagbody
>>> (go n)
>>> 1 (print 1)
>>> 2 (print 2)))
>>> => expected 2
>>>
>>> Is there a way I can pass an expression to the go form?
>>>
>>> Thanks
>>> Ps
>>> I don’t need a ‘goto considered harmful’ sermon :)
>>
>> (defmacro computed-tagbody (&body body)
>> (let ((tags (remove-if-not (lambda (tag) (or (symbolp tag) (integerp tag))) body)))
>> `(macrolet ((goto (expression)
>> `(ecase ,expression
>> ,@(mapcar (lambda (tag) `((,tag) (go ,tag))) ',tags))))
>> (tagbody
>> ,@body))))
>
> Exercise left to the reader: implement a computed-comefrom operator! :-)
Solution:
(defmacro comefrom-tagbody (&body body)
"
DO: Implement the COMEFROM control structure:
EXAMPLE:
(comefrom-tagbody
:start
(print 'hi)
:next
(print 'lo)
(comefrom :next)
(print 'one)
(go :end)
(comefrom :next)
(print 'two)
:end)
prints:
HI
ONE
or prints:
HI
TWO
and returns:
NIL
Note: The COMEFROM forms can only be written on the
toplevel of the BODY.
"
(let* ((cftags (make-hash-table))
(newbody (loop
:named first-collect-comefroms
:with newbody = '()
:for item :in body
:do (if (and (consp item) (eq 'comefrom (car item)))
(let ((newtag (gensym)))
(push newtag newbody)
(push newtag (gethash (second item) cftags '())))
(push item newbody))
:finally (return-from first-collect-comefroms (nreverse newbody))))
(finalbody (loop
:named add-the-go-from-the-tags
:with finalbody = '()
:for item :in newbody
:do (let ((cf (gethash item cftags)))
(push item finalbody)
(when cf
(if (cdr cf)
;; more than one comefrom this tag! Let's choose randomly
(push `(case (random ,(length cf))
,@(let ((i -1)) (mapcar (lambda (tag)
`((,(incf i)) (go ,tag)))
cf)))
finalbody)
;; a single comefrom
(push `(go (car cf)) finalbody))))
:finally (return-from add-the-go-from-the-tags (nreverse finalbody)))))
`(macrolet ((comefrom (tag) `(error "~S can only be used at the toplevel of the COMEFROM-TAGBODY body."'comefrom)))
(tagbody
,@finalbody))))
(let ((i 0))
(comefrom-tagbody
(comefrom :end-loop)
(if (< i 5) (go :print))
:test-done
:print
(print (incf i))
:end-loop
(comefrom :test-done)
(print 'done)
(terpri)))
prints:
1
2
3
4
5
done
--> nil
(comefrom-tagbody
:start
(print 'hi)
:next
(print 'lo)
(comefrom :next)
(print 'one)
(go :end)
(comefrom :next)
(print 'two)
:end
(terpri))
prints:
hi
two
--> nil
or:
hi
one
--> nil
As can be seen, not having comefrom inside subforms of the body is a big
inconvenient, since it means we have to use GO too. Exercise left to
the reader: modify the macro to be able to come from, and come into
inside subforms, so that we can write:
(let ((i 0))
(comefrom-tagbody
(comefrom :end-loop)
(if (>= i 5)
:done)
(print (incf i))
:end-loop
(comefrom :done)
(print 'done)
(terpri)))
prints:
1
2
3
4
5
done
--> nil
What would:
(let ((i 0))
(comefrom-tagbody
(comefrom :end-loop)
(if (>= i 5)
:done)
(print (incf i))
:end-loop
(if (zerop (random 2))
(comefrom 5))
(print 'done)
(terpri)))
do?