diff --git a/beautiful-racket/br/demo/basic/expander.rkt b/beautiful-racket/br/demo/basic/expander.rkt index 86ea89d..7994dba 100644 --- a/beautiful-racket/br/demo/basic/expander.rkt +++ b/beautiful-racket/br/demo/basic/expander.rkt @@ -39,18 +39,18 @@ (exn:line-not-found (format "line number ~a not found in program" ln) (current-continuation-marks))))) - (with-handlers ([exn:program-end? (λ _ (void))]) - (for/fold ([program-counter 0]) - ([i (in-naturals)]) - (cond - [(= program-counter (vector-length program-lines)) (basic:END)] - [else - (match-define (cons line-number proc) - (vector-ref program-lines program-counter)) - (define maybe-jump-number (and proc (proc))) - (if (number? maybe-jump-number) - (line-number->index maybe-jump-number) - (add1 program-counter))]))) + (for/fold ([program-counter 0]) + ([i (in-naturals)] + #:break (eq? program-counter 'end)) + (cond + [(= program-counter (vector-length program-lines)) (basic:END)] + [else + (define line-function (cdr (vector-ref program-lines program-counter))) + (define maybe-next-line (and line-function (line-function))) + (cond + [(number? maybe-next-line) (line-number->index maybe-next-line)] + [(eq? 'end maybe-next-line) 'end] + [else (add1 program-counter)])])) (void)) (define #'(cr-line _arg ...) #'(begin _arg ...)) @@ -115,7 +115,7 @@ (define-cases #'comp-expr [#'(_ _LEXPR "=" _REXPR) #'(comp-expr _LEXPR "equal?" _REXPR)] ; special case because = is overloaded [#'(_ _LEXPR _op _REXPR) (inject-syntax ([#'OP (string->symbol (syntax->datum #'_op))]) - #'(cond->int (OP _LEXPR _REXPR)))] + #'(cond->int (OP _LEXPR _REXPR)))] [#'(_ _ARG) #'_ARG]) (define <> (compose1 not equal?)) @@ -151,17 +151,12 @@ (basic:PRINT (append _PRINT-LIST (list ";"))) (basic:INPUT _ID))] [#'(_ _ID) #'(set! _ID (let* ([str (read-line)] - [num (string->number str)]) - (if num num str)))]) + [num (string->number str)]) + (if num num str)))]) (define (basic:GOTO where) where) (define (basic:RETURN) (car (current-return-stack))) - -(struct exn:program-end exn:fail ()) (define (basic:END) - (raise - (exn:program-end - "program ended" - (current-continuation-marks)))) + 'end) diff --git a/beautiful-racket/br/demo/basic/expander0.rkt b/beautiful-racket/br/demo/basic/expander0.rkt deleted file mode 100644 index a9a55e2..0000000 --- a/beautiful-racket/br/demo/basic/expander0.rkt +++ /dev/null @@ -1,87 +0,0 @@ -#lang br -(provide (all-defined-out) - #%top-interaction - #%datum - (rename-out [basic-module-begin #%module-begin])) -(require (for-syntax racket/string)) - -(define #'(basic-module-begin PARSE-TREE ...) - #'(#%module-begin - (println (quote PARSE-TREE ...)) - 'PARSE-TREE ...)) - -(define #'(basic-program LINE ...) - #'(basic-run LINE ...)) - -(define (basic-run . lines) - (define program-lines (list->vector (filter (λ(x) x) lines))) - (void (for/fold ([line-idx 0]) - ([i (in-naturals)] - #:break (= line-idx (vector-length program-lines))) - (match-define (cons line-number proc) - (vector-ref program-lines line-idx)) - (define maybe-jump-number (and proc (proc))) - (if (number? maybe-jump-number) - (let ([jump-number maybe-jump-number]) - (for/or ([idx (in-range (vector-length program-lines))]) - (and (= (car (vector-ref program-lines idx)) jump-number) - idx))) - (add1 line-idx))))) - -(define #'(CR) #'#f) - -(define #'(REM ARG ...) #'(void (list 'ARG ...))) - -;; model each line as (cons line-number line-thunk) -(define-cases #'line - [#'(_ NUMBER . SEPARATED-STMTS) - #`(cons NUMBER - (λ _ (begin - #,@(for/list ([(item idx) (in-indexed (syntax->list #'SEPARATED-STMTS))] - #:when (even? idx)) - item))))] - [#'(_ ARG ...) #'(line #f ARG ...)]) - -(define #'(statement NAME ARG ...) #'(NAME ARG ...)) - -(define #'(expression ITEM) #'ITEM) -(define #'(unsignedexpr ITEM) #'ITEM) -(define #'(term ITEM) #'ITEM) -(define #'(factor ITEM) #'ITEM) -(define #'(number ITEM) #'ITEM) -(define #'(varlist ITEM) #'ITEM) -(define #'(var ITEM) #'ITEM) - - -(define #'(printitem EXPR-OR-STRING) #'EXPR-OR-STRING) - -;; skip separators -(define #'(printlist . SEPARATED-ITEMS) #`(list #,@(for/list ([(item idx) (in-indexed (syntax->list #'SEPARATED-ITEMS))] - #:when (even? idx)) - item))) - -(define #'(separator SEP) #'(void)) - -(define #'(function NAME EXP ")") #`(#,(string->symbol (string-trim (syntax->datum #'NAME) "(")) EXP)) - -(define (TAB expr) - (make-string expr #\space)) - -(define (PRINT . args) - (println args) - (if (and (= (length args) 1) (list? (car args))) - (begin - (for-each display (car args)) - (displayln "")) - (filter (λ(i) (and (equal? i ":") (displayln ""))) args))) - -(define (GOTO where) - where) - -(define vars (make-hasheq)) -(define (INPUT id) - (hash-set! vars (string->symbol id) (read (open-input-string (read-line))))) - -(define-cases #'expr-list - [#'(_ EXPR ...) #'(list EXPR ...)]) - diff --git a/beautiful-racket/br/demo/basic/parser0.rkt b/beautiful-racket/br/demo/basic/parser0.rkt deleted file mode 100644 index d3beba8..0000000 --- a/beautiful-racket/br/demo/basic/parser0.rkt +++ /dev/null @@ -1,61 +0,0 @@ -#lang ragg -;; adapted from http://www.ittybittycomputers.com/IttyBitty/TinyBasic/TBuserMan.txt - -;; MS Basic extensions -;; http://www.atariarchives.org/basicgames/showpage.php?page=i12 - -;; games -;; http://www.vintage-basic.net/games.html - -;; chipmunk basic -;; http://www.nicholson.com/rhn/basic/basic.man.html - -basic-program : [CR] line [CR line]* [CR] - -line: INTEGER statements - -statements : statement [":" statement]* - -statement : "END" -| "FOR" ID "=" expr "TO" expr ["STEP" expr] -| "GOTO" expr -| "IF" expr "THEN" (statement | expr) ; change: add expr -| "INPUT" id-list -| ["LET"] ID "=" expr ; change: make "LET" opt -| "NEXT" id-list -| "PRINT" print-list -| "REM" STRING - -id-list : ID ["," id-list] - -;value-list : value ["," value]* - -;datum-list : datum ["," datum]* - -;integer-list : INTEGER ["," INTEGER]* - -expr-list : expr ["," expr]* - -print-list : [expr [";" print-list]] - -;expr : and-expr ["OR" expr] -;and-expr : not-expr ["AND" and-expr] -;not-expr : ["NOT"] compare-expr -;compare-expr : term [("=" | "<>" | "><" | ">" | ">=" | "<" | "<=") compare-expr] - -expr : term [("=" | "<>" | "><" | ">" | ">=" | "<" | "<=") expr] - - -term : factor [("+" | "-") term] - -factor : value [("*" | "/") factor] - -;negate-expr : ["-"] power-expr - -;power-expr : [power-expr "^"] value - -value : "(" expr ")" -| ID ["(" expr-list ")"] -| datum - -datum : INTEGER | STRING | REAL