From b83a09e6af74eb6bfa6a9298b0c2b6ca6558c514 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 9 Jun 2016 18:45:21 -0700 Subject: [PATCH] improve handling of negative numbers; add `DEF` --- beautiful-racket/br/demo/basic/expander.rkt | 36 +++++++++++++++++--- beautiful-racket/br/demo/basic/parser.rkt | 11 ++++-- beautiful-racket/br/demo/basic/tabs.bas | 5 +++ beautiful-racket/br/demo/basic/tokenizer.rkt | 13 +++---- 4 files changed, 51 insertions(+), 14 deletions(-) create mode 100644 beautiful-racket/br/demo/basic/tabs.bas diff --git a/beautiful-racket/br/demo/basic/expander.rkt b/beautiful-racket/br/demo/basic/expander.rkt index 5295ff5..fae0154 100644 --- a/beautiful-racket/br/demo/basic/expander.rkt +++ b/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 ...)) \ No newline at end of file + #'(handle-next 'VAR ...)) + +(define-macro (basic:def DEF-ID LAMBDA-ID EXPR) + #'(set! DEF-ID (λ (LAMBDA-ID) EXPR))) \ No newline at end of file diff --git a/beautiful-racket/br/demo/basic/parser.rkt b/beautiful-racket/br/demo/basic/parser.rkt index 4b01a4e..c327c9f 100644 --- a/beautiful-racket/br/demo/basic/parser.rkt +++ b/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 \ No newline at end of file diff --git a/beautiful-racket/br/demo/basic/tabs.bas b/beautiful-racket/br/demo/basic/tabs.bas new file mode 100644 index 0000000..d3acdbf --- /dev/null +++ b/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);"*"; \ No newline at end of file diff --git a/beautiful-racket/br/demo/basic/tokenizer.rkt b/beautiful-racket/br/demo/basic/tokenizer.rkt index 186e415..33fba26 100644 --- a/beautiful-racket/br/demo/basic/tokenizer.rkt +++ b/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) +