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

Allow contract definitions created from expressions to be fixed up.

Browse Source 
original commit: 115345300dc4bfe3a14c7b7f73507719e2f6500d
This commit is contained in:
Eric Dobson 2012-07-26 21:32:09 -07:00 committed by Sam Tobin-Hochstadt
parent ce51776f1f
commit 3d0e20043d
1 changed files with 24 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
collects/typed-racket/private/type-contract.rkt
View File

@ -19,15 +19,34 @@
(only-in unstable/contract sequence/c)
(only-in racket/class object% is-a?/c subclass?/c object-contract class/c init object/c class?)))
;; These check if either the define form or the body form has the syntax
;; property. Normally the define form will have the property but lifting an
;; expression to the module level will put the property on the body.
(define-values (typechecker:contract-def
typechecker:flat-contract-def
typechecker:contract-def/maker)
(let ()
(define ((get-contract-def property) stx)
(or (syntax-property stx property)
(syntax-case stx (define-values)
((define-values (name) body)
(syntax-property #'body property))
(_ #f))))
(values
(get-contract-def 'typechecker:contract-def)
(get-contract-def 'typechecker:flat-contract-def)
(get-contract-def 'typechecker:contract-def/maker))))
(define (define/fixup-contract? stx)
(or (syntax-property stx 'typechecker:contract-def)
(syntax-property stx 'typechecker:flat-contract-def)
(syntax-property stx 'typechecker:contract-def/maker)))
(or (typechecker:contract-def stx)
(typechecker:flat-contract-def stx)
(typechecker:contract-def/maker stx)))
(define (generate-contract-def stx)
(define prop (define/fixup-contract? stx))
(define maker? (syntax-property stx 'typechecker:contract-def/maker))
(define flat? (syntax-property stx 'typechecker:flat-contract-def))
(define maker? (typechecker:contract-def/maker stx))
(define flat? (typechecker:flat-contract-def stx))
(define typ (parse-type prop))
(syntax-parse stx #:literals (define-values)
[(define-values (n) _)