From f932378a9da20ce6a94fdbff44b4f7e598ab4b28 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 16 Feb 2017 13:08:32 -0800 Subject: [PATCH] touchups --- beautiful-racket-demo/basic-demo-2/cond.rkt | 41 +++++++++++++++++++ .../basic-demo-2/elements.rkt | 7 +++- beautiful-racket-demo/basic-demo-2/go.rkt | 12 +++--- beautiful-racket-demo/basic-demo-2/if.rkt | 40 ------------------ beautiful-racket-demo/basic-demo-2/lexer.rkt | 2 +- beautiful-racket-demo/basic-demo-2/parser.rkt | 24 +++++------ 6 files changed, 65 insertions(+), 61 deletions(-) create mode 100644 beautiful-racket-demo/basic-demo-2/cond.rkt delete mode 100644 beautiful-racket-demo/basic-demo-2/if.rkt diff --git a/beautiful-racket-demo/basic-demo-2/cond.rkt b/beautiful-racket-demo/basic-demo-2/cond.rkt new file mode 100644 index 0000000..7b0502f --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2/cond.rkt @@ -0,0 +1,41 @@ +#lang br +(require "go.rkt") +(provide b-if b-or-expr b-and-expr b-not-expr b-comp-expr) + +(define (bool->int val) (if val 1 0)) +(define nonzero? (compose1 not zero?)) + +(define-macro-cases b-or-expr + [(_ VAL) #'VAL] + [(_ LEFT "or" RIGHT) + #'(bool->int (or (nonzero? LEFT) (nonzero? RIGHT)))]) + +(define-macro-cases b-and-expr + [(_ VAL) #'VAL] + [(_ LEFT "and" RIGHT) + #'(bool->int (and (nonzero? LEFT) (nonzero? RIGHT)))]) + +(define-macro-cases b-not-expr + [(_ VAL) #'VAL] + [(_ "not" VAL) #'(if (nonzero? VAL) 0 1)]) + +(define b= (compose1 bool->int =)) +(define b< (compose1 bool->int <)) +(define b> (compose1 bool->int >)) +(define b<> (compose1 bool->int not =)) + +(define-macro-cases b-comp-expr + [(_ VAL) #'VAL] + [(_ LEFT "=" RIGHT) #'(b= LEFT RIGHT)] + [(_ LEFT "<" RIGHT) #'(b< LEFT RIGHT)] + [(_ LEFT ">" RIGHT) #'(b> LEFT RIGHT)] + [(_ LEFT "<>" RIGHT) #'(b<> LEFT RIGHT)]) + +(define-macro-cases b-if + [(_ COND-EXPR THEN-EXPR) #'(b-if COND-EXPR THEN-EXPR (void))] + [(_ COND-EXPR THEN-EXPR ELSE-EXPR) + #'(let ([result (if (nonzero? COND-EXPR) + THEN-EXPR + ELSE-EXPR)]) + (when (exact-positive-integer? result) + (b-goto result)))]) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/elements.rkt b/beautiful-racket-demo/basic-demo-2/elements.rkt index 4e1136b..ffe89af 100644 --- a/beautiful-racket-demo/basic-demo-2/elements.rkt +++ b/beautiful-racket-demo/basic-demo-2/elements.rkt @@ -1,3 +1,6 @@ #lang br -(require "line.rkt" "go.rkt" "if.rkt" "expr.rkt" "misc.rkt") -(provide (all-from-out "line.rkt" "go.rkt" "if.rkt" "expr.rkt" "misc.rkt")) \ No newline at end of file +(require "line.rkt" "go.rkt" + "expr.rkt" "misc.rkt" "cond.rkt") +(provide + (all-from-out "line.rkt" "go.rkt" + "expr.rkt" "misc.rkt" "cond.rkt")) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/go.rkt b/beautiful-racket-demo/basic-demo-2/go.rkt index 24ecfc8..2edf9ba 100644 --- a/beautiful-racket-demo/basic-demo-2/go.rkt +++ b/beautiful-racket-demo/basic-demo-2/go.rkt @@ -7,18 +7,18 @@ (define (b-goto num-expr) (raise (change-line-signal num-expr))) -(define return-stack empty) +(define return-ccs empty) (define (b-gosub num-expr) - (let/cc return-cc - (push! return-stack return-cc) + (let/cc here-cc + (push! return-ccs here-cc) (b-goto num-expr))) (define (b-return) - (unless (pair? return-stack) + (unless (pair? return-ccs) (raise-line-error "return without gosub")) - (define top-return-k (pop! return-stack)) - (top-return-k)) + (define top-return-cc (pop! return-ccs)) + (top-return-cc (void))) (define thunk-table (make-hasheq)) diff --git a/beautiful-racket-demo/basic-demo-2/if.rkt b/beautiful-racket-demo/basic-demo-2/if.rkt deleted file mode 100644 index 67f26be..0000000 --- a/beautiful-racket-demo/basic-demo-2/if.rkt +++ /dev/null @@ -1,40 +0,0 @@ -#lang br -(require "go.rkt") -(provide b-if b-comp-expr b-logic-expr) - - -#| -explain why this won't work due to premature eval of THEN & ELSE -(define (b-if COND THEN ELSE) - (let ([result (if (not (zero? COND)) - THEN - ELSE)]) - (when (exact-positive-integer? result) - (b-goto result)))) -|# - -(define-macro-cases b-if - [(_ COND THEN) #'(b-if COND THEN #f)] - [(_ COND THEN ELSE) #'(let ([result (if (not (zero? COND)) - THEN - ELSE)]) - (when (exact-positive-integer? result) - (b-goto result)))]) - -(define bool-int (λ (val) (if val 1 0))) -(define bi= (compose1 bool-int =)) -(define bi< (compose1 bool-int <)) -(define bi> (compose1 bool-int >)) - -;; b-comp-expr : b-cond-expr [("and" | "or") b-cond-expr] -(define-macro-cases b-logic-expr - [(_ ARG) #'ARG] - [(_ LEFT "and" RIGHT) #'(and LEFT RIGHT)] - [(_ LEFT "or" RIGHT) #'(or LEFT RIGHT)]) - -;; b-cond-expr : b-expr [("=" | "<" | ">") b-expr] -(define-macro-cases b-comp-expr - [(_ ARG) #'ARG] - [(_ LEFT "=" RIGHT) #'(bi= LEFT RIGHT)] - [(_ LEFT "<" RIGHT) #'(bi< LEFT RIGHT)] - [(_ LEFT ">" RIGHT) #'(bi> LEFT RIGHT)]) diff --git a/beautiful-racket-demo/basic-demo-2/lexer.rkt b/beautiful-racket-demo/basic-demo-2/lexer.rkt index 5e08a4b..e5f6456 100644 --- a/beautiful-racket-demo/basic-demo-2/lexer.rkt +++ b/beautiful-racket-demo/basic-demo-2/lexer.rkt @@ -3,7 +3,7 @@ (define-lex-abbrev digits (:+ (char-set "0123456789"))) -(define-lex-abbrev reserved-terms (:or "print" "goto" "end" "+" ":" ";" "let" "=" "input" "-" "*" "/" "^" "mod" "(" ")" "def" "if" "then" "else" "and" "or" "not" "<" ">" "<>" "gosub" "return" "for" "to" "step" "next")) +(define-lex-abbrev reserved-terms (:or "print" "goto" "end" "+" ":" ";" "let" "=" "input" "-" "*" "/" "^" "mod" "(" ")" "def" "if" "then" "else" "<" ">" "<>" "and" "or" "not" "gosub" "return" "for" "to" "step" "next")) (define basic-lexer (lexer-srcloc diff --git a/beautiful-racket-demo/basic-demo-2/parser.rkt b/beautiful-racket-demo/basic-demo-2/parser.rkt index 5d4b21e..a5d9e1b 100644 --- a/beautiful-racket-demo/basic-demo-2/parser.rkt +++ b/beautiful-racket-demo/basic-demo-2/parser.rkt @@ -4,32 +4,32 @@ b-program : [b-line] (/NEWLINE [b-line])* b-line : b-line-num [b-statement] (/":" [b-statement])* [b-rem] @b-line-num : INTEGER b-rem : REM -@b-statement : b-end | b-print | b-goto | b-let -| b-input | b-def | b-gosub -| b-return | b-for | b-next | b-if +@b-statement : b-end | b-print | b-goto + | b-let | b-input | b-if + | b-gosub | b-return | b-for | b-next b-end : /"end" b-print : /"print" [b-printable] (/";" [b-printable])* @b-printable : STRING | b-expr b-goto : /"goto" b-expr b-let : [/"let"] b-id /"=" (STRING | b-expr) -b-if : /"if" b-expr /"then" (b-statement | b-expr) [/"else" (b-statement | b-expr)] -b-gosub : /"gosub" b-expr -b-return : /"return" +b-if : /"if" b-expr /"then" (b-statement | b-expr) + [/"else" (b-statement | b-expr)] b-input : /"input" b-id @b-id : ID -b-def : /"def" b-id /"(" b-id /")" /"=" b-expr +b-gosub : /"gosub" b-expr +b-return : /"return" b-for : /"for" b-id /"=" b-expr /"to" b-expr [/"step" b-expr] b-next : /"next" [b-id] -b-expr : b-logic-expr -b-logic-expr : [b-logic-expr ("and"|"or"|"not")] b-comp-expr +b-expr : b-or-expr +b-or-expr : [b-or-expr "or"] b-and-expr +b-and-expr : [b-and-expr "and"] b-not-expr +b-not-expr : ["not"] b-comp-expr b-comp-expr : [b-comp-expr ("="|"<"|">"|"<>")] b-sum b-sum : [b-sum ("+"|"-")] b-product b-product : [b-product ("*"|"/"|"mod")] b-neg b-neg : ["-"] b-expt b-expt : [b-expt ("^")] b-value -@b-value : b-number | b-id | /"(" b-expr /")" | b-not | b-func -/b-func : b-id /"(" b-expr /")" -b-not : /"!" b-value +@b-value : b-number | b-id | /"(" b-expr /")" @b-number : INTEGER | DECIMAL \ No newline at end of file