|
|
@ -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
|
|
|
|
(current-return-stack (cons NUMBER (current-return-stack)))
|
|
|
|
(λ _
|
|
|
|
(GOTO WHERE)))]
|
|
|
|
(let ([return-stack (current-return-stack)])
|
|
|
|
|
|
|
|
(cond
|
|
|
|
|
|
|
|
[(or (empty? return-stack)
|
|
|
|
|
|
|
|
(not (= NUMBER (car return-stack))))
|
|
|
|
|
|
|
|
(current-return-stack (cons NUMBER (current-return-stack)))
|
|
|
|
|
|
|
|
(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)
|
|
|
|