From c58ac2a80625eb3b62102bdd7d8984a9bcc742cc Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 3 Feb 2017 11:15:57 -0800 Subject: [PATCH] set up basic-demo-2 --- .../basic-demo-2/expander-runtime-errors.rkt | 61 +++++++++++++ .../basic-demo-2/expander.rkt | 85 +++++++++++++++++++ beautiful-racket-demo/basic-demo-2/gosub.rkt | 3 + beautiful-racket-demo/basic-demo-2/info.rkt | 4 + .../basic-demo-2/lexer-test.rkt | 58 +++++++++++++ beautiful-racket-demo/basic-demo-2/lexer.rkt | 23 +++++ beautiful-racket-demo/basic-demo-2/main.rkt | 11 +++ .../basic-demo-2/parse-only.rkt | 14 +++ .../basic-demo-2/parse-stx.rkt | 15 ++++ beautiful-racket-demo/basic-demo-2/parser.rkt | 17 ++++ .../private/sample-pseudocode.rkt | 8 ++ .../basic-demo-2/sample-gosub.rkt | 10 +++ .../basic-demo-2/sample-var.rkt | 8 ++ .../basic-demo-2/test-parser.rkt | 11 +++ .../basic-demo-2/tokenize-only.rkt | 14 +++ .../basic-demo-2/tokenizer.rkt | 10 +++ 16 files changed, 352 insertions(+) create mode 100644 beautiful-racket-demo/basic-demo-2/expander-runtime-errors.rkt create mode 100644 beautiful-racket-demo/basic-demo-2/expander.rkt create mode 100644 beautiful-racket-demo/basic-demo-2/gosub.rkt create mode 100644 beautiful-racket-demo/basic-demo-2/info.rkt create mode 100644 beautiful-racket-demo/basic-demo-2/lexer-test.rkt create mode 100644 beautiful-racket-demo/basic-demo-2/lexer.rkt create mode 100644 beautiful-racket-demo/basic-demo-2/main.rkt create mode 100644 beautiful-racket-demo/basic-demo-2/parse-only.rkt create mode 100644 beautiful-racket-demo/basic-demo-2/parse-stx.rkt create mode 100644 beautiful-racket-demo/basic-demo-2/parser.rkt create mode 100644 beautiful-racket-demo/basic-demo-2/private/sample-pseudocode.rkt create mode 100644 beautiful-racket-demo/basic-demo-2/sample-gosub.rkt create mode 100644 beautiful-racket-demo/basic-demo-2/sample-var.rkt create mode 100644 beautiful-racket-demo/basic-demo-2/test-parser.rkt create mode 100644 beautiful-racket-demo/basic-demo-2/tokenize-only.rkt create mode 100644 beautiful-racket-demo/basic-demo-2/tokenizer.rkt diff --git a/beautiful-racket-demo/basic-demo-2/expander-runtime-errors.rkt b/beautiful-racket-demo/basic-demo-2/expander-runtime-errors.rkt new file mode 100644 index 0000000..de03e0b --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2/expander-runtime-errors.rkt @@ -0,0 +1,61 @@ +#lang br/quicklang +(provide (rename-out [b-module-begin #%module-begin]) + (matching-identifiers-out #rx"^b-" (all-defined-out))) + +(define-macro (b-module-begin (b-program LINE ...)) + (with-pattern + ([(LINE-NUM ...) + (filter-stx-prop 'b-line-number + (stx-flatten #'(LINE ...)))] + [(LINE-ID ...) (prefix-ids "line-" #'(LINE-NUM ...))]) + #'(#%module-begin + LINE ... + (define line-table + (apply hasheqv (append (list LINE-NUM LINE-ID) ...))) + (run line-table)))) + +(define-macro (b-line LINE-NUMBER STATEMENT ...) + (with-pattern + ([LINE-NUMBER-ID (prefix-id "line-" #'LINE-NUMBER + #:source #'LINE-NUMBER)] + [ORIG-LOC caller-stx]) + (syntax/loc caller-stx + (define (LINE-NUMBER-ID #:srcloc? [loc #f]) + (if loc + (syntax-srcloc #'ORIG-LOC) + (begin (void) STATEMENT ...)))))) + +(define b-rem void) +(define (b-print [val ""]) (displayln val)) +(define (b-sum . nums) (apply + nums)) +(define (b-num-expr expr) + (if (integer? expr) (inexact->exact expr) expr)) + +(struct $program-end-signal ()) +(define (b-end) (raise ($program-end-signal))) + +(struct $change-line-signal (val)) +(define (b-goto expr) (raise ($change-line-signal expr))) + +(define-exn line-not-found exn:fail) + +(define (run line-table) + (define line-vec + (list->vector (sort (hash-keys line-table) <))) + (with-handlers ([$program-end-signal? void]) + (for/fold ([line-idx 0]) + ([i (in-naturals)]) + (unless (< line-idx (vector-length line-vec)) (b-end)) + (define line-num (vector-ref line-vec line-idx)) + (define line-proc (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)) + (raise-line-not-found + (line-proc #:srcloc? #t))))]) + (line-proc) + (add1 line-idx))))) diff --git a/beautiful-racket-demo/basic-demo-2/expander.rkt b/beautiful-racket-demo/basic-demo-2/expander.rkt new file mode 100644 index 0000000..499c5fc --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2/expander.rkt @@ -0,0 +1,85 @@ +#lang br/quicklang +(require (for-syntax racket/list sugar/debug)) +(provide (matching-identifiers-out #rx"^b-" (all-defined-out))) + +(struct line-error (msg)) + +(define (handle-line-error num le) + (error (format "error in line ~a: ~a" num (line-error-msg le)))) + +(define return-ks empty) + +(define (b-gosub num-expr) + (let/cc return-k + (push! return-ks return-k) + (b-goto num-expr))) + +(define (b-return) + (unless (pair? return-ks) + (raise (line-error "return without gosub"))) + (define top-return-k (pop! return-ks)) + (top-return-k)) + +(define-macro (b-line NUM STATEMENT ...) + (with-pattern ([LINE-NUM (prefix-id "line-" #'NUM + #:source #'NUM)]) + (syntax/loc caller-stx + (define (LINE-NUM) + (with-handlers ([line-error? (λ (le) (handle-line-error NUM le))]) + (void) STATEMENT ...))))) + +(define-for-syntax (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)) + +(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 + (define VAR-NAME 0) ... + LINE ... + (define line-table + (apply hasheqv (append (list NUM LINE-FUNC) ...))) + (void (run line-table))))) +(provide (rename-out [b-module-begin #%module-begin])) + +(define-macro (b-let ID VAL) + #'(set! ID VAL)) + +(struct end-program-signal ()) +(struct change-line-signal (val)) + +(define (b-end) (raise (end-program-signal))) +(define (b-goto num-expr) (raise (change-line-signal num-expr))) + +(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))))) + +(define (b-rem val) (void)) +(define (b-print [val ""]) (displayln val)) +(define (b-sum . nums) (apply + nums)) +(define (b-num-expr expr) + (if (integer? expr) (inexact->exact expr) expr)) \ 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..795c0cd --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2/gosub.rkt @@ -0,0 +1,3 @@ +#lang br +(provide b-gosub b-return) + diff --git a/beautiful-racket-demo/basic-demo-2/info.rkt b/beautiful-racket-demo/basic-demo-2/info.rkt new file mode 100644 index 0000000..9641805 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2/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-2/lexer-test.rkt b/beautiful-racket-demo/basic-demo-2/lexer-test.rkt new file mode 100644 index 0000000..c0ea029 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2/lexer-test.rkt @@ -0,0 +1,58 @@ +#lang br +(require "lexer.rkt" brag/support rackunit) + +(define (lex str) + (apply-lexer basic-lexer str)) + +(check-equal? (lex "") empty) +(check-equal? + (lex " ") + (list (srcloc-token (token " " #:skip? #t) + (srcloc 'string #f #f 1 1)))) +(check-equal? + (lex "rem ignored\n") + (list (srcloc-token (token 'REM "rem ignored") + (srcloc 'string #f #f 1 11)) + (srcloc-token (token 'NEWLINE "\n") + (srcloc 'string #f #f 12 1)))) +(check-equal? + (lex "print") + (list (srcloc-token "print" + (srcloc 'string #f #f 1 5)))) +(check-equal? + (lex "goto") + (list (srcloc-token "goto" + (srcloc 'string #f #f 1 4)))) +(check-equal? + (lex "end") + (list (srcloc-token "end" + (srcloc 'string #f #f 1 3)))) +(check-equal? + (lex "+") + (list (srcloc-token "+" + (srcloc 'string #f #f 1 1)))) +(check-equal? + (lex "12") + (list (srcloc-token (token 'INTEGER 12) + (srcloc 'string #f #f 1 2)))) +(check-equal? + (lex "1.2") + (list (srcloc-token (token 'DECIMAL 1.2) + (srcloc 'string #f #f 1 3)))) +(check-equal? + (lex "12.") + (list (srcloc-token (token 'DECIMAL 12.) + (srcloc 'string #f #f 1 3)))) +(check-equal? + (lex ".12") + (list (srcloc-token (token 'DECIMAL .12) + (srcloc 'string #f #f 1 3)))) +(check-equal? + (lex "\"foo\"") + (list (srcloc-token (token 'STRING "foo") + (srcloc 'string #f #f 1 5)))) +(check-equal? + (lex "'foo'") + (list (srcloc-token (token 'STRING "foo") + (srcloc 'string #f #f 1 5)))) +(check-exn exn:fail:read? (lambda () (lex "x"))) \ 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 new file mode 100644 index 0000000..67cebaa --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2/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" "+" ":" "gosub" "return" "let" "=") 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) diff --git a/beautiful-racket-demo/basic-demo-2/main.rkt b/beautiful-racket-demo/basic-demo-2/main.rkt new file mode 100644 index 0000000..454a573 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2/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-2/expander + #,parse-tree))) + +(module+ reader + (provide read-syntax)) diff --git a/beautiful-racket-demo/basic-demo-2/parse-only.rkt b/beautiful-racket-demo/basic-demo-2/parse-only.rkt new file mode 100644 index 0000000..a2d7b7d --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2/parse-only.rkt @@ -0,0 +1,14 @@ +#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-parser-mod basic-demo/parse-only + #,parse-tree))) +(module+ reader (provide read-syntax)) + +(define-macro (parser-only-mb PARSE-TREE) + #'(#%module-begin + 'PARSE-TREE)) +(provide (rename-out [parser-only-mb #%module-begin])) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/parse-stx.rkt b/beautiful-racket-demo/basic-demo-2/parse-stx.rkt new file mode 100644 index 0000000..4523e03 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2/parse-stx.rkt @@ -0,0 +1,15 @@ +#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-parser-mod basic-demo/parse-stx + #'#,parse-tree))) +(module+ reader (provide read-syntax)) + +(define-macro (parser-only-mb PARSE-STX) + #'(#%module-begin + PARSE-STX)) +(provide (rename-out [parser-only-mb #%module-begin])) +(provide syntax) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/parser.rkt b/beautiful-racket-demo/basic-demo-2/parser.rkt new file mode 100644 index 0000000..a0c128b --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2/parser.rkt @@ -0,0 +1,17 @@ +#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-gosub | b-return | b-let +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-return : /"return" +b-let : [/"let"] b-id /"=" b-num-expr +@b-id : ID +b-num-expr : b-sum +b-sum : b-value (/"+" b-value)* +@b-value : b-id | b-number +@b-number : INTEGER | DECIMAL \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/private/sample-pseudocode.rkt b/beautiful-racket-demo/basic-demo-2/private/sample-pseudocode.rkt new file mode 100644 index 0000000..cb306a5 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2/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-2/sample-gosub.rkt b/beautiful-racket-demo/basic-demo-2/sample-gosub.rkt new file mode 100644 index 0000000..b1baafb --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2/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-2/sample-var.rkt b/beautiful-racket-demo/basic-demo-2/sample-var.rkt new file mode 100644 index 0000000..106abb4 --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2/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-2/test-parser.rkt b/beautiful-racket-demo/basic-demo-2/test-parser.rkt new file mode 100644 index 0000000..e6e19fe --- /dev/null +++ b/beautiful-racket-demo/basic-demo-2/test-parser.rkt @@ -0,0 +1,11 @@ +#lang br +(require "tokenizer.rkt" "parser.rkt" brag/support) + +(define str #<