start implementing for–next loops with continuations

pull/2/head
Matthew Butterick 9 years ago
parent 0ad719ce4a
commit 30fa41f05f

@ -35,6 +35,10 @@
(define (raise-program-end-error)
(raise (exn:program-end "" (current-continuation-marks))))
(struct exn:line-end exn:fail ())
(define (raise-line-end-error)
(raise (exn:line-end "" (current-continuation-marks))))
(define (run line-list)
(define lines (list->vector line-list))
(define (find-index ln)
@ -57,12 +61,14 @@
(define return-stack empty)
(define (do-gosub number where)
(define (do-gosub this-line where)
(if (or (empty? return-stack)
(not (= number (car return-stack))))
(not (= this-line (car return-stack))))
(begin
(set! return-stack (cons number return-stack))
(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))))
(struct $line (number thunk) #:transparent)
@ -70,7 +76,8 @@
[(_ NUMBER (statement "gosub" WHERE))
#'($line NUMBER (λ () (do-gosub NUMBER WHERE)))]
[(_ NUMBER . STATEMENTS)
#'($line NUMBER (λ () . STATEMENTS))])
#'($line NUMBER (λ () (with-handlers ([exn:line-end? (λ _ #f)])
. STATEMENTS)))])
(define-macro statement
[(statement ID "=" EXPR) #'(set! ID EXPR)]
@ -84,9 +91,10 @@
#'(if (true? COND-EXPR)
TRUE-EXPR
FALSE-EXPR)]
[(_ COND TRUE-EXPR)
#'(when (true? COND)
TRUE-EXPR)])
[(_ COND-EXPR TRUE-EXPR)
#'(if (true? COND-EXPR)
TRUE-EXPR
(raise-line-end-error))]) ; special short-circuit rule for one-armed conditional
(define true? (compose1 not zero?))
(define (cond->int cond) (if cond 1 0))
@ -149,3 +157,43 @@
(define (basic:return) (car return-stack))
(define (basic:end) (raise-program-end-error))
(define for-stack empty)
(define (push-for-stack thunk)
(set! for-stack (cons thunk for-stack)))
(define (pop-for-stack)
(set! for-stack (cdr for-stack)))
(define-macro basic:for
[(_ VAR START-VALUE END-VALUE)
#'(basic:for VAR START-VALUE END-VALUE 1)]
[(_ VAR START-VALUE END-VALUE STEP-VALUE)
#'(begin
(cond
[(and (pair? for-stack)
(eq? 'VAR (car (car for-stack))))
;; we're already in the midst of a loop, so keep going
(raise-line-end-error)]
[else
(statement VAR "=" START-VALUE)
(call/cc (λ(for-k)
(push-for-stack (λ ()
(define next-val (+ VAR STEP-VALUE))
(and (<= next-val END-VALUE)
(set! VAR next-val)
(for-k))))))
(raise-line-end-error)]))])
(define-macro basic:next
[(_ VAR)
;; todo: named `next` means find var in stack
#'()]
[(_)
;; plain `next` implies var on top of stack
#'(if (pair? for-stack)
(let ([for-thunk (car for-stack)])
(unless (for-thunk)
(pop-for-stack)))
(error 'next "for-stack is empty"))])

@ -0,0 +1,5 @@
#lang br/demo/basic
10 for A=1 to 5 step 3
20 print A
30 next
40 print "yay"

@ -12,6 +12,8 @@ statement : "end"
| ID "=" expr
| "print" [print-list]
| "return"
| "for" ID /"=" value /"to" value [/"step" value]
| "next" [ID]
print-list : expr [";" [print-list]]

Loading…
Cancel
Save