tidying

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

@@ -0,0 +1,3 @@
+#lang br
+(require "line.rkt" "goto.rkt" "end.rkt" "let.rkt" "rem.rkt" "print.rkt" "if.rkt" "expr.rkt" "input.rkt" "gosub.rkt" "for.rkt")
+(provide (all-from-out "line.rkt" "goto.rkt" "end.rkt" "let.rkt" "rem.rkt" "print.rkt" "if.rkt" "expr.rkt" "input.rkt" "gosub.rkt" "for.rkt"))

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

@@ -0,0 +1,5 @@
+#lang br
+(require "structs.rkt")
+(provide b-end)
+(define (b-end)
+  (raise (end-program-signal)))

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

@@ -1,15 +1,9 @@
 #lang br/quicklang
 (require "runtime.rkt"
          "run.rkt"
-         "line.rkt"
-         "expr.rkt"
-         "misc.rkt"
-         "flow.rkt")
+         "elements.rkt")
 (provide (rename-out [b-module-begin #%module-begin])
-         (all-from-out "line.rkt"
-                       "expr.rkt"
-                       "misc.rkt"
-                       "flow.rkt"))
+         (all-from-out "elements.rkt"))
 
 (define-macro (b-module-begin (b-program LINE ...))
   (with-pattern

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

@@ -1,9 +1,28 @@
 #lang br
-(provide (matching-identifiers-out #rx"^b-" (all-defined-out)))
+(provide (all-defined-out))
 
-(define (b-sum . nums) (apply + nums))
+;; b-sum : b-product (("+" | "-")  b-product)*
+(define-macro-cases b-sum
+  [(_ PROD) #'PROD]
+  [(_ LEFT-PROD "+" RIGHT-PROD) #'(+ LEFT-PROD RIGHT-PROD)]
+  [(_ LEFT-PROD "-" RIGHT-PROD) #'(- LEFT-PROD RIGHT-PROD)])
 
-(define (b-num-expr expr)
+;; b-product : [b-product ("*"|"/"|"%"|"^")] b-value
+(define-macro-cases b-product
+  [(_ VAL) #'VAL]
+  [(_ LEFT "*" RIGHT) #'(* LEFT RIGHT)]
+  [(_ LEFT "/" RIGHT) #'(/ LEFT RIGHT 1.0)]
+  [(_ LEFT "^" RIGHT) #'(expt LEFT RIGHT)]
+  [(_ LEFT "%" RIGHT) #'(modulo LEFT RIGHT)])
+
+(define (b-expr expr)
   (if (integer? expr) (inexact->exact expr) expr))
 
 (define (b-negative num) (- num))
+
+(define (b-not expr) (if (zero? expr) 1 0))
+
+(define-macro (b-def ID VAR EXPR)
+  #'(set! ID (λ (VAR) EXPR)))
+
+(define (b-func id val) (id val))

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

@@ -1,56 +0,0 @@
-#lang br
-(require "structs.rkt" "misc.rkt" "line.rkt")
-(provide (matching-identifiers-out #rx"^b-" (all-defined-out)))
-
-(define (b-end) (raise (end-program-signal)))
-(define (b-goto num-expr) (raise (change-line-signal num-expr)))
-
-(define gosub-ccs empty)
-
-(define (b-gosub num-expr)
-  (let/cc gosub-cc
-    (push! gosub-ccs gosub-cc)
-    (b-goto num-expr)))
-
-(define (b-return)
-  (unless (pair? gosub-ccs)
-    (raise (line-error "return without gosub")))
-  (define top-return-k (pop! gosub-ccs))
-  (top-return-k))
-
-(define (in-closed-interval? x left right)
-  (define cmp (if (< left right) <= >=))
-  (cmp left x right))
-
-(define-macro-cases b-for
-  [(_ ID START END) #'(b-for ID START END 1)]
-  [(_ ID START END STEP)
-   #'(b-let ID (let/cc top-of-loop-cc
-                 (push-thunk!
-                  (cons 'ID
-                        (λ ()
-                          (define next-val (+ ID STEP))
-                          (if (next-val . in-closed-interval? . START END)
-                              (top-of-loop-cc next-val)
-                              (remove-thunk! 'ID)))))
-                 START))])
-
-(define for-thunks (make-parameter empty))
-
-(define (push-thunk! thunk)
-  (for-thunks (cons thunk (for-thunks))))
-
-(define (remove-thunk! id-sym)
-  (for-thunks (remq (assq id-sym (for-thunks)) (for-thunks))))
-
-(define-macro (b-next ID ...) #'(do-next 'ID ...))
-
-(define (do-next [id-sym #f])
-  (when (empty? (for-thunks))
-    (raise-line-error "next without for"))
-  (define for-thunk
-    (cdr (if id-sym
-             (or (assq id-sym (for-thunks))
-                 (raise-line-error "next without for"))
-             (car (for-thunks)))))
-  (for-thunk))

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

@@ -0,0 +1,30 @@
+#lang br
+(require "let.rkt" "line.rkt")
+(provide b-for b-next)
+
+(define thunk-table (make-hasheq))
+
+(define-macro-cases b-for
+  [(_ LOOP-ID START END) #'(b-for LOOP-ID START END 1)]
+  [(_ LOOP-ID START END STEP)
+   #'(b-let LOOP-ID (let/cc loop-cc
+                      (hash-set! thunk-table
+                                 'LOOP-ID
+                                 (λ ()
+                                   (define next-val (+ LOOP-ID STEP))
+                                   (if (next-val . in-closed-interval? . START END)
+                                       (loop-cc next-val)
+                                       (hash-remove! thunk-table 'LOOP-ID))))
+                      START))])
+
+(define (in-closed-interval? x start end)
+  (if (< start end)
+      (<= start x end)
+      (<= end x start)))
+
+(define-macro (b-next LOOP-ID)
+  #'(begin
+      (unless (hash-has-key? thunk-table 'LOOP-ID)
+        (raise-line-error "next without for"))
+      (define thunk (hash-ref thunk-table 'LOOP-ID))
+      (thunk)))

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

@@ -0,0 +1,16 @@
+#lang br
+(require "goto.rkt" "line.rkt")
+(provide b-gosub b-return)
+
+(define return-stack empty)
+
+(define (b-gosub num-expr)
+  (let/cc return-cc
+    (push! return-stack return-cc)
+    (b-goto num-expr)))
+
+(define (b-return)
+  (unless (pair? return-stack)
+    (raise-line-error "return without gosub"))
+  (define top-return-k (pop! return-stack))
+  (top-return-k))

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

@@ -0,0 +1,5 @@
+#lang br
+(require "structs.rkt")
+(provide b-goto)
+(define (b-goto num-expr)
+  (raise (change-line-signal num-expr)))

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

@@ -0,0 +1,27 @@
+#lang br
+(require "goto.rkt")
+(provide b-if b-comp-expr b-logic-expr)
+
+;; b-if : /"if" b-expr /"then" b-expr [/"else" b-expr]
+(define (b-if cond-expr then-expr [else-expr #f])
+  (cond
+    [(not (zero? cond-expr)) (b-goto then-expr)]
+    [else-expr => b-goto]))
+
+(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/input.rkt

@@ -0,0 +1,7 @@
+#lang br
+(provide b-input)
+
+(define-macro (b-input ID)
+  #'(set! ID (let* ([str (read-line)]
+                  [num (string->number (string-trim str))])
+             (or num str))))

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

@@ -0,0 +1,3 @@
+#lang br
+(provide b-let)
+(define-macro (b-let ID VAL) #'(set! ID VAL))

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

@@ -9,8 +9,9 @@
    ["\n" (token 'NEWLINE lexeme)]
    [whitespace (token lexeme #:skip? #t)]
    [(from/stop-before "rem" "\n") (token 'REM lexeme)]
-   [(:or "print" "goto" "end" "+" ":" "gosub" "return" "let" "=" "-" "for" "to" "step" "next") lexeme]
-   [(:seq (:+ alphabetic) (:* (:or alphabetic numeric))) (token 'ID (string->symbol lexeme))]
+   [(:or "print" "goto" "end" "+" ":" "gosub" "return" "let" "=" "-" "for" "to" "step" "next"
+         "if" "then" "else" "and" "or" "<" ">" "*" "/" "(" ")" "^" "!" "%" "input" ";" "def") lexeme]
+   [(:seq (:+ alphabetic) (:* (:or alphabetic numeric "$"))) (token 'ID (string->symbol lexeme))]
    [digits (token 'INTEGER (string->number lexeme))]
    [(:or (:seq (:? digits) "." digits)
          (:seq digits "."))

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

@@ -6,14 +6,12 @@
   (with-pattern ([LINE-NUM (prefix-id "line-" #'NUM
                                       #:source #'NUM)])
     (syntax/loc caller-stx
-      (define (LINE-NUM)
+      (define (LINE-NUM #:error [msg #f])
         (with-handlers ([line-error? (λ (le) (handle-line-error NUM le))])
-          (void) STATEMENT ...)))))
+          (when msg (raise-line-error msg))
+          STATEMENT ...)))))
 
 (define (handle-line-error num le)
   (error (format "error in line ~a: ~a" num (line-error-msg le))))
 
-(define (raise-line-error line-error-or-str)
-  (raise (if (string? line-error-or-str)
-             (line-error line-error-or-str)
-             line-error-or-str)))
+(define (raise-line-error str) (raise (line-error str)))

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

@@ -1,7 +0,0 @@
-#lang br
-(provide (matching-identifiers-out #rx"^b-" (all-defined-out)))
-
-(define (b-rem val) (void))
-(define (b-print [val ""]) (displayln val))
-(define-macro (b-let ID VAL)
-  #'(set! ID VAL))

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

@@ -1,22 +1,37 @@
 #lang brag
+;; program & lines
 b-program : [b-line] (/NEWLINE [b-line])*
 b-line : b-line-number [b-statement] (/":" [b-statement])*
 @b-line-number : INTEGER
-@b-statement : b-rem | b-end | b-print | b-let
-             | b-goto | b-gosub | b-return | b-for | b-next
+
+;; statements
+@b-statement : b-rem | b-end | b-print | b-let | b-input | b-def
+             | b-goto | b-gosub | b-return | b-for | b-next | b-if
 b-rem : REM
 b-end : /"end"
-b-print : /"print" [STRING | b-num-expr]
-b-goto : /"goto" b-num-expr
-b-gosub : /"gosub" b-num-expr
+b-print : /"print" [STRING | b-expr] (/";" [STRING | b-expr])*
+b-goto : /"goto" b-expr
+b-if : /"if" b-expr /"then" b-expr [/"else" b-expr]
+b-gosub : /"gosub" b-expr
 b-return : /"return"
-b-let : [/"let"] b-id /"=" b-num-expr
-b-for : /"for" b-id /"=" b-num-expr /"to" b-num-expr [/"step" b-num-expr]
+b-input : /"input" b-id
+b-def :  /"def" b-id /"(" b-id /")" /"=" b-expr
+b-let : [/"let"] b-id /"=" [STRING | b-expr]
+b-for : /"for" b-id /"=" b-expr /"to" b-expr [/"step" b-expr]
 b-next : /"next" [b-id]
+
+;; expressions with precedence & order
+b-expr : b-logic-expr 
+b-logic-expr : [b-logic-expr ("and" | "or")] b-comp-expr
+b-comp-expr : [b-comp-expr ("=" | "<" | ">")] b-sum
+b-sum : [b-sum ("+"|"-")] b-product
+b-product : [b-product ("*"|"/"|"%"|"^")] b-value
+
+;; values
+@b-value : b-id | b-number | /"(" b-expr /")" | b-not | b-func
+b-func : b-id /"(" b-expr /")"
+b-not : /"!" b-value
 @b-id : ID
-b-num-expr : b-sum
-b-sum : (b-value /"+" b-value)*
-@b-value : b-id | b-number
 @b-number : b-positive | b-negative
 @b-positive : INTEGER | DECIMAL
 b-negative : /"-" b-positive

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

@@ -0,0 +1,4 @@
+#lang br
+(provide b-print)
+(define (b-print . vals)
+  (displayln (string-append* (map ~a vals))))

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

@@ -0,0 +1,3 @@
+#lang br
+(provide b-rem)
+(define (b-rem val) (void))

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

@@ -18,7 +18,6 @@
               (or
                (and (exact-positive-integer? clsv)
                     (vector-member clsv line-vec))
-               (handle-line-error line-num
-                                  (line-error (format "line ~a not found" clsv)))))])
+               (line-func #:error (format "line ~a not found" clsv))))])
         (line-func)
         (add1 line-idx)))))

beautiful-racket-demo/basic-demo-2/sample-cond.rkt

@@ -0,0 +1,8 @@
+#lang basic-demo-2
+10 rem all results should be 1
+20 a = 5
+30 b = 10
+40 print a > 4
+50 print b = 10
+60 print b < 11
+70 print ! (b = 100)

beautiful-racket-demo/basic-demo-2/sample-def.rkt

@@ -0,0 +1,4 @@
+#lang basic-demo-2
+10 rem all results should be 1
+20 def f(x) = x * x
+30 print f((1+2)*3) = 81

beautiful-racket-demo/basic-demo-2/sample-input.rkt

@@ -0,0 +1,4 @@
+#lang basic-demo-2
+5 print "enter your name: "
+10 input A$
+20 print "hello, " ; A$ ; "!"

beautiful-racket-demo/basic-demo-2/sample-math.rkt

@@ -0,0 +1,9 @@
+#lang basic-demo-2
+10 rem all results should be 1
+20 print 1 - 2 * 3 + 4 * 5 - 6 = 9
+30 print (1 - 2) * (3 + 4) * (5 - 6) = 7
+40 print 1 / 4 = .25
+50 print 2 ^ 3 = 8
+60 print 9 ^ 0.5 = 3
+70 print 6 % 2 = 0
+80 print 5 % 2 = 1