diff --git a/pkgs/racket-pkgs/racket-doc/syntax/scribblings/parse/patterns.scrbl b/pkgs/racket-pkgs/racket-doc/syntax/scribblings/parse/patterns.scrbl index 7d447e1728..510c1d4c10 100644 --- a/pkgs/racket-pkgs/racket-doc/syntax/scribblings/parse/patterns.scrbl +++ b/pkgs/racket-pkgs/racket-doc/syntax/scribblings/parse/patterns.scrbl @@ -36,6 +36,7 @@ means specifically @tech{@Spattern}. [S-pattern pvar-id pvar-id:syntax-class-id + pvar-id:literal-id literal-id (@#,ref[~var s-] id) (@#,ref[~var s+] id syntax-class-id maybe-role) @@ -241,6 +242,18 @@ An identifier can be either a @tech{pattern variable}, an @svar[pvar-id]. } +@item{If @racket[id] is of the form @racket[_pvar-id:literal-id], + where @racket[_literal-id] is in the literals list, then it is + equivalent to @racket[(~and (~var _pvar-id) literal-id)]. + + @myexamples[ + (require (only-in racket/base [define def])) + (syntax-parse #'(def x 7) + #:literals (define) + [(d:define var:id body:expr) #'d]) + ] +} + @item{Otherwise, @racket[id] is a @tech{pattern variable}, and the pattern is equivalent to @racket[(~var id)]. } diff --git a/racket/collects/syntax/parse/private/rep-data.rkt b/racket/collects/syntax/parse/private/rep-data.rkt index 6fabc47a0d..8b9b449bdc 100644 --- a/racket/collects/syntax/parse/private/rep-data.rkt +++ b/racket/collects/syntax/parse/private/rep-data.rkt @@ -252,7 +252,7 @@ expressions are duplicated, and may be evaluated in different scopes. stxclass?)] [split-id/get-stxclass (-> identifier? DeclEnv/c - (values identifier? (or/c stxclass? #f)))]) + (values identifier? (or/c stxclass? den:lit? den:datum-lit? #f)))]) ;; stxclass-lookup-config : (parameterof (U 'no 'try 'yes)) ;; 'no means don't lookup, always use dummy (no nested attrs) @@ -288,12 +288,16 @@ expressions are duplicated, and may be evaluated in different scopes. => (lambda (m) (define id (datum->syntax id0 (string->symbol (cadr m)) id0 id0)) - (define scname + (define suffix (datum->syntax id0 (string->symbol (caddr m)) id0 id0)) - (declenv-check-unbound decls id (syntax-e scname) + (declenv-check-unbound decls id (syntax-e suffix) #:blame-declare? #t) - (let ([sc (get-stxclass/check-arity scname id0 0 null)]) - (values id sc)))] + (let ([suffix-entry (declenv-lookup decls suffix)]) + (cond [(or (den:lit? suffix-entry) (den:datum-lit? suffix-entry)) + (values id suffix-entry)] + [else + (let ([sc (get-stxclass/check-arity suffix id0 0 null)]) + (values id sc))])))] [else (values id0 #f)])) ;; ---- diff --git a/racket/collects/syntax/parse/private/rep.rkt b/racket/collects/syntax/parse/private/rep.rkt index b10c93a998..b2a651b4e7 100644 --- a/racket/collects/syntax/parse/private/rep.rkt +++ b/racket/collects/syntax/parse/private/rep.rkt @@ -686,9 +686,14 @@ [(not (safe-name? id)) (wrong-syntax id "expected identifier not starting with ~~ character")] [else - (let-values ([(name sc) (split-id/get-stxclass id decls)]) - (cond [sc - (parse-pat:var* id allow-head? name sc no-arguments "." #f #f)] + (let-values ([(name suffix) (split-id/get-stxclass id decls)]) + (cond [(stxclass? suffix) + (parse-pat:var* id allow-head? name suffix no-arguments "." #f #f)] + [(or (den:lit? suffix) (den:datum-lit? suffix)) + (create-pat:and + (list + (create-pat:var name #f no-arguments null #f #t #f) + (parse-pat:id/entry id decls allow-head? suffix)))] [(declenv-apply-conventions decls id) => (lambda (entry) (parse-pat:id/entry id decls allow-head? entry))] [else (create-pat:var name #f no-arguments null #f #t #f)]))]))