comments

beautiful-racket/br/demo/basic/expander.rkt

@@ -3,7 +3,6 @@
          (rename-out [basic-module-begin #%module-begin])
          (rename-out [basic-top #%top])
          (all-defined-out))
-(require br/stxparam)
 
 ; BASIC implementation details
 ; http://www.atariarchives.org/basicgames/showpage.php?page=i12
@@ -42,13 +41,13 @@
     (format "line number ~a not found in program" ln)
     (current-continuation-marks))))
 
-(struct exn:program-end exn:fail ())
+(struct end-program-signal exn:fail ())
-(define (raise-program-end-error)
+(define (raise-end-program-signal)
-  (raise (exn:program-end "" (current-continuation-marks))))
+  (raise (end-program-signal "" (current-continuation-marks))))
 
-(struct exn:line-end exn:fail ())
+(struct end-line-signal exn:fail ())
-(define (raise-line-end-error)
+(define (raise-end-line-signal)
-  (raise (exn:line-end "" (current-continuation-marks))))
+  (raise (end-line-signal "" (current-continuation-marks))))
 
 (define (run . line-list)
   (define lines (list->vector line-list))
@@ -59,7 +58,7 @@
                   idx))
      (raise-line-not-found-error ln)))
   (void
-   (with-handlers ([exn:program-end? void])
+   (with-handlers ([end-program-signal? void])
      (for/fold ([program-counter 0])
                ([i (in-naturals)])
        (if (= program-counter (vector-length lines))
@@ -87,7 +86,7 @@
   [(_ NUMBER (statement "gosub" WHERE))
    #'($line NUMBER (λ () (do-gosub NUMBER WHERE)))]
   [(_ NUMBER . STATEMENTS)
-   #'($line NUMBER (λ () (with-handlers ([exn:line-end? (λ _ #f)])
+   #'($line NUMBER (λ () (with-handlers ([end-line-signal? (λ _ #f)])
                            . STATEMENTS)))])
 
 (define-macro statement
@@ -105,7 +104,7 @@
   [(_ COND-EXPR TRUE-EXPR)
    #'(if (true? COND-EXPR)
          TRUE-EXPR
-         (raise-line-end-error))]) ; special short-circuit rule for one-armed conditional
+         (raise-end-line-signal))]) ; special short-circuit rule for one-armed conditional
 
 (define true? (compose1 not zero?))
 (define (cond->int cond) (if cond 1 0))
@@ -169,7 +168,7 @@
 (define (basic:return) (car return-stack))
 
 (define (basic:stop) (basic:end))
-(define (basic:end) (raise-program-end-error))
+(define (basic:end) (raise-end-program-signal))
 
 (define for-stack empty)
 
@@ -187,18 +186,20 @@
        (cond
          [(and (pair? for-stack)
                (eq? 'VAR (car (car for-stack))))
-          ;; we're already in the midst of a loop, so keep going
+          ;; we're already in the midst of a loop, so abort the rest of the line
-          (raise-line-end-error)]
+          (raise-end-line-signal)]
          [else
+          ;; initialize the loop counter
           (statement VAR "=" START-VALUE)
-          (call/cc (λ(for-k)
+          ;; create a point for the `next` statement to return to, using a continuation
-                     (push-for-stack (cons 'VAR
+          (let/cc return-point-for-next
-                                           (λ ()
+            (push-for-stack (cons 'VAR
-                                             (define next-val (+ VAR STEP-VALUE))
+                                  (λ () ; thunk that increments counter & teleports back to beginning of loop
-                                             (and (<= next-val END-VALUE)
+                                    (define next-val (+ VAR STEP-VALUE))
-                                                  (set! VAR next-val)
+                                    (when (<= next-val END-VALUE)
-                                                  (for-k)))))))
+                                      (set! VAR next-val)
-          (raise-line-end-error)]))])
+                                      (return-point-for-next))))))
+          (raise-end-line-signal)]))])
 
 (define (handle-next [stack-selector-proc car])
   (unless (pair? for-stack)