diff --git a/beautiful-racket-demo/basic-demo-2/elements.rkt b/beautiful-racket-demo/basic-demo-2/elements.rkt new file mode 100644 index 0000000..18376e9 --- /dev/null +++ b/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")) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/end.rkt b/beautiful-racket-demo/basic-demo-2/end.rkt new file mode 100644 index 0000000..1466696 --- /dev/null +++ b/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))) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/expander.rkt b/beautiful-racket-demo/basic-demo-2/expander.rkt index e287769..8080938 100644 --- a/beautiful-racket-demo/basic-demo-2/expander.rkt +++ b/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 diff --git a/beautiful-racket-demo/basic-demo-2/expr.rkt b/beautiful-racket-demo/basic-demo-2/expr.rkt index 6a9825e..9c48201 100644 --- a/beautiful-racket-demo/basic-demo-2/expr.rkt +++ b/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)) \ No newline at end of file +(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)) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/flow.rkt b/beautiful-racket-demo/basic-demo-2/flow.rkt deleted file mode 100644 index 3e323a3..0000000 --- a/beautiful-racket-demo/basic-demo-2/flow.rkt +++ /dev/null @@ -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)) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/for.rkt b/beautiful-racket-demo/basic-demo-2/for.rkt new file mode 100644 index 0000000..c7c85c5 --- /dev/null +++ b/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))) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/gosub.rkt b/beautiful-racket-demo/basic-demo-2/gosub.rkt new file mode 100644 index 0000000..5e408b1 --- /dev/null +++ b/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)) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/goto.rkt b/beautiful-racket-demo/basic-demo-2/goto.rkt new file mode 100644 index 0000000..c355ae6 --- /dev/null +++ b/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))) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/if.rkt b/beautiful-racket-demo/basic-demo-2/if.rkt new file mode 100644 index 0000000..eda3ade --- /dev/null +++ b/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)]) diff --git a/beautiful-racket-demo/basic-demo-2/input.rkt b/beautiful-racket-demo/basic-demo-2/input.rkt new file mode 100644 index 0000000..d5a3f94 --- /dev/null +++ b/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)))) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/let.rkt b/beautiful-racket-demo/basic-demo-2/let.rkt new file mode 100644 index 0000000..45c81cc --- /dev/null +++ b/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)) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/lexer.rkt b/beautiful-racket-demo/basic-demo-2/lexer.rkt index bc13240..141e8eb 100644 --- a/beautiful-racket-demo/basic-demo-2/lexer.rkt +++ b/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 ".")) diff --git a/beautiful-racket-demo/basic-demo-2/line.rkt b/beautiful-racket-demo/basic-demo-2/line.rkt index 322b726..fb96fda 100644 --- a/beautiful-racket-demo/basic-demo-2/line.rkt +++ b/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))) \ No newline at end of file +(define (raise-line-error str) (raise (line-error str))) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/misc.rkt b/beautiful-racket-demo/basic-demo-2/misc.rkt deleted file mode 100644 index fea74d9..0000000 --- a/beautiful-racket-demo/basic-demo-2/misc.rkt +++ /dev/null @@ -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)) diff --git a/beautiful-racket-demo/basic-demo-2/parser.rkt b/beautiful-racket-demo/basic-demo-2/parser.rkt index 03c5dd8..4dd4edb 100644 --- a/beautiful-racket-demo/basic-demo-2/parser.rkt +++ b/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 \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/print.rkt b/beautiful-racket-demo/basic-demo-2/print.rkt new file mode 100644 index 0000000..6346d92 --- /dev/null +++ b/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)))) diff --git a/beautiful-racket-demo/basic-demo-2/rem.rkt b/beautiful-racket-demo/basic-demo-2/rem.rkt new file mode 100644 index 0000000..8c137d6 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2/rem.rkt @@ -0,0 +1,3 @@ +#lang br +(provide b-rem) +(define (b-rem val) (void)) diff --git a/beautiful-racket-demo/basic-demo-2/run.rkt b/beautiful-racket-demo/basic-demo-2/run.rkt index fb942b9..2a3240f 100644 --- a/beautiful-racket-demo/basic-demo-2/run.rkt +++ b/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))))) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/sample-cond.rkt b/beautiful-racket-demo/basic-demo-2/sample-cond.rkt new file mode 100644 index 0000000..95b5760 --- /dev/null +++ b/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) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/sample-def.rkt b/beautiful-racket-demo/basic-demo-2/sample-def.rkt new file mode 100644 index 0000000..f2d92c1 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/sample-input.rkt b/beautiful-racket-demo/basic-demo-2/sample-input.rkt new file mode 100644 index 0000000..8eb14cb --- /dev/null +++ b/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$ ; "!" \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/sample-math.rkt b/beautiful-racket-demo/basic-demo-2/sample-math.rkt new file mode 100644 index 0000000..4c3923f --- /dev/null +++ b/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