diff --git a/beautiful-racket-demo/basic-demo-2/expander.rkt b/beautiful-racket-demo/basic-demo-2/expander.rkt index 8080938..6d42f5a 100644 --- a/beautiful-racket-demo/basic-demo-2/expander.rkt +++ b/beautiful-racket-demo/basic-demo-2/expander.rkt @@ -1,6 +1,5 @@ #lang br/quicklang -(require "runtime.rkt" - "run.rkt" +(require "struct.rkt" "elements.rkt") (provide (rename-out [b-module-begin #%module-begin]) (all-from-out "elements.rkt")) @@ -11,17 +10,11 @@ [(LINE-FUNC ...) (prefix-id "line-" #'(NUM ...))] [(VAR-NAME ...) (find-unique-var-names #'(LINE ...))]) #'(#%module-begin - (module configure-runtime br - (require basic-demo-2/runtime) - (current-basic-port (current-output-port))) (define VAR-NAME 0) ... - (provide VAR-NAME ...) LINE ... (define line-table (apply hasheqv (append (list NUM LINE-FUNC) ...))) - (void (parameterize ([current-output-port - (or (current-basic-port) (open-output-nowhere))]) - (run line-table)))))) + (void (run line-table))))) (begin-for-syntax (require racket/list) @@ -32,4 +25,24 @@ var-stx) #:key syntax->datum))) +(define (run line-table) + (define line-vec + (list->vector (sort (hash-keys line-table) <))) + (with-handlers ([end-program-signal? (λ (exn-val) (void))]) + (for/fold ([line-idx 0]) + ([i (in-naturals)] + #:break (>= line-idx (vector-length line-vec))) + (define line-num (vector-ref line-vec line-idx)) + (define line-func (hash-ref line-table line-num)) + (with-handlers + ([change-line-signal? + (λ (cls) + (define clsv (change-line-signal-val cls)) + (or + (and (exact-positive-integer? clsv) + (vector-member clsv line-vec)) + (line-func #:error (format "line ~a not found" clsv))))]) + (line-func) + (add1 line-idx))))) + diff --git a/beautiful-racket-demo/basic-demo-2/go.rkt b/beautiful-racket-demo/basic-demo-2/go.rkt index 1322c25..e415c77 100644 --- a/beautiful-racket-demo/basic-demo-2/go.rkt +++ b/beautiful-racket-demo/basic-demo-2/go.rkt @@ -1,5 +1,5 @@ #lang br -(require "structs.rkt" "line.rkt") +(require "struct.rkt" "line.rkt") (provide b-goto b-gosub b-return) (define (b-goto num-expr) diff --git a/beautiful-racket-demo/basic-demo-2/line.rkt b/beautiful-racket-demo/basic-demo-2/line.rkt index fb96fda..bd58073 100644 --- a/beautiful-racket-demo/basic-demo-2/line.rkt +++ b/beautiful-racket-demo/basic-demo-2/line.rkt @@ -1,5 +1,5 @@ #lang br -(require "structs.rkt") +(require "struct.rkt") (provide (all-defined-out)) (define-macro (b-line NUM STATEMENT ...) diff --git a/beautiful-racket-demo/basic-demo-2/misc.rkt b/beautiful-racket-demo/basic-demo-2/misc.rkt index 4e2f7b9..1f0e8ad 100644 --- a/beautiful-racket-demo/basic-demo-2/misc.rkt +++ b/beautiful-racket-demo/basic-demo-2/misc.rkt @@ -1,5 +1,5 @@ #lang br -(require "structs.rkt") +(require "struct.rkt") (provide (all-defined-out)) (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 2a3240f..b264363 100644 --- a/beautiful-racket-demo/basic-demo-2/run.rkt +++ b/beautiful-racket-demo/basic-demo-2/run.rkt @@ -1,5 +1,5 @@ #lang br -(require "line.rkt" "structs.rkt") +(require "line.rkt" "struct.rkt") (provide run) (define (run line-table) diff --git a/beautiful-racket-demo/basic-demo-2/struct.rkt b/beautiful-racket-demo/basic-demo-2/struct.rkt new file mode 100644 index 0000000..ee0de12 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2/struct.rkt @@ -0,0 +1,9 @@ +#lang br +(provide (struct-out end-program-signal) + (struct-out change-line-signal) + (struct-out line-error)) + +(struct end-program-signal ()) +(struct change-line-signal (val)) + +(struct line-error (msg)) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2a/elements.rkt b/beautiful-racket-demo/basic-demo-2a/elements.rkt new file mode 100644 index 0000000..25942be --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2a/elements.rkt @@ -0,0 +1,6 @@ +#lang br +(require "line.rkt" "go.rkt" + "expr.rkt" "misc.rkt") +(provide + (all-from-out "line.rkt" "go.rkt" + "expr.rkt" "misc.rkt")) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2a/expander.rkt b/beautiful-racket-demo/basic-demo-2a/expander.rkt new file mode 100644 index 0000000..2fa2193 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2a/expander.rkt @@ -0,0 +1,37 @@ +#lang br/quicklang +(require "struct.rkt" "elements.rkt") +(provide (rename-out [b-module-begin #%module-begin]) + (all-from-out "elements.rkt")) + +(define-macro (b-module-begin (b-program LINE ...)) + (with-pattern + ([((b-line NUM STMT ...) ...) #'(LINE ...)] + [(LINE-FUNC ...) (prefix-id "line-" #'(NUM ...))]) + #'(#%module-begin + LINE ... + (define line-table + (apply hasheqv (append (list NUM LINE-FUNC) ...))) + (void (run line-table))))) + +(define (run line-table) + (define line-vec + (list->vector (sort (hash-keys line-table) <))) + (with-handlers ([end-program-signal? (λ (exn-val) (void))]) + (for/fold ([line-idx 0]) + ([i (in-naturals)] + #:break (>= line-idx (vector-length line-vec))) + (define line-num (vector-ref line-vec line-idx)) + (define line-func (hash-ref line-table line-num)) + (with-handlers + ([change-line-signal? + (λ (cls) + (define clsv (change-line-signal-val cls)) + (or + (and (exact-positive-integer? clsv) + (vector-member clsv line-vec)) + (error (format "error in line ~a: line ~a not found" + line-num clsv))))]) + (line-func) + (add1 line-idx))))) + + diff --git a/beautiful-racket-demo/basic-demo-2a/expr.rkt b/beautiful-racket-demo/basic-demo-2a/expr.rkt new file mode 100644 index 0000000..8f274d6 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2a/expr.rkt @@ -0,0 +1,7 @@ +#lang br +(provide b-sum b-expr) + +(define (b-sum . vals) (apply + vals)) + +(define (b-expr expr) + (if (integer? expr) (inexact->exact expr) expr)) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2a/go.rkt b/beautiful-racket-demo/basic-demo-2a/go.rkt new file mode 100644 index 0000000..7d03118 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2a/go.rkt @@ -0,0 +1,8 @@ +#lang br +(require "struct.rkt" "line.rkt") +(provide b-end b-goto) + +(define (b-end) (raise (end-program-signal))) + +(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-2a/info.rkt b/beautiful-racket-demo/basic-demo-2a/info.rkt new file mode 100644 index 0000000..9641805 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2a/info.rkt @@ -0,0 +1,4 @@ +#lang info + +(define compile-omit-paths 'all) +(define test-omit-paths 'all) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2a/lexer.rkt b/beautiful-racket-demo/basic-demo-2a/lexer.rkt new file mode 100644 index 0000000..9f95c19 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2a/lexer.rkt @@ -0,0 +1,23 @@ +#lang br +(require brag/support) + +(define-lex-abbrev digits (:+ (char-set "0123456789"))) + +(define basic-lexer + (lexer-srcloc + [(eof) (return-without-srcloc eof)] + ["\n" (token 'NEWLINE lexeme)] + [whitespace (token lexeme #:skip? #t)] + [(from/stop-before "rem" "\n") (token 'REM lexeme)] + [(:or "print" "goto" "end" + "+" ":" ";") (token lexeme lexeme)] + [digits (token 'INTEGER (string->number lexeme))] + [(:or (:seq (:? digits) "." digits) + (:seq digits ".")) + (token 'DECIMAL (string->number lexeme))] + [(:or (from/to "\"" "\"") (from/to "'" "'")) + (token 'STRING + (substring lexeme + 1 (sub1 (string-length lexeme))))])) + +(provide basic-lexer) diff --git a/beautiful-racket-demo/basic-demo-2a/line.rkt b/beautiful-racket-demo/basic-demo-2a/line.rkt new file mode 100644 index 0000000..5e2cdb9 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2a/line.rkt @@ -0,0 +1,9 @@ +#lang br +(require "struct.rkt") +(provide b-line) + +(define-macro (b-line NUM STATEMENT ...) + (with-pattern ([LINE-NUM (prefix-id "line-" #'NUM + #:source #'NUM)]) + (syntax/loc caller-stx + (define (LINE-NUM) (void) STATEMENT ...)))) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2a/main.rkt b/beautiful-racket-demo/basic-demo-2a/main.rkt new file mode 100644 index 0000000..539100d --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2a/main.rkt @@ -0,0 +1,11 @@ +#lang br/quicklang +(require "parser.rkt" "tokenizer.rkt") + +(define (read-syntax path port) + (define parse-tree (parse path (make-tokenizer port path))) + (strip-bindings + #`(module basic-mod basic-demo-2a/expander + #,parse-tree))) + +(module+ reader + (provide read-syntax)) diff --git a/beautiful-racket-demo/basic-demo-2a/misc.rkt b/beautiful-racket-demo/basic-demo-2a/misc.rkt new file mode 100644 index 0000000..40c969e --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2a/misc.rkt @@ -0,0 +1,8 @@ +#lang br +(require "struct.rkt") +(provide b-rem b-print) + +(define (b-rem val) (void)) + +(define (b-print . vals) + (displayln (string-append* (map ~a vals)))) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2a/parser.rkt b/beautiful-racket-demo/basic-demo-2a/parser.rkt new file mode 100644 index 0000000..ff898cf --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2a/parser.rkt @@ -0,0 +1,13 @@ +#lang brag +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-goto +b-rem : REM +b-end : /"end" +b-print : /"print" [b-printable] (/";" [b-printable])* +@b-printable : STRING | b-expr +b-goto : /"goto" b-expr +b-expr : b-sum +b-sum : b-number (/"+" b-number)* +@b-number : INTEGER | DECIMAL \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2a/sample.rkt b/beautiful-racket-demo/basic-demo-2a/sample.rkt new file mode 100644 index 0000000..cec4f7f --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2a/sample.rkt @@ -0,0 +1,9 @@ +#lang basic-demo-2a +30 rem print 'ignored' +35 +50 print "never gets here" +40 end +60 print 'three' : print 1.0 + 3 +70 goto 11. + 18.5 + .5 +10 print "o" ; "n" ; "e" +20 print : goto 60.0 : end \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2a/struct.rkt b/beautiful-racket-demo/basic-demo-2a/struct.rkt new file mode 100644 index 0000000..d680b77 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2a/struct.rkt @@ -0,0 +1,6 @@ +#lang br +(provide (struct-out end-program-signal) + (struct-out change-line-signal)) + +(struct end-program-signal ()) +(struct change-line-signal (val)) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2a/tokenizer.rkt b/beautiful-racket-demo/basic-demo-2a/tokenizer.rkt new file mode 100644 index 0000000..5c15433 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2a/tokenizer.rkt @@ -0,0 +1,10 @@ +#lang br +(require "lexer.rkt" brag/support) + +(define (make-tokenizer ip [path #f]) + (port-count-lines! ip) + (lexer-file-path path) + (define (next-token) (basic-lexer ip)) + next-token) + +(provide make-tokenizer) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-3/colorer.rkt b/beautiful-racket-demo/basic-demo-3/colorer.rkt new file mode 100644 index 0000000..a317a63 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/colorer.rkt @@ -0,0 +1,22 @@ +#lang br +(require "lexer.rkt" brag/support) +(provide color-basic) + +(define (color-basic port) + (define srcloc-tok (basic-lexer port)) + (match srcloc-tok + [(? eof-object?) (values srcloc-tok 'eof #f #f #f)] + [else ; reverse-engineer with `match-define` + (match-define (srcloc-token (token-struct type val _ _ _ _ _) + (srcloc _ _ _ pos span)) srcloc-tok) + (define (color cat [paren #f]) + (values (or val "") cat paren pos (+ pos span))) + (match type + ['STRING (color 'string)] + ['REM (color 'comment)] + [else (match val + [(? number?) (color 'constant)] + [(? symbol?) (color 'symbol)] + ["(" (color 'parenthesis '|(|)] + [")" (color 'parenthesis '|)|)] + [else (color 'no-color)])])])) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-3/elements.rkt b/beautiful-racket-demo/basic-demo-3/elements.rkt new file mode 100644 index 0000000..62090ca --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/elements.rkt @@ -0,0 +1,3 @@ +#lang br +(require "line.rkt" "go.rkt" "if.rkt" "expr.rkt" "for.rkt" "misc.rkt") +(provide (all-from-out "line.rkt" "go.rkt" "if.rkt" "expr.rkt" "for.rkt" "misc.rkt")) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-3/expander.rkt b/beautiful-racket-demo/basic-demo-3/expander.rkt new file mode 100644 index 0000000..8080938 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/expander.rkt @@ -0,0 +1,35 @@ +#lang br/quicklang +(require "runtime.rkt" + "run.rkt" + "elements.rkt") +(provide (rename-out [b-module-begin #%module-begin]) + (all-from-out "elements.rkt")) + +(define-macro (b-module-begin (b-program LINE ...)) + (with-pattern + ([((b-line NUM STMT ...) ...) #'(LINE ...)] + [(LINE-FUNC ...) (prefix-id "line-" #'(NUM ...))] + [(VAR-NAME ...) (find-unique-var-names #'(LINE ...))]) + #'(#%module-begin + (module configure-runtime br + (require basic-demo-2/runtime) + (current-basic-port (current-output-port))) + (define VAR-NAME 0) ... + (provide VAR-NAME ...) + LINE ... + (define line-table + (apply hasheqv (append (list NUM LINE-FUNC) ...))) + (void (parameterize ([current-output-port + (or (current-basic-port) (open-output-nowhere))]) + (run line-table)))))) + +(begin-for-syntax + (require racket/list) + (define (find-unique-var-names stx) + (remove-duplicates + (for/list ([var-stx (in-list (syntax-flatten stx))] + #:when (syntax-property var-stx 'b-id)) + var-stx) + #:key syntax->datum))) + + diff --git a/beautiful-racket-demo/basic-demo-3/expr.rkt b/beautiful-racket-demo/basic-demo-3/expr.rkt new file mode 100644 index 0000000..8b3dfd7 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/expr.rkt @@ -0,0 +1,26 @@ +#lang br +(provide (all-defined-out)) + +;; 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)]) + +;; 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))) diff --git a/beautiful-racket-demo/basic-demo-3/for.rkt b/beautiful-racket-demo/basic-demo-3/for.rkt new file mode 100644 index 0000000..4bba4d2 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/for.rkt @@ -0,0 +1,30 @@ +#lang br +(require "misc.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-3/go.rkt b/beautiful-racket-demo/basic-demo-3/go.rkt new file mode 100644 index 0000000..1322c25 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/go.rkt @@ -0,0 +1,19 @@ +#lang br +(require "structs.rkt" "line.rkt") +(provide b-goto b-gosub b-return) + +(define (b-goto num-expr) + (raise (change-line-signal num-expr))) + +(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-3/if.rkt b/beautiful-racket-demo/basic-demo-3/if.rkt new file mode 100644 index 0000000..147d5db --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/if.rkt @@ -0,0 +1,27 @@ +#lang br +(require "go.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-3/info.rkt b/beautiful-racket-demo/basic-demo-3/info.rkt new file mode 100644 index 0000000..9641805 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/info.rkt @@ -0,0 +1,4 @@ +#lang info + +(define compile-omit-paths 'all) +(define test-omit-paths 'all) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-3/lexer.rkt b/beautiful-racket-demo/basic-demo-3/lexer.rkt new file mode 100644 index 0000000..04eb928 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/lexer.rkt @@ -0,0 +1,24 @@ +#lang br +(require brag/support) + +(define-lex-abbrev digits (:+ (char-set "0123456789"))) + +(define basic-lexer + (lexer-srcloc + [(eof) (return-without-srcloc eof)] + ["\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" + "if" "then" "else" "and" "or" "<" ">" "*" "/" "(" ")" "^" "!" "%" "input" ";" "def") (token lexeme lexeme)] + [(:seq (:+ alphabetic) (:* (:or alphabetic numeric "$"))) (token 'ID (string->symbol lexeme))] + [digits (token 'INTEGER (string->number lexeme))] + [(:or (:seq (:? digits) "." digits) + (:seq digits ".")) + (token 'DECIMAL (string->number lexeme))] + [(:or (from/to "\"" "\"") (from/to "'" "'")) + (token 'STRING + (substring lexeme + 1 (sub1 (string-length lexeme))))])) + +(provide basic-lexer) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-3/line.rkt b/beautiful-racket-demo/basic-demo-3/line.rkt new file mode 100644 index 0000000..fb96fda --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/line.rkt @@ -0,0 +1,17 @@ +#lang br +(require "structs.rkt") +(provide (all-defined-out)) + +(define-macro (b-line NUM STATEMENT ...) + (with-pattern ([LINE-NUM (prefix-id "line-" #'NUM + #:source #'NUM)]) + (syntax/loc caller-stx + (define (LINE-NUM #:error [msg #f]) + (with-handlers ([line-error? (λ (le) (handle-line-error NUM le))]) + (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 str) (raise (line-error str))) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-3/main.rkt b/beautiful-racket-demo/basic-demo-3/main.rkt new file mode 100644 index 0000000..d48546f --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/main.rkt @@ -0,0 +1,19 @@ +#lang br/quicklang +(require "parser.rkt" "tokenizer.rkt") + +(module+ reader + (provide read-syntax get-info)) + +(define (read-syntax path port) + (define parse-tree (parse path (make-tokenizer port path))) + (strip-bindings + #`(module basic-mod basic-demo-2/expander + #,parse-tree))) + +(define (get-info port mod line col pos) + (define (handle-query key default) + (case key + [(color-lexer) + (dynamic-require 'basic-demo-2/colorer 'color-basic)] + [else default])) + handle-query) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-3/misc.rkt b/beautiful-racket-demo/basic-demo-3/misc.rkt new file mode 100644 index 0000000..4e2f7b9 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/misc.rkt @@ -0,0 +1,17 @@ +#lang br +(require "structs.rkt") +(provide (all-defined-out)) + +(define (b-rem val) (void)) + +(define (b-print . vals) + (displayln (string-append* (map ~a vals)))) + +(define-macro (b-let ID VAL) #'(set! ID VAL)) + +(define-macro (b-input ID) + #'(b-let ID (let* ([str (read-line)] + [num (string->number (string-trim str))]) + (or num str)))) + +(define (b-end) (raise (end-program-signal))) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-3/parser.rkt b/beautiful-racket-demo/basic-demo-3/parser.rkt new file mode 100644 index 0000000..c5a7c77 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/parser.rkt @@ -0,0 +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 + +;; 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-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-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-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-3/private/sample-pseudocode.rkt b/beautiful-racket-demo/basic-demo-3/private/sample-pseudocode.rkt new file mode 100644 index 0000000..cb306a5 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/private/sample-pseudocode.rkt @@ -0,0 +1,8 @@ +(define (30) (rem print "'ignored'")) +(define (35) (void)) +(define (50) (print "never gets here")) +(define (40) (end)) +(define (60) (print "three") (print (+ 1.0 3))) +(define (70) (goto (+ 11 18.5 0.5))) +(define (10) (print "one")) +(define (20) (print) (goto 60) (end)) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-3/run.rkt b/beautiful-racket-demo/basic-demo-3/run.rkt new file mode 100644 index 0000000..2a3240f --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/run.rkt @@ -0,0 +1,23 @@ +#lang br +(require "line.rkt" "structs.rkt") +(provide run) + +(define (run line-table) + (define line-vec + (list->vector (sort (hash-keys line-table) <))) + (with-handlers ([end-program-signal? (λ (exn-val) (void))]) + (for/fold ([line-idx 0]) + ([i (in-naturals)] + #:break (>= line-idx (vector-length line-vec))) + (define line-num (vector-ref line-vec line-idx)) + (define line-func (hash-ref line-table line-num)) + (with-handlers + ([change-line-signal? + (λ (cls) + (define clsv (change-line-signal-val cls)) + (or + (and (exact-positive-integer? clsv) + (vector-member clsv line-vec)) + (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/runtime.rkt b/beautiful-racket-demo/basic-demo-3/runtime.rkt similarity index 100% rename from beautiful-racket-demo/basic-demo-2/runtime.rkt rename to beautiful-racket-demo/basic-demo-3/runtime.rkt diff --git a/beautiful-racket-demo/basic-demo-3/sample-cond.rkt b/beautiful-racket-demo/basic-demo-3/sample-cond.rkt new file mode 100644 index 0000000..95b5760 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/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-3/sample-def.rkt b/beautiful-racket-demo/basic-demo-3/sample-def.rkt new file mode 100644 index 0000000..f2d92c1 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/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-3/sample-for.rkt b/beautiful-racket-demo/basic-demo-3/sample-for.rkt new file mode 100644 index 0000000..3346736 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/sample-for.rkt @@ -0,0 +1,8 @@ +#lang basic-demo-2 +10 for a = 1 to 3 +20 print a +21 for b = 103 to 101 step -1 +22 print b +23 next b +30 next a +40 print "yay" \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-3/sample-gosub.rkt b/beautiful-racket-demo/basic-demo-3/sample-gosub.rkt new file mode 100644 index 0000000..b1baafb --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/sample-gosub.rkt @@ -0,0 +1,10 @@ +#lang basic-demo-2 +10 gosub 41 +20 print "world" +30 gosub 100 +31 print "hi" +35 end +40 return +41 print "hello" : return +100 print "third" +110 goto 40 \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-3/sample-import.rkt b/beautiful-racket-demo/basic-demo-3/sample-import.rkt new file mode 100644 index 0000000..7004f51 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/sample-import.rkt @@ -0,0 +1,3 @@ +#lang br +(require basic-demo-2/sample-var) +(* a a) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-3/sample-input.rkt b/beautiful-racket-demo/basic-demo-3/sample-input.rkt new file mode 100644 index 0000000..8eb14cb --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/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-3/sample-math.rkt b/beautiful-racket-demo/basic-demo-3/sample-math.rkt new file mode 100644 index 0000000..4c3923f --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/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 diff --git a/beautiful-racket-demo/basic-demo-3/sample-var.rkt b/beautiful-racket-demo/basic-demo-3/sample-var.rkt new file mode 100644 index 0000000..106abb4 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/sample-var.rkt @@ -0,0 +1,8 @@ +#lang basic-demo-2 +10 a = 1 : a = 5 +20 gosub 150 +30 a = 25 +40 gosub 150 +50 end +150 print a + a + a +160 return \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-3/sample.rkt b/beautiful-racket-demo/basic-demo-3/sample.rkt new file mode 100644 index 0000000..a3089f6 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/sample.rkt @@ -0,0 +1,9 @@ +#lang basic-demo +30 rem print 'ignored' +35 +50 print "never gets here" +40 end +60 print 'three' : print 1.0 + 3 +70 goto 11. + 18.5 + .5 +10 print "one" +20 print : goto 60.0 : end \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/structs.rkt b/beautiful-racket-demo/basic-demo-3/structs.rkt similarity index 100% rename from beautiful-racket-demo/basic-demo-2/structs.rkt rename to beautiful-racket-demo/basic-demo-3/structs.rkt diff --git a/beautiful-racket-demo/basic-demo-3/tokenizer.rkt b/beautiful-racket-demo/basic-demo-3/tokenizer.rkt new file mode 100644 index 0000000..5c15433 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-3/tokenizer.rkt @@ -0,0 +1,10 @@ +#lang br +(require "lexer.rkt" brag/support) + +(define (make-tokenizer ip [path #f]) + (port-count-lines! ip) + (lexer-file-path path) + (define (next-token) (basic-lexer ip)) + next-token) + +(provide make-tokenizer) \ No newline at end of file