From f49f42003adbd4527de4bec85d81372c96a6fabb Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 8 Feb 2017 15:54:54 -0800 Subject: [PATCH] reorg --- .../basic-demo-2/colorer.rkt | 42 +++++++++++-------- .../basic-demo-2/elements.rkt | 4 +- beautiful-racket-demo/basic-demo-2/for.rkt | 30 ------------- beautiful-racket-demo/basic-demo-2/go.rkt | 31 ++++++++++++-- beautiful-racket-demo/basic-demo-2/lexer.rkt | 3 ++ beautiful-racket-demo/basic-demo-2/main.rkt | 2 +- .../basic-demo-2/sample-for.rkt | 8 ++-- 7 files changed, 62 insertions(+), 58 deletions(-) delete mode 100644 beautiful-racket-demo/basic-demo-2/for.rkt diff --git a/beautiful-racket-demo/basic-demo-2/colorer.rkt b/beautiful-racket-demo/basic-demo-2/colorer.rkt index a317a63..d92c5cb 100644 --- a/beautiful-racket-demo/basic-demo-2/colorer.rkt +++ b/beautiful-racket-demo/basic-demo-2/colorer.rkt @@ -1,22 +1,30 @@ #lang br (require "lexer.rkt" brag/support) -(provide color-basic) +(provide basic-colorer) -(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` +(define (basic-colorer port) + (define next-char (peek-char port)) + (define (handle-read-error exn) + (define exn-srclocs (exn:fail:read-srclocs exn)) + (srcloc-token (token 'ERROR (string next-char)) (car exn-srclocs))) + (define srcloc-tok (with-handlers ([exn:fail:read? handle-read-error]) + (basic-lexer port))) + (cond + [(eof-object? srcloc-tok) (values srcloc-tok 'eof #f #f #f)] + [else (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 + (match-define (list cat paren) + (match type + ['STRING '(string #f)] + ['REM '(comment #f)] + ['ERROR '(error #f)] + [else (match val + [(? number?)'(constant #f)] + [(? symbol?) '(symbol #f)] + ["(" '(parenthesis |(|)] + [")" '(parenthesis |)|)] + [else '(no-color #f)])])) + (values (or val "") cat paren pos (+ pos span))])) + +(apply-colorer basic-colorer "foo") \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/elements.rkt b/beautiful-racket-demo/basic-demo-2/elements.rkt index 62090ca..4e1136b 100644 --- a/beautiful-racket-demo/basic-demo-2/elements.rkt +++ b/beautiful-racket-demo/basic-demo-2/elements.rkt @@ -1,3 +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 +(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")) \ 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 deleted file mode 100644 index 4bba4d2..0000000 --- a/beautiful-racket-demo/basic-demo-2/for.rkt +++ /dev/null @@ -1,30 +0,0 @@ -#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-2/go.rkt b/beautiful-racket-demo/basic-demo-2/go.rkt index e415c77..24f4b70 100644 --- a/beautiful-racket-demo/basic-demo-2/go.rkt +++ b/beautiful-racket-demo/basic-demo-2/go.rkt @@ -1,6 +1,6 @@ #lang br -(require "struct.rkt" "line.rkt") -(provide b-goto b-gosub b-return) +(require "struct.rkt" "line.rkt" "misc.rkt") +(provide b-goto b-gosub b-return b-for b-next) (define (b-goto num-expr) (raise (change-line-signal num-expr))) @@ -16,4 +16,29 @@ (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 + (top-return-k)) + +(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)) + +(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/lexer.rkt b/beautiful-racket-demo/basic-demo-2/lexer.rkt index 04eb928..932ed84 100644 --- a/beautiful-racket-demo/basic-demo-2/lexer.rkt +++ b/beautiful-racket-demo/basic-demo-2/lexer.rkt @@ -3,6 +3,9 @@ (define-lex-abbrev digits (:+ (char-set "0123456789"))) +(define (handle-tok-error tok-ok? tok-name tok-value start-pos end-pos) + (token 'ERROR tok-value)) + (define basic-lexer (lexer-srcloc [(eof) (return-without-srcloc eof)] diff --git a/beautiful-racket-demo/basic-demo-2/main.rkt b/beautiful-racket-demo/basic-demo-2/main.rkt index d48546f..53b43e8 100644 --- a/beautiful-racket-demo/basic-demo-2/main.rkt +++ b/beautiful-racket-demo/basic-demo-2/main.rkt @@ -14,6 +14,6 @@ (define (handle-query key default) (case key [(color-lexer) - (dynamic-require 'basic-demo-2/colorer 'color-basic)] + (dynamic-require 'basic-demo-2/colorer 'basic-colorer)] [else default])) handle-query) \ No newline at end of file diff --git a/beautiful-racket-demo/basic-demo-2/sample-for.rkt b/beautiful-racket-demo/basic-demo-2/sample-for.rkt index 3346736..3688f93 100644 --- a/beautiful-racket-demo/basic-demo-2/sample-for.rkt +++ b/beautiful-racket-demo/basic-demo-2/sample-for.rkt @@ -1,8 +1,6 @@ #lang basic-demo-2 10 for a = 1 to 3 -20 print a -21 for b = 103 to 101 step -1 -22 print b +21 for b = 9 to 7 step -1 +22 print a ; b 23 next b -30 next a -40 print "yay" \ No newline at end of file +30 next a \ No newline at end of file