From aeac5dcd31af8a89ae79d82e10d4d3051d2efa51 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Thu, 21 Apr 2016 19:01:39 -0700
Subject: [PATCH] implement gosub

---
 beautiful-racket/br/demo/basic/expander.rkt | 40 +++++++++++++--------
 beautiful-racket/br/demo/basic/gosub.bas    | 12 ++++---
 2 files changed, 34 insertions(+), 18 deletions(-)

diff --git a/beautiful-racket/br/demo/basic/expander.rkt b/beautiful-racket/br/demo/basic/expander.rkt
index 54c166d..24c5647 100644
--- a/beautiful-racket/br/demo/basic/expander.rkt
+++ b/beautiful-racket/br/demo/basic/expander.rkt
@@ -21,8 +21,21 @@
 
 (define #'(program LINE ...) #'(run (list LINE ...)))
 
+
+(struct exn:line-not-found exn:fail ())
+
+
 (define (run lines)
   (define program-lines (list->vector (filter (λ(ln) (not (equal? ln "cr"))) lines)))
+  (define (line-number->index ln)
+    (or
+     (for/or ([idx (in-range (vector-length program-lines))])
+             (and (= (car (vector-ref program-lines idx)) ln)
+                  idx))
+     (raise
+      (exn:line-not-found
+       (format "line number ~a not found in program" ln)
+       (current-continuation-marks)))))
   (void (with-handlers ([exn:program-end? (λ (exn) (void))])
           (for/fold ([program-counter 0])
                     ([i (in-naturals)]
@@ -31,10 +44,7 @@
               (vector-ref program-lines program-counter))
             (define maybe-jump-number (and proc (proc)))
             (if (number? maybe-jump-number)
-                (let ([jump-number maybe-jump-number])
-                  (for/or ([idx (in-range (vector-length program-lines))])
-                          (and (= (car (vector-ref program-lines idx)) jump-number)
-                               idx)))
+                (line-number->index maybe-jump-number)
                 (add1 program-counter))))))
 
 (define #'(cr-line ARG ...) #'(begin ARG ...))
@@ -43,10 +53,16 @@
 (define current-return-stack (make-parameter empty))
 
 (define-cases #'line
-  [#'(_ NUMBER (STATEMENT "GOSUB" WHERE)) #'(cons NUMBER
-                                                  (λ _
-                                                    (current-return-stack (cons NUMBER (current-return-stack)))
-                                                    (GOTO WHERE)))]
+  [#'(_ NUMBER (STATEMENT "GOSUB" WHERE))
+   #'(cons NUMBER
+           (λ _
+             (let ([return-stack (current-return-stack)])
+               (cond
+                 [(or (empty? return-stack)
+                      (not (= NUMBER (car return-stack))))
+                  (current-return-stack (cons NUMBER (current-return-stack)))
+                  (GOTO WHERE)]
+                 [else (current-return-stack (cdr (current-return-stack)))]))))]
   [#'(_ NUMBER STATEMENT ...)  #'(cons NUMBER (λ _ STATEMENT ...))])
 
 
@@ -125,13 +141,8 @@
 (define (GOTO where)
   where)
 
-(define (GOSUB where)
-  where)
-
 (define (RETURN)
-  (define where (car (current-return-stack)))
-  (current-return-stack (cdr (current-return-stack)))
-  where)
+  (car (current-return-stack)))
 
 
 (struct exn:program-end exn:fail ())
@@ -141,4 +152,5 @@
     "program ended"
     (current-continuation-marks))))
 
+
 (define (comment . args) void)
diff --git a/beautiful-racket/br/demo/basic/gosub.bas b/beautiful-racket/br/demo/basic/gosub.bas
index ea6683f..614ae47 100644
--- a/beautiful-racket/br/demo/basic/gosub.bas
+++ b/beautiful-racket/br/demo/basic/gosub.bas
@@ -1,5 +1,9 @@
 #lang br/demo/basic
-10 GOSUB 40
-11 END
-20 PRINT "YAY"
-25 RETURN
\ No newline at end of file
+10 GOSUB 50
+15 PRINT "BOOM"
+17 GOSUB 30
+20 END
+30 PRINT "YAY"
+40 RETURN
+50 PRINT "50"
+55 RETURN
\ No newline at end of file