suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add custom printer for terminal contracts.

Browse Source
This commit is contained in:
Eric Dobson 2014-01-07 22:27:08 -08:00
parent 497a7faa83
commit bb74b55f67
2 changed files with 12 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/parametric.rkt
View File

@ -52,4 +52,5 @@
#'(parametric-combinator (list body) vars)])) #'(parametric-combinator (list body) vars)]))
(define-terminal-sc parametric-var/sc (id) #:impersonator (define-terminal-sc parametric-var/sc (id) #:impersonator
#:printer (v p mode) (display (syntax-e (parametric-var/sc-id v)) p)
id) id)

13
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/terminal.rkt
View File

@ -18,14 +18,23 @@
(define-syntax-class kind-keyword (define-syntax-class kind-keyword
[pattern #:flat #:with sym 'flat] [pattern #:flat #:with sym 'flat]
[pattern #:chaperone #:with sym 'chaperone] [pattern #:chaperone #:with sym 'chaperone]
[pattern #:impersonator #:with sym 'impersonator])) [pattern #:impersonator #:with sym 'impersonator])
(define-splicing-syntax-class printer
[pattern (~seq #:printer (v p mode) body)
#:with (methods ...) #'(#:methods gen:custom-write [(define (write-proc v p mode) body)])]
[pattern (~seq)
#:with (methods ...) #'()])
)
(define-syntax (define-terminal-sc stx) (define-syntax (define-terminal-sc stx)
(syntax-parse stx (syntax-parse stx
[(_ name:id (args:id ...) kind:kind-keyword body:expr) [(_ name:id (args:id ...) kind:kind-keyword p:printer body:expr)
#'(struct name static-contract (args ...) #'(struct name static-contract (args ...)
#:transparent #:transparent
p.methods ...
#:methods gen:sc #:methods gen:sc
[(define (sc-map v f) v) [(define (sc-map v f) v)
(define (sc-traverse v f) (void)) (define (sc-traverse v f) (void))