diff --git a/beautiful-racket/br/demo/basic/expander.rkt b/beautiful-racket/br/demo/basic/expander.rkt index 8d57e12..a662531 100644 --- a/beautiful-racket/br/demo/basic/expander.rkt +++ b/beautiful-racket/br/demo/basic/expander.rkt @@ -3,9 +3,11 @@ #%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 ...) @@ -13,24 +15,27 @@ (define (basic-run . lines) (define program-lines (list->vector (filter (λ(x) x) lines))) - (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)))) + (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 - [#'(line 'end) #'#f] - [#'(_ NUMBER STATEMENT 'end) #'(cons NUMBER (λ _ STATEMENT))] - [#'(_ STATEMENT 'end) #'(cons #f (λ _ STATEMENT))]) + [#'(_ NUMBER STATEMENT) #'(cons NUMBER (λ _ STATEMENT))] + [#'(_ STATEMENT) #'(cons #f (λ _ STATEMENT))]) (define #'(statement NAME ARG ...) #'(NAME ARG ...)) @@ -42,11 +47,24 @@ (define #'(printitem EXPR-OR-STRING) #'EXPR-OR-STRING) -(define #'(printlist ITEM-OR-SEPARATOR ...) #'(list ITEM-OR-SEPARATOR ...)) +;; 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) - (for-each display args) - (displayln "")) +(define (PRINT . 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) diff --git a/beautiful-racket/br/demo/basic/parser.rkt b/beautiful-racket/br/demo/basic/parser.rkt index 458e855..4284590 100644 --- a/beautiful-racket/br/demo/basic/parser.rkt +++ b/beautiful-racket/br/demo/basic/parser.rkt @@ -1,11 +1,18 @@ #lang ragg ;; adapted from http://www.ittybittycomputers.com/IttyBitty/TinyBasic/TBuserMan.txt -basic-program : line* +;; MS Basic extensions +;; http://www.atariarchives.org/basicgames/showpage.php?page=i12 -line : NUMBER statement CR | statement CR | CR +;; games +;; http://www.vintage-basic.net/games.html -statement : "PRINT" printlist + +basic-program : [CR] line (CR line)* [CR] + +line: [NUMBER] statement (":" statement)* + +statement : "PRINT" printlist* | "PR" printlist | "INPUT" varlist | "LET" var "=" expression @@ -15,20 +22,20 @@ statement : "PRINT" printlist | "RETURN" | "IF" expression relop expression "THEN" statement | "IF" expression relop expression statement -;| "REM" commentstring ; todo: implement in tokenizer | "CLEAR" | "RUN" | "RUN" exprlist | "LIST" | "LIST" exprlist -printlist : printitem [(":" | separator printlist)] +; formerly printlist : printitem [(":" | (separator printitem)*)] +printlist : printitem (separator printitem)* printitem : expression | STRING -varlist: var ["," varlist] +varlist: var ("," var)* -exprlist : expression ["," exprlist] +exprlist : expression ("," expression)* expression : [("+"|"-")] unsignedexpr @@ -43,12 +50,13 @@ factor : var function : "RND(" expression ")" | "USR(" exprlist ")" +| "TAB(" expression ")" number : NUMBER separator : "," | ";" -var : UPPERCASE +var : "A" | "B" | "C" | "D" | "T" digit: DIGIT diff --git a/beautiful-racket/br/demo/basic/test-change.rkt b/beautiful-racket/br/demo/basic/test-change.rkt new file mode 100644 index 0000000..a15edbf --- /dev/null +++ b/beautiful-racket/br/demo/basic/test-change.rkt @@ -0,0 +1,9 @@ +#lang br/demo/basic + +REM program listing from +REM http://www.vintage-basic.net/bcg/change.bas + +2 PRINT TAB(33);"CHANGE" +4 PRINT TAB(15);"CREATIVE COMPUTING MORRISTOWN, NEW JERSEY" +REM 10 PRINT:PRINT + diff --git a/beautiful-racket/br/demo/basic/tokenizer.rkt b/beautiful-racket/br/demo/basic/tokenizer.rkt index c16bbbf..b88c765 100644 --- a/beautiful-racket/br/demo/basic/tokenizer.rkt +++ b/beautiful-racket/br/demo/basic/tokenizer.rkt @@ -9,13 +9,17 @@ (define (next-token) (define get-token (lexer - ["\n" (token 'CR ''end)] + [(:seq "REM" (repetition 1 +inf.0 (char-complement "\n")) (repetition 0 +inf.0 "\n")) + (token 'COMMENT lexeme #:skip? #t)] + [(repetition 1 +inf.0 "\n") (token 'CR '(CR))] [(union "PRINT" "IF" "THEN" "GOTO" "INPUT" "LET" "GOSUB" "RETURN" "CLEAR" "LIST" "RUN" "END") (string->symbol lexeme)] + ;; this only matches integers [(repetition 1 +inf.0 numeric) (token 'NUMBER (string->number lexeme))] - [(char-set ",+-ε*/<>=") lexeme] + [(char-set ",;:+-ε*/<>=()") lexeme] + [(:seq (repetition 1 +inf.0 upper-case) "(") lexeme] [upper-case (token 'UPPERCASE lexeme)] [whitespace (token 'WHITESPACE lexeme #:skip? #t)] [(:seq "\"" (complement (:: any-string "\"" any-string)) "\"") (token 'STRING (string-trim lexeme "\""))]