lib.rkt (3073B)
1 #lang racket/base 2 (require "sc.rkt" 3 syntax/parse/private/keywords 4 (only-in "residual.rkt" state-cons!) 5 (for-syntax syntax/parse/private/residual-ct) 6 (for-syntax racket/base)) 7 8 (provide identifier 9 boolean 10 str 11 character 12 keyword 13 number 14 integer 15 exact-integer 16 exact-nonnegative-integer 17 exact-positive-integer 18 19 id 20 nat 21 char 22 23 expr 24 static) 25 26 27 (define (expr-stx? x) 28 (not (keyword-stx? x))) 29 30 (define ((stxof pred?) x) (and (syntax? x) (pred? (syntax-e x)))) 31 (define keyword-stx? (stxof keyword?)) 32 (define boolean-stx? (stxof boolean?)) 33 (define string-stx? (stxof string?)) 34 (define bytes-stx? (stxof bytes?)) 35 (define char-stx? (stxof char?)) 36 (define number-stx? (stxof number?)) 37 (define integer-stx? (stxof integer?)) 38 (define exact-integer-stx? (stxof exact-integer?)) 39 (define exact-nonnegative-integer-stx? (stxof exact-nonnegative-integer?)) 40 (define exact-positive-integer-stx? (stxof exact-positive-integer?)) 41 42 43 ;; == Integrable syntax classes == 44 45 (define-integrable-syntax-class identifier (quote "identifier") identifier?) 46 (define-integrable-syntax-class expr (quote "expression") expr-stx?) 47 (define-integrable-syntax-class keyword (quote "keyword") keyword-stx?) 48 (define-integrable-syntax-class boolean (quote "boolean") boolean-stx?) 49 (define-integrable-syntax-class character (quote "character") char-stx?) 50 (define-integrable-syntax-class number (quote "number") number-stx?) 51 (define-integrable-syntax-class integer (quote "integer") integer-stx?) 52 (define-integrable-syntax-class exact-integer (quote "exact-integer") exact-integer-stx?) 53 (define-integrable-syntax-class exact-nonnegative-integer 54 (quote "exact-nonnegative-integer") 55 exact-nonnegative-integer-stx?) 56 (define-integrable-syntax-class exact-positive-integer 57 (quote "exact-positive-integer") 58 exact-positive-integer-stx?) 59 60 (define-integrable-syntax-class -string (quote "string") string-stx?) 61 (define-integrable-syntax-class -bytes (quote "bytes") bytes-stx?) 62 (begin-for-syntax 63 (set-box! alt-stxclass-mapping 64 (list (cons #'string (syntax-local-value #'-string)) 65 (cons #'bytes (syntax-local-value #'-bytes))))) 66 67 ;; Aliases 68 (define-syntax id (make-rename-transformer #'identifier)) 69 (define-syntax nat (make-rename-transformer #'exact-nonnegative-integer)) 70 (define-syntax char (make-rename-transformer #'character)) 71 (define-syntax str (make-rename-transformer #'-string)) 72 73 74 ;; == Normal syntax classes == 75 76 (define notfound (box 'notfound)) 77 78 (define-syntax-class (static pred [name #f]) 79 #:attributes (value) 80 #:description name 81 #:commit 82 (pattern x:id 83 #:fail-unless (syntax-transforming?) 84 "not within the dynamic extent of a macro transformation" 85 #:attr value (syntax-local-value #'x (lambda () notfound)) 86 #:fail-when (eq? (attribute value) notfound) #f 87 #:fail-unless (pred (attribute value)) #f 88 #:do [(state-cons! 'literals #'x)]))