more continuations

pull/2/head
Matthew Butterick 9 years ago
parent 93db2015af
commit 83a1090754

@ -18,7 +18,7 @@
(gather-unique-ids #'(PROGRAM-LINE ...)))]) (gather-unique-ids #'(PROGRAM-LINE ...)))])
#'(#%module-begin #'(#%module-begin
(define UNIQUE-ID 0) ... (define UNIQUE-ID 0) ...
(run PROGRAM-LINE ...)))) (run PROGRAM-LINE ... (line #f (statement "end"))))))
; #%app and #%datum have to be present to make #%top work ; #%app and #%datum have to be present to make #%top work
(define-macro (basic-top . ID) (define-macro (basic-top . ID)
@ -53,13 +53,11 @@
(with-handlers ([end-program-signal? void]) (with-handlers ([end-program-signal? void])
(for/fold ([program-counter 0]) (for/fold ([program-counter 0])
([i (in-naturals)]) ([i (in-naturals)])
(if (= program-counter (vector-length lines)) (let* ([line-thunk ($line-thunk (vector-ref lines program-counter))]
(basic:end) [maybe-line-number (line-thunk)])
(let* ([line-thunk ($line-thunk (vector-ref lines program-counter))] (if (number? maybe-line-number)
[maybe-line-number (line-thunk)]) (find-index maybe-line-number)
(if (number? maybe-line-number) (add1 program-counter)))))))
(find-index maybe-line-number)
(add1 program-counter))))))))
(define return-stack empty) (define return-stack empty)
@ -70,8 +68,8 @@
(struct $line (number thunk) #:transparent) (struct $line (number thunk) #:transparent)
(define-macro (line NUMBER . STATEMENTS) (define-macro (line NUMBER . STATEMENTS)
#'($line NUMBER (λ () (with-handlers ([end-line-signal? (λ _ #f)]) #'($line NUMBER (λ () (with-handlers ([end-line-signal? (λ _ #f)])
. STATEMENTS)))) . STATEMENTS))))
(define-macro statement (define-macro statement
[(statement ID "=" EXPR) #'(set! ID EXPR)] [(statement ID "=" EXPR) #'(set! ID EXPR)]
@ -170,31 +168,27 @@
#'(basic:for VAR START-VALUE END-VALUE 1)] #'(basic:for VAR START-VALUE END-VALUE 1)]
[(_ VAR START-VALUE END-VALUE STEP-VALUE) [(_ VAR START-VALUE END-VALUE STEP-VALUE)
#'(begin #'(begin
(cond ;; initialize the loop counter
[(and (pair? for-stack) (statement VAR "=" START-VALUE)
(eq? 'VAR (car (car for-stack)))) ;; create a point for the `next` statement to return to, using a continuation
;; we're already in the midst of a loop, so abort the rest of the line (let/cc return-point-for-next
(raise-end-line-signal)] (push-for-stack (cons 'VAR
[else (procedure-rename
;; initialize the loop counter (λ () ; thunk that increments counter & teleports back to beginning of loop
(statement VAR "=" START-VALUE) (define next-val (+ VAR STEP-VALUE))
;; create a point for the `next` statement to return to, using a continuation (if (<= next-val END-VALUE)
(let/cc return-point-for-next (begin
(push-for-stack (cons 'VAR (set! VAR next-val)
(λ () ; thunk that increments counter & teleports back to beginning of loop (return-point-for-next #f)) ; return value for subsequent visits to line
(define next-val (+ VAR STEP-VALUE)) (pop-for-stack))) (format-datum "~a-incrementer" 'VAR))))
(when (<= next-val END-VALUE) #f))]) ; return value for first visit to line
(set! VAR next-val)
(return-point-for-next)))))) (define (handle-next [which #f])
(raise-end-line-signal)]))]) (unless (pair? for-stack) (error 'next "for-stack is empty"))
(define for-thunk (cdr (if which
(define (handle-next [stack-selector-proc car]) (assq which for-stack)
(unless (pair? for-stack) (car for-stack))))
(error 'next "for-stack is empty")) (for-thunk))
(let ([for-thunk (cdr (stack-selector-proc for-stack))])
(unless (for-thunk) (define-macro (basic:next VAR ...)
(pop-for-stack)))) #'(handle-next 'VAR ...))
(define-macro basic:next
[(_ VAR) #'(handle-next (λ(stack) (assq 'VAR stack)))] ; named `next` means find var in stack
[(_) #'(handle-next)]) ; plain `next` implies var on top of stack

@ -1,5 +1,8 @@
#lang br/demo/basic #lang br/demo/basic
10 for A=1 to 5 step 3 10 for A=1 to 3
20 print A 20 print A
30 next 21 for B=5 to 8
22 print B
23 next B
30 next A
40 print "yay" 40 print "yay"
Loading…
Cancel
Save