make gosub a continuation
This commit is contained in:
parent
574bb06fb7
commit
93db2015af
|
@ -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))
|
||||
|
|
|
@ -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
|
Loading…
Reference in New Issue
Block a user