contract.rkt (1817B)
1 #lang racket/base 2 (require stxparse-info/parse/pre 3 "provide.rkt" 4 syntax/contract 5 (only-in stxparse-info/parse/private/residual ;; keep abs. path 6 this-context-syntax 7 this-role) 8 racket/contract/base) 9 10 (define not-given (gensym)) 11 12 (define-syntax-class (expr/c ctc-stx 13 #:arg? [arg? #t] 14 #:positive [pos-blame 'from-macro] 15 #:negative [neg-blame 'use-site] 16 #:macro [macro-name #f] 17 #:name [expr-name not-given] 18 #:context [ctx #f]) 19 #:attributes (c) 20 #:commit 21 (pattern y:expr 22 #:with 23 c (wrap-expr/c ctc-stx 24 #'y 25 #:arg? arg? 26 #:positive pos-blame 27 #:negative neg-blame 28 #:name (if (eq? expr-name not-given) 29 this-role 30 expr-name) 31 #:macro macro-name 32 #:context (or ctx (this-context-syntax))))) 33 34 (provide-syntax-class/contract 35 [expr/c (syntax-class/c (syntax?) 36 (#:arg? any/c 37 #:positive (or/c syntax? string? module-path-index? 38 'from-macro 'use-site 'unknown) 39 #:negative (or/c syntax? string? module-path-index? 40 'from-macro 'use-site 'unknown) 41 #:name (or/c identifier? string? symbol? #f) 42 #:macro (or/c identifier? string? symbol? #f) 43 #:context (or/c syntax? #f)))])