Allow giving two contracts in field macro

This commit is contained in:
Sam Caldwell 2016-07-20 16:51:41 -04:00
parent 01ad7c72f6
commit c76480f701
1 changed files with 10 additions and 4 deletions

View File

@ -249,7 +249,10 @@
(define-splicing-syntax-class priority (define-splicing-syntax-class priority
(pattern (~seq #:priority level)) (pattern (~seq #:priority level))
(pattern (~seq) #:attr level #'*normal-priority*))) (pattern (~seq) #:attr level #'*normal-priority*))
(define-splicing-syntax-class field-contract
(pattern (~seq #:contract in (~optional out #:defaults ([out #f]))))))
(define-syntax (actor stx) (define-syntax (actor stx)
(syntax-parse stx (syntax-parse stx
@ -305,11 +308,14 @@
(react/suspend (continue) O ...))])) (react/suspend (continue) O ...))]))
(define-syntax (define-field stx) (define-syntax (define-field stx)
(syntax-case stx () (syntax-parse stx
[(_ id init) [(_ id init)
#'(define id (make-field 'id init))] #'(define id (make-field 'id init))]
[(_ id init #:contract contract) [(_ id init contract:field-contract)
#'(define/contract id (field/c contract) (make-field 'id init))])) (with-syntax ([ctc (if (attribute contract.out)
#'(field/c contract.in contract.out)
#'(field/c contract.in))])
#'(define/contract id ctc (make-field 'id init)))]))
(define-syntax (field stx) (define-syntax (field stx)
(syntax-parse stx (syntax-parse stx