touchups

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

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"))
+(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"))

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))
 

beautiful-racket-demo/basic-demo-2/if.rkt

@@ -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)])

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

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