adjust grammar

8 years ago · 1515dee76b
parent fca4b96b7b
commit 1515dee76b
6 changed files with 130 additions and 49 deletions
--- a/beautiful-racket/br/demo/basic/change.bas
+++ 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
--- 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 ...)])
--- 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 : "<" [("="|">")] | ">" [("="|"<")] | "="
+negate-expr : ["-"] power-expr
+
+power-expr : [power-expr "^"] value
+
+value : "(" expr ")"
+| ID ["(" expr-list ")"]
+| constant
+
+constant : INTEGER | STRING | REAL
--- a/beautiful-racket/br/demo/basic/sinewave.bas
+++ 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
--- 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
--- 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 "\""))]