contract.rkt (1694B)
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 #:positive [pos-blame 'use-site] 14 #:negative [neg-blame 'from-macro] 15 #:macro [macro-name #f] 16 #:name [expr-name not-given] 17 #:context [ctx #f]) 18 #:attributes (c) 19 #:commit 20 (pattern y:expr 21 #:with 22 c (wrap-expr/c ctc-stx 23 #'y 24 #:positive pos-blame 25 #:negative neg-blame 26 #:name (if (eq? expr-name not-given) 27 this-role 28 expr-name) 29 #:macro macro-name 30 #:context (or ctx (this-context-syntax))))) 31 32 (provide-syntax-class/contract 33 [expr/c (syntax-class/c (syntax?) 34 (#:positive (or/c syntax? string? module-path-index? 35 'from-macro 'use-site 'unknown) 36 #:negative (or/c syntax? string? module-path-index? 37 'from-macro 'use-site 'unknown) 38 #:name (or/c identifier? string? symbol? #f) 39 #:macro (or/c identifier? string? symbol? #f) 40 #:context (or/c syntax? #f)))])