From 93db2015af3b317fd088aabffa1f37de0eaf373d Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Fri, 3 Jun 2016 18:27:18 -0700
Subject: [PATCH] make gosub a continuation

---
 beautiful-racket/br/demo/basic/expander.rkt | 45 +++++++++------------
 beautiful-racket/br/demo/basic/gosub.bas    |  6 +--
 2 files changed, 23 insertions(+), 28 deletions(-)

diff --git a/beautiful-racket/br/demo/basic/expander.rkt b/beautiful-racket/br/demo/basic/expander.rkt
index 845faf6..a89de60 100644
--- a/beautiful-racket/br/demo/basic/expander.rkt
+++ b/beautiful-racket/br/demo/basic/expander.rkt
@@ -13,12 +13,12 @@
     (remove-duplicates (map syntax->datum (filter (λ(s) (syntax-property s 'id)) (syntax-flatten stx))) eq?)))
 
 (define-macro (basic-module-begin (basic-program PROGRAM-LINE ...))
-  (with-pattern
-   ([(UNIQUE-ID ...) (map (compose1 syntax-local-introduce (λ(id) (datum->syntax #f id)))
-                          (gather-unique-ids #'(PROGRAM-LINE ...)))])
-   #'(#%module-begin
-      (define UNIQUE-ID 0) ...
-      (run PROGRAM-LINE ...))))
+  (with-pattern ([(UNIQUE-ID ...)
+                  (map (compose1 syntax-local-introduce (λ(id) (datum->syntax #f id)))
+                       (gather-unique-ids #'(PROGRAM-LINE ...)))])
+    #'(#%module-begin
+       (define UNIQUE-ID 0) ...
+       (run PROGRAM-LINE ...))))
 
 ; #%app and #%datum have to be present to make #%top work
 (define-macro (basic-top . ID)
@@ -63,30 +63,22 @@
 
 (define return-stack empty)
 
-(define (do-gosub this-line where)
-  (if (or (empty? return-stack)
-          (not (= this-line (car return-stack))))
-      (begin
-        (set! return-stack (cons this-line return-stack))
-        (basic:goto where))
-      ;; if (= number (car return-stack))
-      ;; then we reached this line by `return`, which means the end of a gosub
-      (set! return-stack (cdr return-stack))))
+(define (basic:gosub where)
+  (let/cc return-k
+    (set! return-stack (cons return-k return-stack))
+    (basic:goto where)))
 
 (struct $line (number thunk) #:transparent)
-(define-macro line
-  [(_ NUMBER (statement "gosub" WHERE))
-   #'($line NUMBER (λ () (do-gosub NUMBER WHERE)))]
-  [(_ NUMBER . STATEMENTS)
+(define-macro (line NUMBER . STATEMENTS)
    #'($line NUMBER (λ () (with-handlers ([end-line-signal? (λ _ #f)])
-                           . STATEMENTS)))])
+                           . STATEMENTS))))
 
 (define-macro statement
   [(statement ID "=" EXPR) #'(set! ID EXPR)]
   [(statement PROC-NAME . ARGS)
    (with-pattern
-    ([PROC-ID (prefix-id "basic:" #'PROC-NAME)])
-    #'(PROC-ID . ARGS))])
+     ([PROC-ID (prefix-id "basic:" #'PROC-NAME)])
+     #'(PROC-ID . ARGS))])
 
 (define-macro basic:if
   [(_ COND-EXPR TRUE-EXPR FALSE-EXPR)
@@ -114,8 +106,8 @@
    #'(cond->int (equal? SUM COMP-EXPR))] ; special case because `=` is overloaded in basic
   [(_ SUM OP-STR COMP-EXPR)
    (with-pattern
-    ([OP (replace-context #'here (prefix-id #'OP-STR))])
-    #'(cond->int (OP SUM COMP-EXPR)))])
+     ([OP (replace-context #'here (prefix-id #'OP-STR))])
+     #'(cond->int (OP SUM COMP-EXPR)))])
 
 (define <> (compose1 not equal?))
 
@@ -157,7 +149,10 @@
 
 (define (basic:goto where) where)
 
-(define (basic:return) (car return-stack))
+(define (basic:return)
+  (define return-k (car return-stack))
+  (set! return-stack (cdr return-stack))
+  (return-k #f))
 
 (define (basic:stop) (basic:end))
 (define (basic:end) (raise-end-program-signal))
diff --git a/beautiful-racket/br/demo/basic/gosub.bas b/beautiful-racket/br/demo/basic/gosub.bas
index 614ae47..92c5d30 100644
--- a/beautiful-racket/br/demo/basic/gosub.bas
+++ b/beautiful-racket/br/demo/basic/gosub.bas
@@ -1,9 +1,9 @@
 #lang br/demo/basic
 10 GOSUB 50
-15 PRINT "BOOM"
+15 PRINT "2 of 3"
 17 GOSUB 30
 20 END
-30 PRINT "YAY"
+30 PRINT "3 of 3"
 40 RETURN
-50 PRINT "50"
+50 PRINT "1 of 3"
 55 RETURN
\ No newline at end of file