From 1515dee76b75ac3265e4f85735f24f17e60f95ce Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 18 Apr 2016 22:47:02 -0700 Subject: [PATCH] adjust grammar --- beautiful-racket/br/demo/basic/change.bas | 51 +++++++++++++ beautiful-racket/br/demo/basic/expander.rkt | 18 ++++- beautiful-racket/br/demo/basic/parser.rkt | 73 +++++++++---------- beautiful-racket/br/demo/basic/sinewave.bas | 16 ++++ .../br/demo/basic/test-change.rkt | 7 +- beautiful-racket/br/demo/basic/tokenizer.rkt | 14 ++-- 6 files changed, 130 insertions(+), 49 deletions(-) create mode 100644 beautiful-racket/br/demo/basic/change.bas create mode 100644 beautiful-racket/br/demo/basic/sinewave.bas diff --git a/beautiful-racket/br/demo/basic/change.bas b/beautiful-racket/br/demo/basic/change.bas new file mode 100644 index 0000000..974afd7 --- /dev/null +++ b/beautiful-racket/br/demo/basic/change.bas @@ -0,0 +1,51 @@ +2 PRINT TAB(33);"CHANGE" +4 PRINT TAB(15);"CREATIVE COMPUTING MORRISTOWN, NEW JERSEY" +5 PRINT:PRINT:PRINT +6 PRINT "I, YOUR FRIENDLY MICROCOMPUTER, WILL DETERMINE" +8 PRINT "THE CORRECT CHANGE FOR ITEMS COSTING UP TO $100." +9 PRINT:PRINT +10 PRINT "COST OF ITEM";:INPUT A:PRINT "AMOUNT OF PAYMENT";:INPUT P +20 C=P-A:M=C:IF C<>0 THEN 90 +25 PRINT "CORRECT AMOUNT, THANK YOU." +30 GOTO 400 +90 IF C>0 THEN 120 +95 PRINT "SORRY, YOU HAVE SHORT-CHANGED ME $";A-P +100 GOTO 10 +120 PRINT "YOUR CHANGE, $";C +130 D=INT(C/10) +140 IF D=0 THEN 155 +150 PRINT D;"TEN DOLLAR BILL(S)" +155 C=M-(D*10) +160 E=INT(C/5) +170 IF E=0 THEN 185 +180 PRINT E;"FIVE DOLLARS BILL(S)" +185 C=M-(D*10+E*5) +190 F=INT(C) +200 IF F=0 THEN 215 +210 PRINT F;"ONE DOLLAR BILL(S)" +215 C=M-(D*10+E*5+F) +220 C=C*100 +225 N=C +230 G=INT(C/50) +240 IF G=0 THEN 255 +250 PRINT G;"ONE HALF DOLLAR(S)" +255 C=N-(G*50) +260 H=INT(C/25) +270 IF H=0 THEN 285 +280 PRINT H;"QUARTER(S)" +285 C=N-(G*50+H*25) +290 I=INT(C/10) +300 IF I=0 THEN 315 +310 PRINT I;"DIME(S)" +315 C=N-(G*50+H*25+I*10) +320 J=INT(C/5) +330 IF J=0 THEN 345 +340 PRINT J;"NICKEL(S)" +345 C=N-(G*50+H*25+I*10+J*5) +350 K=INT(C+.5) +360 IF K=0 THEN 380 +370 PRINT K;"PENNY(S)" +380 PRINT "THANK YOU, COME AGAIN." +390 PRINT:PRINT +400 GOTO 10 +410 END \ No newline at end of file diff --git a/beautiful-racket/br/demo/basic/expander.rkt b/beautiful-racket/br/demo/basic/expander.rkt index a662531..a9a55e2 100644 --- a/beautiful-racket/br/demo/basic/expander.rkt +++ b/beautiful-racket/br/demo/basic/expander.rkt @@ -8,7 +8,7 @@ (define #'(basic-module-begin PARSE-TREE ...) #'(#%module-begin (println (quote PARSE-TREE ...)) - PARSE-TREE ...)) + 'PARSE-TREE ...)) (define #'(basic-program LINE ...) #'(basic-run LINE ...)) @@ -34,8 +34,13 @@ ;; model each line as (cons line-number line-thunk) (define-cases #'line - [#'(_ NUMBER STATEMENT) #'(cons NUMBER (λ _ STATEMENT))] - [#'(_ STATEMENT) #'(cons #f (λ _ STATEMENT))]) + [#'(_ 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 ...)) @@ -44,6 +49,9 @@ (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) @@ -60,6 +68,7 @@ (make-string expr #\space)) (define (PRINT . args) + (println args) (if (and (= (length args) 1) (list? (car args))) (begin (for-each display (car args)) @@ -69,6 +78,9 @@ (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/parser.rkt b/beautiful-racket/br/demo/basic/parser.rkt index 4284590..220956b 100644 --- a/beautiful-racket/br/demo/basic/parser.rkt +++ b/beautiful-racket/br/demo/basic/parser.rkt @@ -7,57 +7,56 @@ ;; 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] +basic-program : [CR] lines [CR] -line: [NUMBER] statement (":" statement)* +lines : INTEGER statements [CR | CR lines] -statement : "PRINT" printlist* -| "PR" printlist -| "INPUT" varlist -| "LET" var "=" expression -| var "=" expression -| "GOTO" expression -| "GOSUB" expression -| "RETURN" -| "IF" expression relop expression "THEN" statement -| "IF" expression relop expression statement -| "CLEAR" -| "RUN" -| "RUN" exprlist -| "LIST" -| "LIST" exprlist +statements : statement [":" statements] -; formerly printlist : printitem [(":" | (separator printitem)*)] -printlist : printitem (separator printitem)* +statement : "CLOSE" "#" INTEGER +| "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" printlist +| "REM" STRING -printitem : expression | STRING +id-list : ID ["," id-list] -varlist: var ("," var)* +value-list : value ["," value-list] -exprlist : expression ("," expression)* +constant-list : constant ["," constant-list] -expression : [("+"|"-")] unsignedexpr +integer-list : INTEGER ["," integer-list] -unsignedexpr : term [("+"|"-") unsignedexpr] +expr-list : expr ["," expr-list] -term : factor [("*"|"/") term] +printlist : [expr [";" printlist]] -factor : var -| number -| "(" expression ")" -| function +expr : and-expr ["OR" expr] -function : "RND(" expression ")" -| "USR(" exprlist ")" -| "TAB(" expression ")" +and-expr : not-expr ["AND" and-expr] -number : NUMBER +not-expr : ["NOT"] compare-expr -separator : "," | ";" +compare-expr : add-expr [("=" | "<>" | "><" | ">" | ">=" | "<" | "<=") compare-expr] -var : "A" | "B" | "C" | "D" | "T" +add-expr : mult-expr [("+" | "-") add-expr] -digit: DIGIT +mult-expr : negate-expr [("*" | "/") mult-expr] -relop : "<" [("="|">")] | ">" [("="|"<")] | "=" \ No newline at end of file +negate-expr : ["-"] power-expr + +power-expr : [power-expr "^"] value + +value : "(" expr ")" +| ID ["(" expr-list ")"] +| constant + +constant : INTEGER | STRING | REAL diff --git a/beautiful-racket/br/demo/basic/sinewave.bas b/beautiful-racket/br/demo/basic/sinewave.bas new file mode 100644 index 0000000..f2f1c74 --- /dev/null +++ b/beautiful-racket/br/demo/basic/sinewave.bas @@ -0,0 +1,16 @@ +#lang br/demo/basic +10 PRINT TAB(30);"SINE WAVE" +20 PRINT TAB(15);"CREATIVE COMPUTING MORRISTOWN, NEW JERSEY" +30 PRINT: PRINT: PRINT: PRINT: PRINT +50 B=0 +110 FOR T=0 TO 40 STEP .25 +120 A=INT(26+25*SIN(T)) +130 PRINT TAB(A); +140 IF B=1 THEN 180 +150 PRINT "CREATIVE" +160 B=1 +170 GOTO 200 +180 PRINT "COMPUTING" +190 B=0 +200 NEXT T +999 END \ No newline at end of file diff --git a/beautiful-racket/br/demo/basic/test-change.rkt b/beautiful-racket/br/demo/basic/test-change.rkt index a15edbf..51c708e 100644 --- a/beautiful-racket/br/demo/basic/test-change.rkt +++ b/beautiful-racket/br/demo/basic/test-change.rkt @@ -5,5 +5,8 @@ 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 - +5 PRINT:PRINT:PRINT +6 PRINT "I, YOUR FRIENDLY MICROCOMPUTER, WILL DETERMINE" +8 PRINT "THE CORRECT CHANGE FOR ITEMS COSTING UP TO $100." +9 PRINT:PRINT +10 PRINT "COST OF ITEM":INPUT A:PRINT "AMOUNT OF PAYMENT":INPUT P diff --git a/beautiful-racket/br/demo/basic/tokenizer.rkt b/beautiful-racket/br/demo/basic/tokenizer.rkt index b88c765..c44b9b0 100644 --- a/beautiful-racket/br/demo/basic/tokenizer.rkt +++ b/beautiful-racket/br/demo/basic/tokenizer.rkt @@ -9,17 +9,17 @@ (define (next-token) (define get-token (lexer - [(: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" + [(union "PRINT" "FOR" "TO" "STEP" "IF" "THEN" "GOTO" "REM" + "INPUT" "LET" "NEXT" "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] - [(:seq (repetition 1 +inf.0 upper-case) "(") lexeme] + [(repetition 1 +inf.0 numeric) (token 'INTEGER (string->number lexeme))] + [(repetition 1 +inf.0 (union "." numeric)) (token 'REAL (string->number lexeme))] + [(union "," ";" ":" "+" "-" "*" "/" + "<=" ">=" "<>" "><" "<" ">" "=" "(" ")") lexeme] + [(:seq (repetition 1 +inf.0 upper-case)) (token 'ID lexeme)] [upper-case (token 'UPPERCASE lexeme)] [whitespace (token 'WHITESPACE lexeme #:skip? #t)] [(:seq "\"" (complement (:: any-string "\"" any-string)) "\"") (token 'STRING (string-trim lexeme "\""))]