beautiful-racket/beautiful-racket-demo/basic-demo-3/go.rkt

#lang br
(require "struct.rkt" "line.rkt" "misc.rkt")
(provide b-end b-goto b-gosub b-return b-for b-next)

(define (b-end) (raise (end-program-signal)))

(define (b-goto num-expr)
  (raise (change-line-signal num-expr)))

(define return-ccs empty)

(define (b-gosub num-expr)
  (let/cc this-cc
    (push! return-ccs this-cc)
    (b-goto num-expr)))

(define (b-return)
  (unless (not (empty? return-ccs))
    (raise-line-error "return without gosub"))
  (define top-cc (pop! return-ccs))
  (top-cc (void)))

(define next-funcs (make-hasheq))

(define-macro-cases b-for
  [(_ LOOP-ID START END) #'(b-for LOOP-ID START END 1)]
  [(_ LOOP-ID START END STEP)
   #'(b-let LOOP-ID
            (let/cc loop-cc
              (hash-set! next-funcs
                         'LOOP-ID
                         (λ ()
                           (define next-val
                             (+ LOOP-ID STEP))
                           (if (next-val
                                . in-closed-interval? .
                                START END)
                               (loop-cc next-val)
                               (hash-remove! next-funcs
                                             'LOOP-ID))))
              START))])

(define (in-closed-interval? x start end)
  ((if (< start end) <= >=) start x end))

(define-macro (b-next LOOP-ID)
  #'(begin
      (unless (hash-has-key? next-funcs 'LOOP-ID)
        (raise-line-error
         (format "`next ~a` without for" 'LOOP-ID)))
      (define func (hash-ref next-funcs 'LOOP-ID))
      (func)))