From 18081e6d6ebb2bbd88e36ace7a20d7974ef4ef0b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 19 Feb 2017 18:54:46 -0800 Subject: [PATCH] tidying --- .../bf-demo/test-tokenizer.rkt | 3 +- beautiful-racket-lib/br/case.rkt | 24 ------------ beautiful-racket-lib/br/cond.rkt | 10 +---- beautiful-racket-lib/br/datum.rkt | 33 ++++++++-------- beautiful-racket-lib/br/debug.rkt | 7 +--- beautiful-racket-lib/br/define.rkt | 38 ++++++------------- beautiful-racket-lib/br/drracket.rkt | 11 ------ beautiful-racket-lib/br/get-info.rkt | 16 ++++---- beautiful-racket-lib/br/list.rkt | 14 ++++++- beautiful-racket-lib/br/main.rkt | 4 +- 10 files changed, 56 insertions(+), 104 deletions(-) delete mode 100644 beautiful-racket-lib/br/case.rkt delete mode 100644 beautiful-racket-lib/br/drracket.rkt diff --git a/beautiful-racket-demo/bf-demo/test-tokenizer.rkt b/beautiful-racket-demo/bf-demo/test-tokenizer.rkt index ad0a2f4..109c630 100644 --- a/beautiful-racket-demo/bf-demo/test-tokenizer.rkt +++ b/beautiful-racket-demo/bf-demo/test-tokenizer.rkt @@ -1,7 +1,8 @@ #lang br (require brag/support) +(provide tokenize) -(define+provide (tokenize ip) +(define (tokenize ip) (define get-token (lexer [(char-set "><-.,+[]") lexeme] diff --git a/beautiful-racket-lib/br/case.rkt b/beautiful-racket-lib/br/case.rkt deleted file mode 100644 index 0636eeb..0000000 --- a/beautiful-racket-lib/br/case.rkt +++ /dev/null @@ -1,24 +0,0 @@ -#lang racket/base -(require (for-syntax racket/base) br/define) -(provide (all-defined-out)) - -(define-macro (define-case-macro ID PRED) - #'(define-syntax (ID stx) - (syntax-case stx () - [(_ test-val - [(match-vals) . result] (... ...) - [else . else-result]) - #'(cond - [(PRED test-val '(match-vals)) . result] (... ...) - [else . else-result])] - [(_ test-val - match-clause (... ...)) - #'(ID test-val - match-clause (... ...) - [else (error 'ID "no match")])]))) - -;; like case but strictly uses `eq?` comparison (as opposed to `equal?`) -(define-case-macro caseq memq) - -;; `eqv?` is OK for chars (same as `char=?`) -(define-case-macro casev memv) \ No newline at end of file diff --git a/beautiful-racket-lib/br/cond.rkt b/beautiful-racket-lib/br/cond.rkt index 6e2d3b1..25c9c3e 100644 --- a/beautiful-racket-lib/br/cond.rkt +++ b/beautiful-racket-lib/br/cond.rkt @@ -1,6 +1,5 @@ #lang racket/base -(require (for-syntax racket/base br/syntax) - br/define) +(require (for-syntax racket/base) br/define) (provide (all-defined-out)) (define-macro (until COND EXPR ...) @@ -15,13 +14,6 @@ EXPR ... (loop)))) -(define-macro (forever . EXPRS) - ;; todo: would be better with a syntax parameter - (with-pattern - ([STOP (datum->syntax #'EXPRS 'stop)]) - #'(let/ec STOP - (while #t . EXPRS)))) - (module+ test (require rackunit) (check-equal? (let ([x 5]) diff --git a/beautiful-racket-lib/br/datum.rkt b/beautiful-racket-lib/br/datum.rkt index f6b0678..b4c0b66 100644 --- a/beautiful-racket-lib/br/datum.rkt +++ b/beautiful-racket-lib/br/datum.rkt @@ -1,31 +1,32 @@ #lang racket/base -(require (for-syntax racket/base br/syntax) br/define) -(provide (except-out (all-defined-out) string->datum)) +(provide format-datum format-datums) (define (blank? str) - (or (zero? (string-length str)) - (andmap char-blank? (string->list str)))) + (for/and ([c (in-string str)]) + (char-blank? c))) ;; read "foo bar" the same way as "(foo bar)" ;; otherwise "bar" is dropped, which is too astonishing (define (string->datum str) - (if (blank? str) - (void) - (let ([result (read (open-input-string (format "(~a)" str)))]) - (if (= (length result) 1) - (car result) - result)))) + (unless (blank? str) + (let ([result (read (open-input-string (format "(~a)" str)))]) + (if (= (length result) 1) + (car result) + result)))) -(define (datum? x) - (or (list? x) (symbol? x))) +(define (datum? x) (or (list? x) (symbol? x))) (define (format-datum datum-template . args) - (string->datum (apply format (format "~a" datum-template) (map (λ(arg) (if (syntax? arg) - (syntax->datum arg) - arg)) args)))) + (unless (datum? datum-template) + (raise-argument-error 'format-datums "datum?" datum-template)) + (string->datum (apply format (format "~a" datum-template) + (map (λ (arg) (if (syntax? arg) + (syntax->datum arg) + arg)) args)))) -;; todo: rephrase errors from `format` or `map` in terms of `format-datums` (define (format-datums datum-template . argss) + (unless (datum? datum-template) + (raise-argument-error 'format-datums "datum?" datum-template)) (apply map (λ args (apply format-datum datum-template args)) argss)) (module+ test diff --git a/beautiful-racket-lib/br/debug.rkt b/beautiful-racket-lib/br/debug.rkt index 9618a95..c4f2016 100644 --- a/beautiful-racket-lib/br/debug.rkt +++ b/beautiful-racket-lib/br/debug.rkt @@ -1,6 +1,5 @@ #lang racket/base -(require (for-syntax racket/base br/syntax) - br/define) +(require (for-syntax racket/base br/syntax) br/define) (provide (all-defined-out)) (define-macro-cases report @@ -11,9 +10,7 @@ expr-result)]) (define-macro-cases report-datum - [(_ STX-EXPR) - (with-pattern ([datum (syntax->datum #'STX-EXPR)]) - #'(report-datum STX-EXPR datum))] + [(_ STX-EXPR) #`(report-datum STX-EXPR #,(syntax->datum #'STX-EXPR))] [(_ STX-EXPR NAME) #'(let () (eprintf "~a = ~v\n" 'NAME (syntax->datum STX-EXPR)) diff --git a/beautiful-racket-lib/br/define.rkt b/beautiful-racket-lib/br/define.rkt index 4faba7c..1953ecd 100644 --- a/beautiful-racket-lib/br/define.rkt +++ b/beautiful-racket-lib/br/define.rkt @@ -1,26 +1,13 @@ #lang racket/base -(require - racket/function - (for-syntax racket/base - syntax/parse - br/private/syntax-flatten - br/private/generate-literals - syntax/define)) +(require racket/function + (for-syntax racket/base + syntax/parse + br/private/generate-literals + syntax/define)) (provide (all-defined-out) (for-syntax with-shared-id)) -(module+ test - (require rackunit)) - - -(define-syntax (define+provide stx) - (with-syntax ([(id lambda-exp) - (let-values ([(id-stx body-exp-stx) - (normalize-definition stx (datum->syntax stx 'λ) #t #t)]) - (list id-stx body-exp-stx))]) - #'(begin - (provide id) - (define id lambda-exp)))) +(module+ test (require rackunit)) (begin-for-syntax ;; expose the caller context within br:define macros with syntax parameter @@ -28,7 +15,6 @@ (provide caller-stx) (define-syntax-parameter caller-stx (λ(stx) (error 'caller-stx-not-parameterized)))) - (define-syntax (define-cases stx) (syntax-parse stx #:literals (syntax) @@ -73,7 +59,7 @@ (module+ test - (require rackunit racket/port) + (require racket/port) (parameterize ([current-output-port (open-output-nowhere)]) (check-equal? (let () (debug-define-macro (foo X Y Z) @@ -180,7 +166,7 @@ (module+ test - (define-macro plus (λ(stx) #'+)) + (define-macro plus (λ (stx) #'+)) (check-equal? (plus 42) +) (define-macro plusser #'plus) (check-equal? (plusser 42) +) @@ -238,11 +224,11 @@ (check-equal? (elseop "+") 'got-arg) (check-equal? (elseop "+" 42) 'got-else) - (check-exn exn:fail:syntax? (λ _ (expand-once #'(define-macro-cases no-cases)))) + (check-exn exn:fail:syntax? (λ () (expand-once #'(define-macro-cases no-cases)))) - (check-exn exn:fail:syntax? (λ _ (expand-once #'(define-macro-cases badelseop - [else #''got-else] - [(_ _arg) #''got-arg])))) + (check-exn exn:fail:syntax? (λ () (expand-once #'(define-macro-cases badelseop + [else #''got-else] + [(_ _arg) #''got-arg])))) (define-macro-cases no-else-macro [(_ ARG) #''got-arg]) diff --git a/beautiful-racket-lib/br/drracket.rkt b/beautiful-racket-lib/br/drracket.rkt deleted file mode 100644 index 8c0cb2c..0000000 --- a/beautiful-racket-lib/br/drracket.rkt +++ /dev/null @@ -1,11 +0,0 @@ -#lang racket/base -(require racket/class - racket/draw) - -(provide (all-defined-out)) -(define (make-drracket-button . args) - (define label (or (findf string? args) "untitled")) - (define bitmap (or (findf (λ(arg) (is-a? arg bitmap%)) args) (make-object bitmap% 16 16))) - (define callback (or (findf procedure? args) (λ(drr-frame) (void)))) - (define number (or (findf (λ(arg) (or (real? arg) (equal? #f arg))) args) #f)) - (list label bitmap callback number)) diff --git a/beautiful-racket-lib/br/get-info.rkt b/beautiful-racket-lib/br/get-info.rkt index d3310a2..8ff25a6 100644 --- a/beautiful-racket-lib/br/get-info.rkt +++ b/beautiful-racket-lib/br/get-info.rkt @@ -1,19 +1,19 @@ #lang racket +(require racket/class) (provide (all-defined-out)) -(require racket/class) (define (indenter t pos) - (with-handlers ([exn:fail? (λ(exn) #f)]) ; this function won't work until gui-lib 1.26 + (with-handlers ([exn:fail? (λ (exn) #f)]) ; this function won't work until gui-lib 1.26 (send t compute-racket-amount-to-indent pos (λ(x) (case x - [("with-pattern" "with-shared-id") 'lambda] - [("define-macro") 'define] + [("with-pattern" + "with-shared-id") 'lambda] + [("define-macro" + "define-macro-cases" + "define-cases") 'define] [else #f]))))) (define (br-get-info key default default-filter) (case key - #;[(color-lexer) - (dynamic-require 'syntax-color/default-lexer 'default-lexer)] [(drracket:indentation) indenter] - [else - (default-filter key default)])) \ No newline at end of file + [else (default-filter key default)])) \ No newline at end of file diff --git a/beautiful-racket-lib/br/list.rkt b/beautiful-racket-lib/br/list.rkt index 1ac1fd0..e82d3df 100644 --- a/beautiful-racket-lib/br/list.rkt +++ b/beautiful-racket-lib/br/list.rkt @@ -10,5 +10,15 @@ (define-macro (pop! ID) #'(let ([x (car ID)]) - (set! ID (cdr ID)) - x)) \ No newline at end of file + (set! ID (cdr ID)) + x)) + +(module+ test + (require rackunit) + (check-equal? '(1 2 3) (values->list (values 1 2 3))) + (check-equal? (let ([xs '(2 3)]) + (push! xs 1) + xs) '(1 2 3)) + (check-equal? (let ([xs '(1 2 3)]) + (define x (pop! xs)) + (cons x xs)) '(1 2 3))) \ No newline at end of file diff --git a/beautiful-racket-lib/br/main.rkt b/beautiful-racket-lib/br/main.rkt index 9c2d078..4af43f6 100644 --- a/beautiful-racket-lib/br/main.rkt +++ b/beautiful-racket-lib/br/main.rkt @@ -1,10 +1,10 @@ #lang racket/base (require racket/provide racket/list racket/string racket/format racket/match racket/port racket/function racket/provide - br/define br/syntax br/datum br/debug br/cond br/case br/exception br/list racket/class racket/vector br/reader-utils + br/define br/syntax br/datum br/debug br/cond br/exception br/list racket/class racket/vector br/reader-utils (for-syntax racket/base racket/syntax br/syntax br/debug br/define br/datum)) (provide (all-from-out racket/base) (all-from-out racket/list racket/string racket/format racket/match racket/port racket/function racket/provide - br/syntax br/datum br/debug br/cond br/case br/exception br/list racket/class racket/vector br/define br/reader-utils) + br/syntax br/datum br/debug br/cond br/exception br/list racket/class racket/vector br/define br/reader-utils) (for-syntax (all-from-out racket/base racket/syntax br/syntax br/debug br/datum)) (for-syntax caller-stx with-shared-id)) ; from br/define