contract.rkt (1978B)
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 #:phase [phase (syntax-local-phase-level)]) 20 #:attributes (c) 21 #:commit 22 (pattern y:expr 23 #:with 24 c (wrap-expr/c ctc-stx 25 #'y 26 #:arg? arg? 27 #:positive pos-blame 28 #:negative neg-blame 29 #:name (if (eq? expr-name not-given) 30 this-role 31 expr-name) 32 #:macro macro-name 33 #:context (or ctx (this-context-syntax)) 34 #:phase phase))) 35 36 (provide-syntax-class/contract 37 [expr/c (syntax-class/c (syntax?) 38 (#:arg? any/c 39 #:positive (or/c syntax? string? module-path-index? 40 'from-macro 'use-site 'unknown) 41 #:negative (or/c syntax? string? module-path-index? 42 'from-macro 'use-site 'unknown) 43 #:name (or/c identifier? string? symbol? #f) 44 #:macro (or/c identifier? string? symbol? #f) 45 #:context (or/c syntax? #f) 46 #:phase exact-integer?))])