lib.rkt (3513B)
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 (define regexp-stx? (stxof regexp?)) 42 (define byte-regexp-stx? (stxof byte-regexp?)) 43 44 45 ;; == Integrable syntax classes == 46 47 (define-integrable-syntax-class identifier (quote "identifier") identifier?) 48 (define-integrable-syntax-class expr (quote "expression") expr-stx?) 49 (define-integrable-syntax-class keyword (quote "keyword") keyword-stx?) 50 (define-integrable-syntax-class boolean (quote "boolean") boolean-stx?) 51 (define-integrable-syntax-class character (quote "character") char-stx?) 52 (define-integrable-syntax-class number (quote "number") number-stx?) 53 (define-integrable-syntax-class integer (quote "integer") integer-stx?) 54 (define-integrable-syntax-class exact-integer (quote "exact-integer") exact-integer-stx?) 55 (define-integrable-syntax-class exact-nonnegative-integer 56 (quote "exact-nonnegative-integer") 57 exact-nonnegative-integer-stx?) 58 (define-integrable-syntax-class exact-positive-integer 59 (quote "exact-positive-integer") 60 exact-positive-integer-stx?) 61 62 (define-integrable-syntax-class -string (quote "string") string-stx?) 63 (define-integrable-syntax-class -bytes (quote "bytes") bytes-stx?) 64 (define-integrable-syntax-class -regexp (quote "regexp") regexp-stx?) 65 (define-integrable-syntax-class -byte-regexp (quote "byte-regexp") byte-regexp-stx?) 66 67 ;; Overloading the meaning of existing identifiers 68 (begin-for-syntax 69 (set-box! alt-stxclass-mapping 70 (list (cons #'string (syntax-local-value #'-string)) 71 (cons #'bytes (syntax-local-value #'-bytes)) 72 (cons #'regexp (syntax-local-value #'-regexp)) 73 (cons #'byte-regexp (syntax-local-value #'-byte-regexp))))) 74 75 ;; Aliases 76 (define-syntax id (make-rename-transformer #'identifier)) 77 (define-syntax nat (make-rename-transformer #'exact-nonnegative-integer)) 78 (define-syntax char (make-rename-transformer #'character)) 79 (define-syntax str (make-rename-transformer #'-string)) 80 81 82 ;; == Normal syntax classes == 83 84 (define notfound (box 'notfound)) 85 86 (define-syntax-class (static pred [name #f]) 87 #:attributes (value) 88 #:description name 89 #:commit 90 (pattern x:id 91 #:fail-unless (syntax-transforming?) 92 "not within the dynamic extent of a macro transformation" 93 #:attr value (syntax-local-value #'x (lambda () notfound)) 94 #:fail-when (eq? (attribute value) notfound) #f 95 #:fail-unless (pred (attribute value)) #f 96 #:do [(state-cons! 'literals #'x)]))