From 30ee7910ca5505474eaa6d4505ca38effd66b59c Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 23 Jul 2014 18:33:48 -0700 Subject: [PATCH] update sugar/coerce & docs --- coerce.rkt | 156 ++++++++++++++++++++++++++++++++++++++- coerce/contract.rkt | 39 ---------- coerce/value.rkt | 110 --------------------------- container.rkt | 2 +- define.rkt | 51 ++++++++++++- define/contract.rkt | 41 ---------- define/provide.rkt | 14 ---- file.rkt | 2 +- list.rkt | 2 +- misc.rkt | 2 +- scribblings/coerce.scrbl | 89 ++++++++++++++++------ scribblings/sugar.scrbl | 2 +- string.rkt | 2 +- tree.rkt | 2 +- 14 files changed, 276 insertions(+), 238 deletions(-) delete mode 100644 coerce/contract.rkt delete mode 100644 coerce/value.rkt delete mode 100644 define/contract.rkt delete mode 100644 define/provide.rkt diff --git a/coerce.rkt b/coerce.rkt index cba6bb6..ccdf755 100644 --- a/coerce.rkt +++ b/coerce.rkt @@ -1,4 +1,156 @@ #lang racket/base +(require (for-syntax racket/base racket/syntax)) +(require net/url xml racket/set racket/contract racket/sequence racket/stream racket/dict) +(require "len.rkt" "define.rkt") + + + +(define (make-coercion-error-handler target-format x) + (λ(e) (error (format "Can’t convert ~a to ~a" x target-format)))) + + +(define+provide (->int x) + (with-handlers ([exn:fail? (make-coercion-error-handler 'integer x)]) + (cond + [(or (integer? x) (real? x)) (inexact->exact (floor x))] + [(and (string? x) (> (len x) 0)) (->int (string->number x))] + [(symbol? x) (->int (->string x))] + [(char? x) (char->integer x)] + [(path? x) (->int (->string x))] + [else (len x)]))) + + +(provide ->macrostring) +(define-syntax-rule (->macrostring x) + (if (string? x) + x ; fast exit for strings + (with-handlers ([exn:fail? (make-coercion-error-handler 'string (format "~a (result of ~a" x 'x))]) + (cond + [(equal? '() x) ""] + [(symbol? x) (symbol->string x)] + [(number? x) (number->string x)] + [(path? x) (path->string x)] + [(char? x) (format "~a" x)] + [else (error)])))) + +(define+provide (->string x) + (if (string? x) + x ; fast exit for strings + (with-handlers ([exn:fail? (make-coercion-error-handler 'string x)]) + (cond + [(equal? '() x) ""] + [(symbol? x) (symbol->string x)] + [(number? x) (number->string x)] + [(path? x) (path->string x)] + [(char? x) (format "~a" x)] + [else (error)])))) + + +(define+provide (->symbol x) + (if (symbol? x) + x + (with-handlers ([exn:fail? (make-coercion-error-handler 'symbol x)]) + (string->symbol (->string x))))) + + +(define+provide (->path x) + (if (path? x) + x + (with-handlers ([exn:fail? (make-coercion-error-handler 'path x)]) + (cond + [(url? x) (apply build-path (map path/param-path (url-path x)))] + [else (string->path (->string x))])))) + + +(define+provide (->url x) + (with-handlers ([exn:fail? (make-coercion-error-handler 'url x)]) + (string->url (->string x)))) + + +(define+provide (->complete-path x) + (with-handlers ([exn:fail? (make-coercion-error-handler 'complete-path x)]) + (path->complete-path (->path x)))) + + +(define+provide (->list x) + (if (list? x) + x + (with-handlers ([exn:fail? (make-coercion-error-handler 'list x)]) + (cond + [(string? x) (list x)] + [(vector? x) (vector->list x)] + [(set? x) (set->list x)] + ;; location relevant because hash or dict are also sequences + [(dict? x) (dict->list x)] + [(sequence? x) (sequence->list x)] + [(stream? x) (stream->list x)] + [else (list x)])))) + + +(define+provide (->vector x) + (if (vector? x) + x + (with-handlers ([exn:fail? (make-coercion-error-handler 'vector x)]) + (list->vector (->list x))))) + + +(define+provide (->boolean x) + (and x #t)) + + +(define-syntax (make-*ish-predicate stx) + (syntax-case stx () + [(_ stem) + (with-syntax ([stemish? (format-id stx "~aish?" #'stem)] + [->stem (format-id stx "->~a" #'stem)]) + #`(begin + (define+provide (stemish? x) + (with-handlers ([exn:fail? (λ(e) #f)]) (and (->stem x) #t)))))])) + +(make-*ish-predicate int) +(make-*ish-predicate string) +(make-*ish-predicate symbol) +(make-*ish-predicate url) +(make-*ish-predicate complete-path) +(make-*ish-predicate path) +(make-*ish-predicate list) +(make-*ish-predicate vector) +;; no point to having list and vector here; they work with everything + + + +(define-syntax-rule (make-blame-handler try-proc expected-sym) + (λ(b) + (λ(x) + (with-handlers ([exn:fail? (λ(e) + (raise-blame-error + b x + '(expected: "~a" given: "~e") + expected-sym x))]) + (try-proc x))))) + +(provide make-coercion-contract) +(define-syntax (make-coercion-contract stx) + (syntax-case stx () + [(_ stem coerce-proc) + (with-syntax ([coerce/stem? (format-id stx "coerce/~a?" #'stem)] + [can-be-stem? (format-id stx "can-be-~a?" #'stem)]) + #'(make-contract + #:name 'coerce/stem? + #:projection (make-blame-handler coerce-proc 'can-be-stem?)))] + [(_ stem) + (with-syntax ([->stem (format-id stx "->~a" #'stem)]) + #'(make-coercion-contract stem ->stem))])) + +(define-syntax (define+provide-coercion-contract stx) + (syntax-case stx () + [(_ stem) + (with-syntax ([coerce/stem? (format-id stx "coerce/~a?" #'stem)]) + #'(define+provide coerce/stem? (make-coercion-contract stem)))])) + +(define+provide-coercion-contract int) +(define+provide-coercion-contract string) +(define+provide-coercion-contract symbol) +(define+provide-coercion-contract path) +(define+provide-coercion-contract boolean) -(require "coerce/value.rkt" "coerce/contract.rkt") -(provide (all-from-out "coerce/value.rkt" "coerce/contract.rkt")) \ No newline at end of file diff --git a/coerce/contract.rkt b/coerce/contract.rkt deleted file mode 100644 index 5ce54ff..0000000 --- a/coerce/contract.rkt +++ /dev/null @@ -1,39 +0,0 @@ -#lang racket/base -(require (for-syntax racket/base racket/syntax)) -(require racket/contract "../define/provide.rkt" "value.rkt") - - -(define-syntax-rule (make-blame-handler try-proc expected-sym) - (λ(b) - (λ(x) - (with-handlers ([exn:fail? (λ(e) - (raise-blame-error - b x - '(expected: "~a" given: "~e") - expected-sym x))]) - (try-proc x))))) - -(provide make-coercion-contract) -(define-syntax (make-coercion-contract stx) - (syntax-case stx () - [(_ stem coerce-proc) - (with-syntax ([coerce/stem? (format-id stx "coerce/~a?" #'stem)] - [can-be-stem? (format-id stx "can-be-~a?" #'stem)]) - #'(make-contract - #:name 'coerce/stem? - #:projection (make-blame-handler coerce-proc 'can-be-stem?)))] - [(_ stem) - (with-syntax ([->stem (format-id stx "->~a" #'stem)]) - #'(make-coercion-contract stem ->stem))])) - -(define-syntax (define+provide-coercion-contract stx) - (syntax-case stx () - [(_ stem) - (with-syntax ([coerce/stem? (format-id stx "coerce/~a?" #'stem)]) - #'(define+provide coerce/stem? (make-coercion-contract stem)))])) - -(define+provide-coercion-contract int) -(define+provide-coercion-contract string) -(define+provide-coercion-contract symbol) -(define+provide-coercion-contract path) -(define+provide-coercion-contract boolean) diff --git a/coerce/value.rkt b/coerce/value.rkt deleted file mode 100644 index 20071f3..0000000 --- a/coerce/value.rkt +++ /dev/null @@ -1,110 +0,0 @@ -#lang racket/base -(require (for-syntax racket/base racket/syntax)) -(require net/url xml racket/set) -(require "../len.rkt" "../define/provide.rkt") - - -(define (make-coercion-error-handler target-format x) - (λ(e) (error (format "Can’t convert ~a to ~a" x target-format)))) - - -(define+provide (->int x) - (with-handlers ([exn:fail? (make-coercion-error-handler 'integer x)]) - (cond - [(or (integer? x) (real? x)) (inexact->exact (floor x))] - [(and (string? x) (> (len x) 0)) (->int (string->number x))] - [(symbol? x) (->int (->string x))] - [(char? x) (char->integer x)] - [(path? x) (->int (->string x))] - [else (len x)]))) - - -(provide ->macrostring) -(define-syntax-rule (->macrostring x) - (if (string? x) - x ; fast exit for strings - (with-handlers ([exn:fail? (make-coercion-error-handler 'string (format "~a (result of ~a" x 'x))]) - (cond - [(equal? '() x) ""] - [(symbol? x) (symbol->string x)] - [(number? x) (number->string x)] - [(path? x) (path->string x)] - [(char? x) (format "~a" x)] - [else (error)])))) - -(define+provide (->string x) - (if (string? x) - x ; fast exit for strings - (with-handlers ([exn:fail? (make-coercion-error-handler 'string x)]) - (cond - [(equal? '() x) ""] - [(symbol? x) (symbol->string x)] - [(number? x) (number->string x)] - [(path? x) (path->string x)] - [(char? x) (format "~a" x)] - [else (error)])))) - - -(define+provide (->symbol x) - (if (symbol? x) - x - (with-handlers ([exn:fail? (make-coercion-error-handler 'symbol x)]) - (string->symbol (->string x))))) - - -(define+provide (->path x) - (if (path? x) - x - (with-handlers ([exn:fail? (make-coercion-error-handler 'path x)]) - (cond - [(url? x) (apply build-path (map path/param-path (url-path x)))] - [else (string->path (->string x))])))) - - -(define+provide (->url x) - (with-handlers ([exn:fail? (make-coercion-error-handler 'url x)]) - (string->url (->string x)))) - - -(define+provide (->complete-path x) - (with-handlers ([exn:fail? (make-coercion-error-handler 'complete-path x)]) - (path->complete-path (->path x)))) - - -(define+provide (->list x) - (if (list? x) - x - (with-handlers ([exn:fail? (make-coercion-error-handler 'list x)]) - (cond - [(vector? x) (vector->list x)] - [(set? x) (set->list x)] - [else (list x)])))) - - -(define+provide (->vector x) - (if (vector? x) - x - (with-handlers ([exn:fail? (make-coercion-error-handler 'vector x)]) - (list->vector (->list x))))) - - -(define+provide (->boolean x) - (and x #t)) - - -(define-syntax (make-*ish-predicate stx) - (syntax-case stx () - [(_ stem) - (with-syntax ([stemish? (format-id stx "~aish?" #'stem)] - [->stem (format-id stx "->~a" #'stem)]) - #`(begin - (define+provide (stemish? x) - (with-handlers ([exn:fail? (λ(e) #f)]) (and (->stem x) #t)))))])) - -(make-*ish-predicate int) -(make-*ish-predicate string) -(make-*ish-predicate symbol) -(make-*ish-predicate url) -(make-*ish-predicate complete-path) -(make-*ish-predicate path) -;; no point to having list and vector here; they work with everything diff --git a/container.rkt b/container.rkt index 5ad91da..73feb21 100644 --- a/container.rkt +++ b/container.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require "define/contract.rkt") +(require "define.rkt") (require "coerce.rkt" "len.rkt" racket/list) (define (sliceable-container? x) diff --git a/define.rkt b/define.rkt index 68f0e7a..bbd0615 100644 --- a/define.rkt +++ b/define.rkt @@ -1,5 +1,52 @@ #lang racket/base +(require (for-syntax racket/base)) +(require racket/contract) -(require "define/provide.rkt" "define/contract.rkt") +(provide (all-defined-out) (all-from-out racket/contract)) -(provide (all-from-out "define/provide.rkt" "define/contract.rkt")) \ No newline at end of file +;; each define macro recursively converts any form of define +;; into its lambda form (define name body ...) and then operates on that. + +(define-syntax (define+provide+safe stx) + (syntax-case stx () + [(_ (proc arg ... . rest-arg) contract body ...) + #'(define+provide+safe proc contract + (λ(arg ... . rest-arg) body ...))] + [(_ name contract body ...) + #'(begin + (define name body ...) + (provide name) + (module+ safe + (provide (contract-out [name contract]))))])) + +(define-syntax (define+provide/contract stx) + (syntax-case stx () + [(_ (proc arg ... . rest-arg) contract body ...) + #'(define+provide/contract proc contract + (λ(arg ... . rest-arg) body ...))] + [(_ name contract body ...) + #'(begin + (provide (contract-out [name contract])) + (define name body ...))])) + + +(define-syntax (define/contract+provide stx) + (syntax-case stx () + [(_ (proc arg ... . rest-arg) contract body ...) + #'(define/contract+provide proc contract + (λ(arg ... . rest-arg) body ...))] + [(_ name contract body ...) + #'(begin + (provide name) + (define/contract name contract body ...))])) + + +(define-syntax (define+provide stx) + (syntax-case stx () + [(_ (proc arg ... . rest-arg) body ...) + #'(define+provide proc + (λ(arg ... . rest-arg) body ...))] + [(_ name body ...) + #'(begin + (provide name) + (define name body ...))])) diff --git a/define/contract.rkt b/define/contract.rkt deleted file mode 100644 index bd0c873..0000000 --- a/define/contract.rkt +++ /dev/null @@ -1,41 +0,0 @@ -#lang racket/base -(require (for-syntax racket/base)) -(require racket/contract) - -(provide (all-defined-out) (all-from-out racket/contract)) - -;; each define macro recursively converts any form of define -;; into its lambda form (define name body ...) and then operates on that. - -(define-syntax (define+provide+safe stx) - (syntax-case stx () - [(_ (proc arg ... . rest-arg) contract body ...) - #'(define+provide+safe proc contract - (λ(arg ... . rest-arg) body ...))] - [(_ name contract body ...) - #'(begin - (define name body ...) - (provide name) - (module+ safe - (provide (contract-out [name contract]))))])) - -(define-syntax (define+provide/contract stx) - (syntax-case stx () - [(_ (proc arg ... . rest-arg) contract body ...) - #'(define+provide/contract proc contract - (λ(arg ... . rest-arg) body ...))] - [(_ name contract body ...) - #'(begin - (provide (contract-out [name contract])) - (define name body ...))])) - - -(define-syntax (define/contract+provide stx) - (syntax-case stx () - [(_ (proc arg ... . rest-arg) contract body ...) - #'(define/contract+provide proc contract - (λ(arg ... . rest-arg) body ...))] - [(_ name contract body ...) - #'(begin - (provide name) - (define/contract name contract body ...))])) diff --git a/define/provide.rkt b/define/provide.rkt deleted file mode 100644 index d3fb289..0000000 --- a/define/provide.rkt +++ /dev/null @@ -1,14 +0,0 @@ -#lang racket/base -(require (for-syntax racket/base)) - -(provide (all-defined-out)) - -(define-syntax (define+provide stx) - (syntax-case stx () - [(_ (proc arg ... . rest-arg) body ...) - #'(define+provide proc - (λ(arg ... . rest-arg) body ...))] - [(_ name body ...) - #'(begin - (provide name) - (define name body ...))])) diff --git a/file.rkt b/file.rkt index 4e0d160..f654ed0 100644 --- a/file.rkt +++ b/file.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require sugar/define/contract sugar/coerce/contract sugar/string racket/path) +(require "define.rkt" "coerce.rkt" "string.rkt" racket/path) diff --git a/list.rkt b/list.rkt index 1a02ab3..f5f24bf 100644 --- a/list.rkt +++ b/list.rkt @@ -1,6 +1,6 @@ #lang racket/base (require racket/list) -(require "define/contract.rkt" "len.rkt" "coerce/value.rkt") +(require "define.rkt" "len.rkt" "coerce.rkt") (define+provide/contract (trim items test-proc) (list? procedure? . -> . list?) diff --git a/misc.rkt b/misc.rkt index 4f0036d..8f8ed5d 100644 --- a/misc.rkt +++ b/misc.rkt @@ -1,6 +1,6 @@ #lang racket/base (require (for-syntax racket/base)) -(require "define/contract.rkt") +(require "define.rkt") (define+provide/contract (bytecount->string bytecount) (integer? . -> . string?) diff --git a/scribblings/coerce.scrbl b/scribblings/coerce.scrbl index 2862c43..adb004d 100644 --- a/scribblings/coerce.scrbl +++ b/scribblings/coerce.scrbl @@ -9,27 +9,42 @@ @defmodule[sugar/coerce] @section{Values} -@defmodule[sugar/coerce/value] @defproc[ (->int [v any/c]) integer?] -Convert @racket[_v] to an integer in the least surprising way possible, or raise an error if it can't be done +Convert @racket[_v] to an integer in the least surprising way, or raise an error if no conversion is possible. Numbers are rounded down to the nearest integer. -Stringlike values are converted to numbers and rounded down. +@examples[#:eval my-eval +(->int 3) +(->int 3.5) +(->int -2.5) +(->int (+ 3 (/ 1 2)))] + +Stringlike values — paths, symbols, and strings — are converted to numbers and rounded down. + +@examples[#:eval my-eval +(->int "3.5") +(->int '3.5) +(->int (string->path "3.5"))] Characters are directly converted to integers. +@examples[#:eval my-eval +(->int #\A) +(->int #\◊)] + Lists, vectors, and other multi-value datatypes return their length (using @racket[len]). @examples[#:eval my-eval -(map ->int (list 3 3.5 -2.5 (+ 3 (/ 1 2)))) -(map ->int (list "3.5" '3.5 (string->path "3.5"))) (->int (list 5 6 7)) -(->int (hash 'a 1 'b 2 'c 3)) +(->int (hash 'a 1 'b 2 'c 3))] + +The function will raise an error if no sensible conversion is possible. +@examples[#:eval my-eval (->int #t) ] @@ -52,7 +67,7 @@ Return the most natural string representation of @racket[_v], or raise an error (->symbol [v any/c]) symbol?] -Same as @racket[->string], but returns a symbol rather than a string. +Same as @racket[->string], but return a symbol rather than a string. @examples[#:eval my-eval (->symbol "string") @@ -74,7 +89,7 @@ path?] [v any/c]) complete-path?] )] -Same as @racket[->string], but returns a path (or complete path) rather than a string. +Same as @racket[->string], but return a path (or complete path) rather than a string. @examples[#:eval my-eval (->path "string") @@ -90,14 +105,18 @@ Same as @racket[->string], but returns a path (or complete path) rather than a s (->list [v any/c]) list?] -Convert a listlike @racket[_v] into a list, or put an atomic @racket[_v] into a single-member list. +If @racket[_v] is a listlike data type — a vector, set, stream, sequence, or list — convert it to a list. A hash or dictionary becomes a list using @racket[dict->list]. If @racket[_v] is an atomic value, turn it into a single-member list. + +Note that a string is treated as an atomic value rather than decomposed with @racket[string->list]. This is done so the function handles strings the same way as symbols and paths. @examples[#:eval my-eval +(->list '(a b c)) +(->list (list->vector '(a b c))) +(->list (make-hash '((k . v) (k2 . v2)))) (->list "string") (->list 'symbol) +(->list (string->path "path")) (->list +) -(->list '(a b c)) -(->list (list->vector '(a b c))) ] @defproc[ @@ -107,21 +126,27 @@ vector?] Same as @racket[->list], but returns a vector rather than a list. @examples[#:eval my-eval +(->vector '(a b c)) +(->vector (list->vector '(a b c))) +(->vector (make-hash '((k . v) (k2 . v2)))) (->vector "string") (->vector 'symbol) +(->vector (string->path "path")) (->vector +) -(->vector '(a b c)) -(->vector (list->vector '(a b c))) ] @defproc[ (->boolean [v any/c]) boolean?] -Return @racket[#t] for any @racket[_v] except @racket[#f], which remains @racket[#f]. Same as @code{(and v #t)}. +Return @racket[#t] for all @racket[_v] except @racket[#f], which remains @racket[#f]. @examples[#:eval my-eval -(map ->boolean (list "string" 'symbol + '(l i s t) #f)) +(->boolean "string") +(->boolean 'symbol) +(->boolean +) +(->boolean '(l i s t)) +(->boolean #f) ] @@ -131,8 +156,10 @@ Return @racket[#t] for any @racket[_v] except @racket[#f], which remains @racket @defproc[(symbolish? [v any/c]) boolean?] @defproc[(pathish? [v any/c]) boolean?] @defproc[(complete-pathish? [v any/c]) boolean?] +@defproc[(listish? [v any/c]) boolean?] +@defproc[(vectorish? [v any/c]) boolean?] )] -Report whether @racket[_v] can be coerced to the specified type. +Predicates that report whether @racket[_v] can be coerced to the specified type. @examples[#:eval my-eval (map intish? (list 3 3.5 #\A "A" + #t)) @@ -140,33 +167,49 @@ Report whether @racket[_v] can be coerced to the specified type. (map symbolish? (list 3 3.5 #\A "A" + #t)) (map pathish? (list 3 3.5 #\A "A" + #t)) (map complete-pathish? (list 3 3.5 #\A "A" + #t)) - +(map listish? (list 3 3.5 #\A "A" + #t)) +(map vectorish? (list 3 3.5 #\A "A" + #t)) ] -@section{Contracts that coerce} -@defmodule[sugar/coerce/contract] +@section{Coercion contracts} @deftogether[( -@defproc[(coerce/int? [v any/c]) int?] -@defproc[(coerce/string? [v any/c]) string] -@defproc[(coerce/symbol? [v any/c]) symbol] +@defproc[(coerce/int? [v any/c]) integer?] +@defproc[(coerce/string? [v any/c]) string?] +@defproc[(coerce/symbol? [v any/c]) symbol?] @defproc[(coerce/path? [v any/c]) path?] @defproc[(coerce/boolean? [v any/c]) boolean?] )] -If @racket[_v] can be coerced to the specified type, these contracts will return it so coerced. If not, they raise the usual contract error. This is an unusual way to use contracts, but it can be handy. +If @racket[_v] can be coerced to the specified type, change it to that type, then return it. If not, raise the usual contract error. These contracts can be used with input or output values. @examples[#:eval my-eval (define/contract (add-ints x y) (coerce/int? coerce/int? . -> . any/c) (+ x y)) +(code:comment @#,t{Input arguments will be coerced to integers, then added}) (add-ints 1.6 3.8) (define/contract (int-sum x y) (any/c any/c . -> . coerce/int?) (+ x y)) +(code:comment @#,t{Input arguments will be added, and the result coerced to an integer}) (int-sum 1.6 3.8) ] +Please note: this is not an officially sanctioned way to use Racket's contract system, because contracts aren't supposed to mutate their values (see @racket[make-contract]). + +But coercion contracts can be useful in two situations: + +@itemlist[ + +@item{You want to be liberal about input types, but don't want to deal with the housekeeping and manual conversions between types.} + +@item{Your contract involves an expensive operation that you'd rather avoid performing twice.} + + +] + + diff --git a/scribblings/sugar.scrbl b/scribblings/sugar.scrbl index eb64a45..b614bf2 100644 --- a/scribblings/sugar.scrbl +++ b/scribblings/sugar.scrbl @@ -10,7 +10,7 @@ @author[(author+email "Matthew Butterick" "mb@mbtype.com")] -A collection of tiny functions to help make Racket code more readable. +A collection of small functions to help make Racket code simpler & more readable. @section{Installation & updates} diff --git a/string.rkt b/string.rkt index 15ef02d..9188b22 100644 --- a/string.rkt +++ b/string.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require "define/contract.rkt" "coerce.rkt") +(require "define.rkt" "coerce.rkt") (define+provide/contract (starts-with? str starter) diff --git a/tree.rkt b/tree.rkt index 5e42dda..0a12d3b 100644 --- a/tree.rkt +++ b/tree.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require "define/contract.rkt") +(require "define.rkt") (module+ test (require rackunit))