tagbody.scm

(use gauche.sequence)     ; for fold2

(define-macro (tagbody . body)
  (let ([entry (gensym)]        ;implicit label for the entry
        [escape (gensym)])
    (receive (segments rest)
        (fold2 (^(f ss fs)
                 (if (symbol? f)
                   (values (cons (reverse `((,f ,escape) ,@fs)) ss) (list f))
                   (values ss (cons f fs))))
               '() `(,entry) body)
      (let1 segments (reverse (cons (reverse rest) segments))
        ;; segments :: (id form ...)
        `(letrec (,@(map (^s `[,(car s) (^(,escape)
                                          (letrec ([go (^l (,escape l))])
                                            ,@(cdr s)))])
                         segments))
           (trampoline ,entry))))))

;; trampoline driver
(define (trampoline entry)
  (let/cc finish
    (let loop ((label entry))
      (loop (let/cc e (finish (label e)))))))

#|
(define (sum n)
  (let ((s 0) (i 0))
    (tagbody
          (print "start!")
     loop:
          (if (= i n) (go end:))
          (set! s (+ s i))
          (set! i (+ i 1))
          (print "s="s" i="i)
          (go loop:)
     end:
          (values s)))) ; use 'values' to avoid 's' from being recognized as a label
|#