update sugar/coerce & docs
parent
2741f08625
commit
30ee7910ca
@ -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)
|
|
@ -1,5 +1,52 @@
|
|||||||
#lang racket/base
|
#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"))
|
;; 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 ...))]))
|
||||||
|
@ -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 ...))]))
|
|
@ -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 ...))]))
|
|
Loading…
Reference in New Issue