implement gosub

dev-elider-3
Matthew Butterick 9 years ago
parent 8b29799b6f
commit aeac5dcd31

@ -21,8 +21,21 @@
(define #'(program LINE ...) #'(run (list LINE ...))) (define #'(program LINE ...) #'(run (list LINE ...)))
(struct exn:line-not-found exn:fail ())
(define (run lines) (define (run lines)
(define program-lines (list->vector (filter (λ(ln) (not (equal? ln "cr"))) 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))]) (void (with-handlers ([exn:program-end? (λ (exn) (void))])
(for/fold ([program-counter 0]) (for/fold ([program-counter 0])
([i (in-naturals)] ([i (in-naturals)]
@ -31,10 +44,7 @@
(vector-ref program-lines program-counter)) (vector-ref program-lines program-counter))
(define maybe-jump-number (and proc (proc))) (define maybe-jump-number (and proc (proc)))
(if (number? maybe-jump-number) (if (number? maybe-jump-number)
(let ([jump-number maybe-jump-number]) (line-number->index maybe-jump-number)
(for/or ([idx (in-range (vector-length program-lines))])
(and (= (car (vector-ref program-lines idx)) jump-number)
idx)))
(add1 program-counter)))))) (add1 program-counter))))))
(define #'(cr-line ARG ...) #'(begin ARG ...)) (define #'(cr-line ARG ...) #'(begin ARG ...))
@ -43,10 +53,16 @@
(define current-return-stack (make-parameter empty)) (define current-return-stack (make-parameter empty))
(define-cases #'line (define-cases #'line
[#'(_ NUMBER (STATEMENT "GOSUB" WHERE)) #'(cons NUMBER [#'(_ 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))) (current-return-stack (cons NUMBER (current-return-stack)))
(GOTO WHERE)))] (GOTO WHERE)]
[else (current-return-stack (cdr (current-return-stack)))]))))]
[#'(_ NUMBER STATEMENT ...) #'(cons NUMBER (λ _ STATEMENT ...))]) [#'(_ NUMBER STATEMENT ...) #'(cons NUMBER (λ _ STATEMENT ...))])
@ -125,13 +141,8 @@
(define (GOTO where) (define (GOTO where)
where) where)
(define (GOSUB where)
where)
(define (RETURN) (define (RETURN)
(define where (car (current-return-stack))) (car (current-return-stack)))
(current-return-stack (cdr (current-return-stack)))
where)
(struct exn:program-end exn:fail ()) (struct exn:program-end exn:fail ())
@ -141,4 +152,5 @@
"program ended" "program ended"
(current-continuation-marks)))) (current-continuation-marks))))
(define (comment . args) void) (define (comment . args) void)

@ -1,5 +1,9 @@
#lang br/demo/basic #lang br/demo/basic
10 GOSUB 40 10 GOSUB 50
11 END 15 PRINT "BOOM"
20 PRINT "YAY" 17 GOSUB 30
25 RETURN 20 END
30 PRINT "YAY"
40 RETURN
50 PRINT "50"
55 RETURN
Loading…
Cancel
Save