|
|
|
@ -13,8 +13,8 @@
|
|
|
|
|
(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)))
|
|
|
|
|
(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) ...
|
|
|
|
@ -63,23 +63,15 @@
|
|
|
|
|
|
|
|
|
|
(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)]
|
|
|
|
@ -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))
|
|
|
|
|