Google Groups

Re: computed goto


informatimago Aug 10, 2012 7:32 AM
Posted in group: comp.lang.lisp
"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?

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