support string, bytes (bindings from racket) as stxclass refs
add compile-time table as alternative to stxclass binding
This commit is contained in:
parent
ce9b309dbc
commit
c082f130cb
|
@ -31,7 +31,6 @@ actually a valid expression.
|
||||||
@deftogether[(
|
@deftogether[(
|
||||||
@defstxclass[identifier]
|
@defstxclass[identifier]
|
||||||
@defstxclass[boolean]
|
@defstxclass[boolean]
|
||||||
@defstxclass[str]
|
|
||||||
@defstxclass[char]
|
@defstxclass[char]
|
||||||
@defstxclass[keyword]
|
@defstxclass[keyword]
|
||||||
@defstxclass[number]
|
@defstxclass[number]
|
||||||
|
@ -43,8 +42,23 @@ actually a valid expression.
|
||||||
Match syntax satisfying the corresponding predicates.
|
Match syntax satisfying the corresponding predicates.
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@deftogether[[
|
||||||
|
@defidform[#:kind "syntax class" #:link-target? #f
|
||||||
|
string]
|
||||||
|
@defidform[#:kind "syntax class" #:link-target? #f
|
||||||
|
bytes]
|
||||||
|
]]{
|
||||||
|
|
||||||
|
As special cases, Racket's @racket[string] and @racket[bytes] bindings
|
||||||
|
are also interpreted as syntax classes that recognize literal strings
|
||||||
|
and bytes, respectively.
|
||||||
|
|
||||||
|
@history[#:added "6.9.0.4"]
|
||||||
|
}
|
||||||
|
|
||||||
@defstxclass[id]{ Alias for @racket[identifier]. }
|
@defstxclass[id]{ Alias for @racket[identifier]. }
|
||||||
@defstxclass[nat]{ Alias for @racket[exact-nonnegative-integer]. }
|
@defstxclass[nat]{ Alias for @racket[exact-nonnegative-integer]. }
|
||||||
|
@defstxclass[str]{ Alias for @racket[string]. }
|
||||||
|
|
||||||
@defstxclass[(static [predicate (-> any/c any/c)]
|
@defstxclass[(static [predicate (-> any/c any/c)]
|
||||||
[description (or/c string? #f)])]{
|
[description (or/c string? #f)])]{
|
||||||
|
|
|
@ -505,6 +505,15 @@
|
||||||
|
|
||||||
;; == Lib tests
|
;; == Lib tests
|
||||||
|
|
||||||
|
;; test string, bytes act as stxclasses
|
||||||
|
|
||||||
|
(test-case "string, bytes act as stxclasses"
|
||||||
|
(check-equal? (syntax->datum
|
||||||
|
(syntax-parse #'(#"a" #"b" "c" "d")
|
||||||
|
[(b:bytes ... s:string ...)
|
||||||
|
#'((b ...) (s ...))]))
|
||||||
|
'((#"a" #"b") ("c" "d"))))
|
||||||
|
|
||||||
;; static
|
;; static
|
||||||
|
|
||||||
(tcerr "static: correct error"
|
(tcerr "static: correct error"
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
(require "sc.rkt"
|
(require "sc.rkt"
|
||||||
"keywords.rkt"
|
"keywords.rkt"
|
||||||
|
(for-syntax syntax/parse/private/residual-ct)
|
||||||
(for-syntax racket/base))
|
(for-syntax racket/base))
|
||||||
|
|
||||||
(provide identifier
|
(provide identifier
|
||||||
|
@ -29,6 +30,7 @@
|
||||||
(define keyword-stx? (stxof keyword?))
|
(define keyword-stx? (stxof keyword?))
|
||||||
(define boolean-stx? (stxof boolean?))
|
(define boolean-stx? (stxof boolean?))
|
||||||
(define string-stx? (stxof string?))
|
(define string-stx? (stxof string?))
|
||||||
|
(define bytes-stx? (stxof bytes?))
|
||||||
(define char-stx? (stxof char?))
|
(define char-stx? (stxof char?))
|
||||||
(define number-stx? (stxof number?))
|
(define number-stx? (stxof number?))
|
||||||
(define integer-stx? (stxof integer?))
|
(define integer-stx? (stxof integer?))
|
||||||
|
@ -36,6 +38,7 @@
|
||||||
(define exact-nonnegative-integer-stx? (stxof exact-nonnegative-integer?))
|
(define exact-nonnegative-integer-stx? (stxof exact-nonnegative-integer?))
|
||||||
(define exact-positive-integer-stx? (stxof exact-positive-integer?))
|
(define exact-positive-integer-stx? (stxof exact-positive-integer?))
|
||||||
|
|
||||||
|
|
||||||
;; == Integrable syntax classes ==
|
;; == Integrable syntax classes ==
|
||||||
|
|
||||||
(define-integrable-syntax-class identifier (quote "identifier") identifier?)
|
(define-integrable-syntax-class identifier (quote "identifier") identifier?)
|
||||||
|
@ -43,7 +46,6 @@
|
||||||
(define-integrable-syntax-class keyword (quote "keyword") keyword-stx?)
|
(define-integrable-syntax-class keyword (quote "keyword") keyword-stx?)
|
||||||
(define-integrable-syntax-class boolean (quote "boolean") boolean-stx?)
|
(define-integrable-syntax-class boolean (quote "boolean") boolean-stx?)
|
||||||
(define-integrable-syntax-class character (quote "character") char-stx?)
|
(define-integrable-syntax-class character (quote "character") char-stx?)
|
||||||
(define-integrable-syntax-class str (quote "string") string-stx?)
|
|
||||||
(define-integrable-syntax-class number (quote "number") number-stx?)
|
(define-integrable-syntax-class number (quote "number") number-stx?)
|
||||||
(define-integrable-syntax-class integer (quote "integer") integer-stx?)
|
(define-integrable-syntax-class integer (quote "integer") integer-stx?)
|
||||||
(define-integrable-syntax-class exact-integer (quote "exact-integer") exact-integer-stx?)
|
(define-integrable-syntax-class exact-integer (quote "exact-integer") exact-integer-stx?)
|
||||||
|
@ -54,10 +56,19 @@
|
||||||
(quote "exact-positive-integer")
|
(quote "exact-positive-integer")
|
||||||
exact-positive-integer-stx?)
|
exact-positive-integer-stx?)
|
||||||
|
|
||||||
|
(define-integrable-syntax-class -string (quote "string") string-stx?)
|
||||||
|
(define-integrable-syntax-class -bytes (quote "bytes") bytes-stx?)
|
||||||
|
(begin-for-syntax
|
||||||
|
(set-box! alt-stxclass-mapping
|
||||||
|
(list (cons #'string (syntax-local-value #'-string))
|
||||||
|
(cons #'bytes (syntax-local-value #'-bytes)))))
|
||||||
|
|
||||||
;; Aliases
|
;; Aliases
|
||||||
(define-syntax id (make-rename-transformer #'identifier))
|
(define-syntax id (make-rename-transformer #'identifier))
|
||||||
(define-syntax nat (make-rename-transformer #'exact-nonnegative-integer))
|
(define-syntax nat (make-rename-transformer #'exact-nonnegative-integer))
|
||||||
(define-syntax char (make-rename-transformer #'character))
|
(define-syntax char (make-rename-transformer #'character))
|
||||||
|
(define-syntax str (make-rename-transformer #'-string))
|
||||||
|
|
||||||
|
|
||||||
;; == Normal syntax classes ==
|
;; == Normal syntax classes ==
|
||||||
|
|
||||||
|
|
|
@ -240,11 +240,17 @@ expressions are duplicated, and may be evaluated in different scopes.
|
||||||
;; otherwise, just a var
|
;; otherwise, just a var
|
||||||
(define stxclass-colon-notation? (make-parameter #t))
|
(define stxclass-colon-notation? (make-parameter #t))
|
||||||
|
|
||||||
|
;; get-stxclass : Identifier -> Stxclass
|
||||||
|
;; Stxclasses are primarily bound by env / syntax-local-value, but a few
|
||||||
|
;; are attached to existing bindings via alt-stxclass-mapping.
|
||||||
|
|
||||||
(define (get-stxclass id)
|
(define (get-stxclass id)
|
||||||
(define config (stxclass-lookup-config))
|
(define config (stxclass-lookup-config))
|
||||||
(if (eq? config 'no)
|
(if (eq? config 'no)
|
||||||
(make-dummy-stxclass id)
|
(make-dummy-stxclass id)
|
||||||
(cond [(syntax-local-value/record id stxclass?) => values]
|
(cond [(syntax-local-value/record id stxclass?) => values]
|
||||||
|
[(assoc id (unbox alt-stxclass-mapping) free-identifier=?)
|
||||||
|
=> cdr]
|
||||||
[(eq? config 'try)
|
[(eq? config 'try)
|
||||||
(make-dummy-stxclass id)]
|
(make-dummy-stxclass id)]
|
||||||
[else (wrong-syntax id "not defined as syntax class")])))
|
[else (wrong-syntax id "not defined as syntax class")])))
|
||||||
|
|
|
@ -11,6 +11,7 @@
|
||||||
(struct-out den:lit)
|
(struct-out den:lit)
|
||||||
(struct-out den:datum-lit)
|
(struct-out den:datum-lit)
|
||||||
(struct-out den:delayed)
|
(struct-out den:delayed)
|
||||||
|
alt-stxclass-mapping
|
||||||
log-syntax-parse-error
|
log-syntax-parse-error
|
||||||
log-syntax-parse-warning
|
log-syntax-parse-warning
|
||||||
log-syntax-parse-info
|
log-syntax-parse-info
|
||||||
|
@ -39,6 +40,11 @@
|
||||||
inline ;; Id/#f, reference to a predicate
|
inline ;; Id/#f, reference to a predicate
|
||||||
) #:prefab)
|
) #:prefab)
|
||||||
|
|
||||||
|
;; alt-stxclass-mapping : (boxof (listof (pair Identifier Stxclass)))
|
||||||
|
;; Maps existing bindings (can't use syntax-local-value mechanism) to stxclasses.
|
||||||
|
;; Uses alist to avoid residual dependence on syntax/id-table.
|
||||||
|
(define alt-stxclass-mapping (box null))
|
||||||
|
|
||||||
;; A scopts is #s(scopts Nat Bool Bool String/#f)
|
;; A scopts is #s(scopts Nat Bool Bool String/#f)
|
||||||
;; These are passed on to var patterns.
|
;; These are passed on to var patterns.
|
||||||
(define-struct scopts
|
(define-struct scopts
|
||||||
|
|
Loading…
Reference in New Issue
Block a user