improve handling of negative numbers; add `DEF`

beautiful-racket/br/demo/basic/expander.rkt

@@ -75,7 +75,7 @@
   [(statement ID "=" EXPR) #'(set! ID EXPR)]
   [(statement PROC-NAME . ARGS)
    (with-pattern
-     ([PROC-ID (prefix-id "basic:" #'PROC-NAME)])
+       ([PROC-ID (prefix-id "basic:" #'PROC-NAME)])
      #'(PROC-ID . ARGS))])
 
 (define-macro basic:if
@@ -104,7 +104,7 @@
    #'(cond->int (equal? SUM COMP-EXPR))] ; special case because `=` is overloaded in basic
   [(_ SUM OP-STR COMP-EXPR)
    (with-pattern
-     ([OP (replace-context #'here (prefix-id #'OP-STR))])
+       ([OP (replace-context #'here (prefix-id #'OP-STR))])
      #'(cond->int (OP SUM COMP-EXPR)))])
 
 (define <> (compose1 not equal?))
@@ -115,25 +115,44 @@
   [(_ SUM "-" PRODUCT) #'(- SUM PRODUCT)])
 
 (define-macro product
+  [(_ "-" VALUE) #'(- VALUE)]
   [(_ VALUE) #'VALUE]
   [(_ PRODUCT "*" VALUE) #'(* PRODUCT VALUE)]
   [(_ PRODUCT "/" VALUE) #'(/ PRODUCT VALUE)])
 
+(define-macro number
+  [(_ "-" NUM) #'(- NUM)]
+  [(_ NUM) #'NUM])
+
+(define-macro id-val
+  [(_ "-" ID) #'(- ID)]
+  [(_ ID) #'ID])
+
 (define print-list list)
 
+;; todo: make it work more like http://www.antonis.de/qbebooks/gwbasman/PRINT.html
 (define (basic:print [args #f])
   (match args
     [#f (displayln "")]
-    [(list print-list-item ... ";" pl) (begin (for-each display print-list-item)
+    [(list print-list-item ... ";" pl) (begin (for-each (λ(pli)
+                                                          (let ([pli (if (number? pli)
+                                                                         (format "~a " pli)
+                                                                         pli)])
+                                                            (display pli))) print-list-item)
                                               (basic:print pl))]
     [(list print-list-item ... ";") (for-each display print-list-item)]
     [(list print-list-item ...) (for-each displayln print-list-item)]))
 
+
+;; todo: make it work more like http://www.antonis.de/qbebooks/gwbasman/TAB.html
+;; need to track current line position
 (define (TAB num) (make-string num #\space))
 (define-macro (INT _ARG ...) #'(inexact->exact (truncate (expr _ARG ...))))
 (define (SIN num) (sin num))
 (define (ABS num) (inexact->exact (abs num)))
 (define (RND num) (* (random) num))
+(define (EXP num) (exp num))
+(define (SQR num) (sqrt num))
 
 (define-macro basic:input
   [(_ (print-list . PL-ITEMS) ID ...)
@@ -163,6 +182,10 @@
 (define (pop-for-stack)
   (set! for-stack (cdr for-stack)))
 
+(define (in-closed-interval? x left right)
+  (define cmp (if (< left right) <= >=))
+  (cmp left x right))
+
 (define-macro basic:for
   [(_ VAR START-VALUE END-VALUE)
    #'(basic:for VAR START-VALUE END-VALUE 1)]
@@ -173,7 +196,7 @@
          (push-for-stack (cons 'VAR
                                (λ () ; thunk that increments counter & teleports back to beginning of loop
                                  (define next-val (+ VAR STEP-VALUE))
-                                 (if (<= next-val END-VALUE)
+                                 (if (next-val . in-closed-interval? . START-VALUE END-VALUE)
                                      (begin
                                        (set! VAR next-val)
                                        (return-k #f)) ; return value for subsequent visits to line
@@ -188,4 +211,7 @@
   (for-thunk))
 
 (define-macro (basic:next VAR ...)
-  #'(handle-next 'VAR ...))
+  #'(handle-next 'VAR ...))
+
+(define-macro (basic:def DEF-ID LAMBDA-ID EXPR)
+  #'(set! DEF-ID (λ (LAMBDA-ID) EXPR)))

beautiful-racket/br/demo/basic/parser.rkt

@@ -4,7 +4,8 @@ basic-program : line*
 
 line: NUMBER statement [/":" statement]*
 
-statement : "end" | "stop"
+statement : "def" id /"(" id /")" /"=" expr
+| "end" | "stop"
 | "gosub" expr
 | "goto" expr
 | "if" expr /"then" (statement | expr) [/"else" (statement | expr)]
@@ -25,12 +26,16 @@ sum : [sum ("+" | "-")] product
 
 product : [product ("*" | "/")] value 
 
-@value : id
+@value : id-val
 | id-expr
 | /"(" expr /")"
-| NUMBER
+| number
 | STRING
 
 /id-expr : id [/"(" expr [/"," expr]* /")"]
 
 @id : ID
+
+id-val : ["-"] id
+
+number : ["-"] NUMBER

beautiful-racket/br/demo/basic/tabs.bas

@@ -0,0 +1,5 @@
+#lang br/demo/basic
+
+5 print 30; "foo"
+10 PRINT TAB(10);"*";
+20 PRINT TAB(15);"*";

beautiful-racket/br/demo/basic/tokenizer.rkt

@@ -6,8 +6,9 @@
 
 (define-lex-abbrevs
   (natural (repetition 1 +inf.0 numeric))
-  (number (union (seq (? "-") natural)
-                 (seq (? "-") (? natural) (seq "." natural))))
+;; don't lex the leading "-": muddles "-X" and "Y-X"
+  (number (union (seq natural)
+                 (seq (? natural) (seq "." natural))))
   (quoted-string (seq "\"" (repetition 0 +inf.0 (char-complement "\"")) "\"")))
 
 (define (tokenize input-port)
@@ -15,19 +16,19 @@
     (define get-token
       (lexer-src-pos
        [(eof) eof]
+       [(seq "/*" (complement (seq any-string "*/" any-string)) "*/") (get-token input-port)]
        [(union #\tab #\space #\newline
                (seq number " REM" (repetition 0 +inf.0 (char-complement #\newline)) #\newline)) (get-token input-port)]
        [(union "PRINT" "print" "FOR" "for" "TO" "to" "STEP" "step" "IF" "if"
                "GOTO" "goto" "INPUT" "input" "LET" "let" "NEXT" "next"
                "RETURN" "return" "CLEAR" "clear" "LIST" "list" "RUN" "run"
                "END" "end" "THEN" "then" "ELSE" "else" "GOSUB" "gosub"
-               "AND" "and" "OR" "or" "STOP" "stop" "LET" "let"
+               "AND" "and" "OR" "or" "STOP" "stop" "LET" "let" "DEF" "def"
                ";" "=" "(" ")" "+" "-" "*" "/"
                "<=" ">=" "<>" "<" ">" "=" ":" ",") (string-downcase lexeme)]
-       [(union ",") (get-token input-port)]
        [number (token 'NUMBER (string->number lexeme))]
-       [(seq (repetition 1 +inf.0 upper-case) (? "$")) (token 'ID (string->symbol lexeme))]
-       [upper-case (token 'UPPERCASE (string->symbol lexeme))]
+       [(seq upper-case (repetition 0 +inf.0 (or upper-case numeric)) (? "$")) (token 'ID (string->symbol lexeme))]
        [quoted-string (token 'STRING (string-trim lexeme "\""))]))
     (get-token input-port))  
   next-token)
+