change

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 (PRINT args)
-  (for-each display args)
-  (displayln ""))
+(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)
+  (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)

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
 

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
+

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 "\""))]