added #:datum-literals, like #:literals but for ~datum patterns

collects/syntax/parse/private/litconv.rkt

@@ -14,6 +14,7 @@
   [syntax/parse/private/rep ;; keep abs. path
    (parse-kw-formals
     check-conventions-rules
+    check-datum-literals-list
     create-aux-def)]))
 ;; FIXME: workaround for phase>0 bug in racket/runtime-path (and thus lazy-require)
 ;; Without this, dependencies don't get collected.
@@ -79,6 +80,7 @@
     (raise-syntax-error #f "expected phase-level (exact integer or #f)" ctx stx))
   stx)
 
+;; check-litset-list : stx stx -> (listof (cons id literalset))
 (define-for-syntax (check-litset-list stx ctx)
   (syntax-case stx ()
     [(litset-id ...)
@@ -101,17 +103,23 @@
      (list #'id #'id)]
     [_ (raise-syntax-error #f "expected literal entry" ctx stx)]))
 
-(define-for-syntax (check-duplicate-literals stx imports lits)
+(define-for-syntax (check-duplicate-literals ctx imports lits datum-lits)
   (let ([lit-t (make-hasheq)]) ;; sym => #t
     (define (check+enter! key blame-stx)
       (when (hash-ref lit-t key #f)
-        (raise-syntax-error #f (format "duplicate literal: ~a" key) stx blame-stx))
+        (raise-syntax-error #f (format "duplicate literal: ~a" key) ctx blame-stx))
       (hash-set! lit-t key #t))
     (for ([id+litset (in-list imports)])
       (let ([litset-id (car id+litset)]
             [litset (cdr id+litset)])
         (for ([entry (in-list (literalset-literals litset))])
-          (check+enter! (car entry) litset-id))))
+          (cond [(lse:lit? entry)
+                 (check+enter! (lse:lit-internal entry) litset-id)]
+                [(lse:datum-lit? entry)
+                 (check+enter! (lse:datum-lit-internal entry) litset-id)]))))
+    (for ([datum-lit (in-list datum-lits)])
+      (let ([internal (den:datum-lit-internal datum-lit)])
+        (check+enter! (syntax-e internal) internal)))
     (for ([lit (in-list lits)])
       (check+enter! (syntax-e (car lit)) (car lit)))))
 
@@ -122,6 +130,7 @@
                    (parse-keyword-options
                     #'rest
                     `((#:literal-sets ,check-litset-list)
+                      (#:datum-literals ,check-datum-literals-list)
                       (#:phase ,check-phase-level)
                       (#:for-template)
                       (#:for-syntax)
@@ -136,28 +145,35 @@
                     [(assq '#:for-syntax chunks) 1]
                     [(assq '#:for-label chunks) #f]
                     [else (options-select-value chunks '#:phase #:default 0)])]
+             [datum-lits
+              (options-select-value chunks '#:datum-literals #:default null)]
              [lits (syntax-case rest ()
                      [( (lit ...) )
                       (for/list ([lit (in-list (syntax->list #'(lit ...)))])
                         (check-literal-entry/litset lit stx))]
                      [_ (raise-syntax-error #f "bad syntax" stx)])]
              [imports (options-select-value chunks '#:literal-sets #:default null)])
-         (check-duplicate-literals stx imports lits)
+         (check-duplicate-literals stx imports lits datum-lits)
          (with-syntax ([((internal external) ...) lits]
+                       [(datum-internal ...) (map den:datum-lit-internal datum-lits)]
+                       [(datum-external ...) (map den:datum-lit-external datum-lits)]
                        [(litset-id ...) (map car imports)]
                        [relphase relphase])
            #`(begin
                (define phase-of-literals
-                 (if 'relphase
+                 (and 'relphase
-                     (+ (phase-of-enclosing-module) 'relphase)
+                      (+ (variable-reference->module-base-phase (#%variable-reference))
-                     'relphase))
+                         'relphase)))
                (define-syntax name
                  (make-literalset
                   (append (literalset-literals (syntax-local-value (quote-syntax litset-id)))
                           ...
-                          (list (list 'internal
+                          (list (make-lse:lit 'internal
                                               (quote-syntax external)
                                               (quote-syntax phase-of-literals))
+                                ...
+                                (make-lse:datum-lit 'datum-internal
+                                                    'datum-external)
                                 ...))))
                (begin-for-syntax/once
                 (for ([x (in-list (syntax->list #'(external ...)))])
@@ -174,26 +190,42 @@
                                         (quote-syntax #,stx) x))))))))]))
 
 #|
-Literal sets: The goal is for literals to refer to their bindings at
+NOTES ON PHASES AND BINDINGS
 
-  phase 0 relative to the enclosing module
+(module M ....
+  .... (define-literal-set LS #:phase PL ....)
+  ....)
 
-Use cases, explained:
+For the expansion of the define-literal-set form, the bindings of the literals
-1) module X with def-lit-set is required-for-syntax
+can be accessed by (identifier-binding lit PL), because the phase of the enclosing
-     phase-of-mod-inst = 1
+module (M) is 0.
-     phase-of-def = 0
+
-     literals looked up at abs phase 1
+LS may be used, however, in a context where the phase of the enclosing
-       which is phase 0 rel to module X
+module is not 0, so each instantiation of LS needs to calculate the
-2) module X with local def-lit-set within define-syntax
+phase of M and add that to PL.
-     phase-of-mod-inst = 1 (mod at 0, but +1 within define-syntax)
+
-     phase-of-def = 1
+--
-     literals looked up at abs phase 0
+
-       which is phase 0 rel to module X
+Normally, literal sets that define the same name conflict. But it
-3) module X with def-lit-set in phase-2 position (really uncommon case!)
+would be nice to allow them to both be imported in the case where they
-     phase-of-mod-inst = 1 (not 2, apparently)
+refer to the same binding.
-     phase-of-def = 2
+
-     literals looked up at abs phase 0
+Problem: Can't do the check eagerly, because the binding of L may
-       (that's why the weird (if (z?) 0 1) term)
+change between when define-literal-set is compiled and the comparison
+involving L. For example:
+
+  (module M racket
+    (require syntax/parse)
+    (define-literal-set LS (lambda))
+    (require (only-in some-other-lang lambda))
+    .... LS ....)
+
+The expansion of the LS definition sees a different lambda than the
+one that the literal in LS actually refers to.
+
+Similarly, a literal in LS might not be defined when the expander
+runs, but might get defined later. (Although I think that will already
+cause an error, so don't worry about that case.)
 |#
 
 ;; FIXME: keep one copy of each identifier (?)
@@ -205,7 +237,10 @@ Use cases, explained:
                      (syntax-local-value/record #'litset-id literalset?))])
        (unless val (raise-syntax-error #f "expected literal set name" stx #'litset-id))
        (let ([lits (literalset-literals val)])
-         (with-syntax ([((_sym lit phase-var) ...) lits])
+         (with-syntax ([((lit phase-var) ...)
+                        (for/list ([lit (in-list lits)]
+                                   #:when (lse:lit? lit))
+                          (list (lse:lit-external lit) (lse:lit-phase lit)))])
            #'(make-literal-set-predicate (list (list (quote-syntax lit) phase-var) ...)))))]))
 
 (define (make-literal-set-predicate lits)

collects/syntax/parse/private/rep-data.rkt

@@ -72,6 +72,7 @@ DeclEnv =
 
 DeclEntry =
   (den:lit id id ct-phase ct-phase)
+  (den:datum-lit id symbol)
   (den:class id id Arguments)
   (den:magic-class id id Arguments stx)
   (den:parser id (listof SAttr) bool bool bool)
@@ -82,6 +83,7 @@ Arguments is defined in rep-patterns.rkt
 A DeclEnv is built up in stages:
   1) syntax-parse (or define-syntax-class) directives
      #:literals -> den:lit
+     #:datum-literals -> den:datum-lit
      #:local-conventions -> den:class
      #:conventions -> den:delayed
      #:literal-sets -> den:lit
@@ -101,20 +103,22 @@ expressions are duplicated, and may be evaluated in different scopes.
 
 (define-struct declenv (table conventions))
 
-(define-struct den:lit (internal external input-phase lit-phase))
 (define-struct den:class (name class argu))
 (define-struct den:magic-class (name class argu role))
 (define-struct den:parser (parser attrs splicing? commit? delimit-cut?))
-;; and from residual.rkt: (define-struct den:delayed (parser class))
+;; and from residual.rkt:
+;;  (define-struct den:lit (internal external input-phase lit-phase))
+;;  (define-struct den:datum-lit (internal external))
+;;  (define-struct den:delayed (parser class))
 
 (define (new-declenv literals #:conventions [conventions null])
-  (make-declenv
+  (let* ([table (make-immutable-bound-id-table)]
-   (for/fold ([table (make-immutable-bound-id-table)])
+         [table (for/fold ([table table]) ([literal (in-list literals)])
-       ([literal (in-list literals)])
+                  (let ([id (cond [(den:lit? literal) (den:lit-internal literal)]
-     (bound-id-table-set table (car literal)
+                                  [(den:datum-lit? literal) (den:datum-lit-internal literal)])])
-                         (make den:lit (first literal) (second literal)
+                    ;;(eprintf ">> added ~e\n" id)
-                               (third literal) (fourth literal))))
+                    (bound-id-table-set table id literal)))])
-   conventions))
+    (make-declenv table conventions)))
 
 (define (declenv-lookup env id #:use-conventions? [use-conventions? #t])
   (or (bound-id-table-ref (declenv-table env) id #f)
@@ -129,6 +133,8 @@ expressions are duplicated, and may be evaluated in different scopes.
     (match val
       [(den:lit _i _e _ip _lp)
        (wrong-syntax id "identifier previously declared as literal")]
+      [(den:datum-lit _i _e)
+       (wrong-syntax id "identifier previously declared as literal")]
       [(den:magic-class name _c _a _r)
        (if (and blame-declare? stxclass-name)
            (wrong-syntax name
@@ -191,7 +197,7 @@ expressions are duplicated, and may be evaluated in different scopes.
 (define DeclEnv/c declenv?)
 
 (define DeclEntry/c 
-  (or/c den:lit? den:class? den:magic-class? den:parser? den:delayed?))
+  (or/c den:lit? den:datum-lit? den:class? den:magic-class? den:parser? den:delayed?))
 
 (define SideClause/c
   (or/c clause:fail? clause:with? clause:attr? clause:do?))
@@ -200,11 +206,12 @@ expressions are duplicated, and may be evaluated in different scopes.
 ;;   usually = #'(syntax-local-phase-level)
 (define ct-phase/c syntax?)
 
-(provide (struct-out den:lit)
+(provide (struct-out den:class)
-         (struct-out den:class)
          (struct-out den:magic-class)
          (struct-out den:parser)
          ;; from residual.rkt:
+         (struct-out den:lit)
+         (struct-out den:datum-lit)
          (struct-out den:delayed))
 
 (provide/contract
@@ -218,7 +225,7 @@ expressions are duplicated, and may be evaluated in different scopes.
  [stxclass-colon-notation? (parameter/c boolean?)]
 
  [new-declenv
-  (->* [(listof (list/c identifier? identifier? ct-phase/c ct-phase/c))]
+  (->* [(listof (or/c den:lit? den:datum-lit?))]
        [#:conventions list?]
        DeclEnv/c)]
  [declenv-lookup

collects/syntax/parse/private/rep.rkt

@@ -4,6 +4,7 @@
                        syntax/parse/private/keywords
                        syntax/parse/private/residual ;; keep abs. path
                        syntax/parse/private/runtime)
+         racket/list
          racket/contract/base
          "minimatch.rkt"
          syntax/private/id-table
@@ -61,6 +62,9 @@
  [check-conventions-rules
   (-> syntax? syntax?
       (listof (list/c regexp? any/c)))]
+ [check-datum-literals-list
+  (-> syntax? syntax?
+      (listof den:datum-lit?))]
  [check-attr-arity-list
   (-> syntax? syntax?
       (listof sattr?))])
@@ -220,11 +224,12 @@
 ;; get-decls : chunks -> (values DeclEnv (listof syntax))
 (define (get-decls chunks strict?)
   (define lits (options-select-value chunks '#:literals #:default null))
+  (define datum-lits (options-select-value chunks '#:datum-literals #:default null))
   (define litsets (options-select-value chunks '#:literal-sets #:default null))
   (define convs (options-select-value chunks '#:conventions #:default null))
   (define localconvs (options-select-value chunks '#:local-conventions #:default null))
   (define literals
-    (append-lits+litsets lits litsets))
+    (append/check-lits+litsets lits datum-lits litsets))
   (define-values (convs-rules convs-defs)
     (for/fold ([convs-rules null] [convs-defs null])
         ([conv-entry (in-list convs)])
@@ -260,6 +265,8 @@
   (match entry
     [(den:lit _i _e _ip _lp)
      (values entry null)]
+    [(den:datum-lit _i _e)
+     (values entry null)]
     [(den:magic-class name class argu role)
      (values entry null)]
     [(den:class name class argu)
@@ -288,14 +295,39 @@
     [(den:delayed _p _c)
      (values entry null)]))
 
-(define (append-lits+litsets lits litsets)
+;; append/check-lits+litsets : .... -> (listof (U den:lit den:datum-lit))
-  (define seen (make-bound-id-table lits))
+(define (append/check-lits+litsets lits datum-lits litsets)
-  (for ([litset (in-list litsets)])
+  (define seen (make-bound-id-table))
-    (for ([lit (in-list litset)])
+  (define (check-id id [blame-ctx id])
-      (when (bound-id-table-ref seen (car lit) #f)
+    (if (bound-id-table-ref seen id #f)
-        (wrong-syntax (car lit) "duplicate literal declaration"))
+        (wrong-syntax blame-ctx "duplicate literal declaration: ~s" (syntax-e id))
-      (bound-id-table-set! seen (car lit) #t)))
+        (bound-id-table-set! seen id #t))
-  (apply append lits litsets))
+    id)
+  (let* ([litsets*
+          (for/list ([entry (in-list litsets)])
+            (let ([litset-id (first entry)]
+                  [litset (second entry)]
+                  [lctx (third entry)]
+                  [input-phase (fourth entry)])
+              (define (get/check-id sym)
+                (check-id (datum->syntax lctx sym) litset-id))
+              (for/list ([lse (in-list (literalset-literals litset))])
+                (match lse
+                  [(lse:lit internal external lit-phase)
+                   (let ([internal (get/check-id internal)])
+                     (make den:lit internal external input-phase lit-phase))]
+                  [(lse:datum-lit internal external)
+                   (let ([internal (get/check-id internal)])
+                     (make den:datum-lit internal external))]))))]
+         [lits*
+          (for/list ([lit (in-list lits)])
+            (check-id (den:lit-internal lit))
+            lit)]
+         [datum-lits*
+          (for/list ([datum-lit (in-list datum-lits)])
+            (check-id (den:datum-lit-internal datum-lit))
+            datum-lit)])
+    (apply append lits* datum-lits* litsets*)))
 
 ;; parse-variant : stx boolean DeclEnv #f/(listof Sattr) -> RHS
 (define (parse-variant stx splicing? decls0 expected-attrs)
@@ -609,6 +641,8 @@
   (match entry
     [(den:lit internal literal input-phase lit-phase)
      (create-pat:literal literal input-phase lit-phase)]
+    [(den:datum-lit internal sym)
+     (create-pat:datum sym)]
     [(den:magic-class name class argu role)
      (let* ([pos-count (length (arguments-pargs argu))]
             [kws (arguments-kws argu)]
@@ -1222,24 +1256,20 @@
     [_
      (raise-syntax-error #f "expected attribute name with optional depth declaration" ctx stx)]))
 
-;; check-literals-list : stx stx -> (listof (list id id ct-phase ct-phase))
+;; check-literals-list : stx stx -> (listof den:lit)
 ;;  - txlifts defs of phase expressions
 ;;  - txlifts checks that literals are bound
 (define (check-literals-list stx ctx)
   (unless (stx-list? stx)
     (raise-syntax-error #f "expected literals list" ctx stx))
-  (let ([lits
   (for/list ([x (in-list (stx->list stx))])
-           (check-literal-entry x ctx))])
+    (check-literal-entry x ctx)))
-    (let ([dup (check-duplicate-identifier (map car lits))])
-      (when dup (raise-syntax-error #f "duplicate literal identifier" ctx dup)))
-    lits))
 
-;; check-literal-entry : stx stx -> (list id id ct-phase ct-phase)
+;; check-literal-entry : stx stx -> den:lit
 (define (check-literal-entry stx ctx)
   (define (go internal external phase)
     (txlift #`(check-literal #,external #,phase #,ctx))
-    (list internal external phase phase))
+    (make den:lit internal external phase phase))
   (syntax-case stx ()
     [(internal external #:phase phase)
      (and (identifier? #'internal) (identifier? #'external))
@@ -1251,32 +1281,44 @@
      (identifier? #'id)
      (go #'id #'id #'(syntax-local-phase-level))]
     [_
-     (raise-syntax-error #f "expected literal entry"
+     (raise-syntax-error #f "expected literal entry" ctx stx)]))
-                         ctx stx)]))
+
+;; check-datum-literals-list : stx stx -> (listof den:datum-lit)
+(define (check-datum-literals-list stx ctx)
+  (unless (stx-list? stx)
+    (raise-syntax-error #f "expected datum-literals list" ctx stx))
+  (for/list ([x (in-list (stx->list stx))])
+    (check-datum-literal-entry x ctx)))
+
+;; check-datum-literal-entry : stx stx -> den:datum-lit
+(define (check-datum-literal-entry stx ctx)
+  (syntax-case stx ()
+    [(internal external)
+     (and (identifier? #'internal) (identifier? #'external))
+     (make den:datum-lit #'internal (syntax-e #'external))]
+    [id
+     (identifier? #'id)
+     (make den:datum-lit #'id (syntax-e #'id))]
+    [_
+     (raise-syntax-error #f "expected datum-literal entry" ctx stx)]))
 
 ;; Literal sets - Import
 
-;; check-literal-sets-list : stx stx -> (listof (listof (list id id ct-phase^2)))
+;; check-literal-sets-list : stx stx -> (listof (list id literalset stx stx))
 (define (check-literal-sets-list stx ctx)
   (unless (stx-list? stx)
     (raise-syntax-error #f "expected literal-set list" ctx stx))
   (for/list ([x (in-list (stx->list stx))])
     (check-literal-set-entry x ctx)))
 
-;; check-literal-set-entry : stx stx -> (listof (list id id ct-phase^2))
+;; check-literal-set-entry : stx stx -> (list id literalset stx stx)
 (define (check-literal-set-entry stx ctx)
   (define (elaborate litset-id lctx phase)
     (let ([litset (syntax-local-value/record litset-id literalset?)])
       (unless litset
         (raise-syntax-error #f "expected identifier defined as a literal-set"
                             ctx litset-id))
-      (elaborate2 litset lctx phase)))
+      (list litset-id litset lctx phase)))
-  (define (elaborate2 litset lctx phase)
-    (for/list ([entry (in-list (literalset-literals litset))])
-      (list (datum->syntax lctx (car entry) stx)
-            (cadr entry)
-            phase
-            (caddr entry))))
   (syntax-case stx ()
     [(litset . more)
      (and (identifier? #'litset))
@@ -1483,6 +1525,7 @@
 (define common-parse-directive-table
   (list (list '#:disable-colon-notation)
         (list '#:literals check-literals-list)
+        (list '#:datum-literals check-datum-literals-list)
         (list '#:literal-sets check-literal-sets-list)
         (list '#:conventions check-conventions-list)
         (list '#:local-conventions check-conventions-rules)))

collects/syntax/parse/private/residual-ct.rkt

@@ -5,8 +5,12 @@
          (struct-out integrate)
          (struct-out conventions)
          (struct-out literalset)
+         (struct-out lse:lit)
+         (struct-out lse:datum-lit)
          (struct-out eh-alternative-set)
          (struct-out eh-alternative)
+         (struct-out den:lit)
+         (struct-out den:datum-lit)
          (struct-out den:delayed))
 
 ;; == from rep-attr.rkt
@@ -38,9 +42,14 @@ A ConventionRule is (list regexp DeclEntry)
 
 #|
 A LiteralSet is
- (make-literalset (listof (list symbol id phase-var-id)))
+ (make-literalset (listof LiteralSetEntry))
+An LiteralSetEntry is one of
+ - (make-lse:lit symbol id ct-phase)
+ - (make-lse:datum-lit symbol symbol)
 |#
 (define-struct literalset (literals) #:transparent)
+(define-struct lse:lit (internal external phase) #:transparent)
+(define-struct lse:datum-lit (internal external) #:transparent)
 
 #|
 An EH-alternative-set is
@@ -51,4 +60,6 @@ An EH-alternative is
 (define-struct eh-alternative-set (alts))
 (define-struct eh-alternative (repc attrs parser))
 
+(define-struct den:lit (internal external input-phase lit-phase) #:transparent)
+(define-struct den:datum-lit (internal external) #:transparent)
 (define-struct den:delayed (parser class))

collects/syntax/scribblings/parse/litconv.scrbl

@@ -15,7 +15,8 @@ As a remedy, @racketmodname[syntax/parse] offers @deftech{literal
 sets}. A literal set is defined via @racket[define-literal-set] and
 used via the @racket[#:literal-set] option of @racket[syntax-parse].
 
-@defform/subs[(define-literal-set id maybe-phase maybe-imports (literal ...))
+@defform/subs[(define-literal-set id maybe-phase maybe-imports maybe-datum-literals
+                (literal ...))
               ([literal literal-id
                         (pattern-id literal-id)]
                [maybe-phase (code:line)
@@ -23,6 +24,8 @@ used via the @racket[#:literal-set] option of @racket[syntax-parse].
                             (code:line #:for-syntax)
                             (code:line #:for-label)
                             (code:line #:phase phase-level)]
+               [maybe-datum-literals (code:line)
+                                     (code:line #:datum-literals (datum-literal ...))]
                [maybe-imports (code:line)
                               (code:line #:literal-sets (imported-litset-id ...))])]{
 

collects/syntax/scribblings/parse/parsing.scrbl

@@ -23,6 +23,7 @@ Two parsing forms are provided: @racket[syntax-parse] and
 @defform/subs[(syntax-parse stx-expr parse-option ... clause ...+)
               ([parse-option (code:line #:context context-expr)
                              (code:line #:literals (literal ...))
+                             (code:line #:datum-literals (datum-literal ...))
                              (code:line #:literal-sets (literal-set ...))
                              (code:line #:conventions (convention-id ...))
                              (code:line #:local-conventions (convention-rule ...))
@@ -30,6 +31,8 @@ Two parsing forms are provided: @racket[syntax-parse] and
                [literal literal-id
                         (pattern-id literal-id)
                         (pattern-id literal-id #:phase phase-expr)]
+               [datum-literal literal-id
+                              (pattern-id literal-id)]
                [literal-set literal-set-id
                             (literal-set-id literal-set-option ...)]
                [literal-set-option (code:line #:at context-id)
@@ -76,10 +79,12 @@ failures; otherwise @racket[stx-expr] is used. The
                             (pattern-id literal-id)
                             (pattern-id literal-id #:phase phase-expr)])
                   #:contracts ([phase-expr (or/c exact-integer? #f)])]{
+
 @margin-note*{
   Unlike @racket[syntax-case], @racket[syntax-parse] requires all
   literals to have a binding. To match identifiers by their symbolic
-  names, use the @racket[~datum] pattern form instead.
+  names, use @racket[#:datum-literals] or the @racket[~datum] pattern
+  form instead.
 }
 @;
 The @racket[#:literals] option specifies identifiers that should be
@@ -94,6 +99,23 @@ If the @racket[#:phase] option is given, then the literal is compared
 at phase @racket[phase-expr]. Specifically, the binding of the
 @racket[literal-id] at phase @racket[phase-expr] must match the
 input's binding at phase @racket[phase-expr].
+
+In other words, the @racket[syntax-pattern]s are interpreted as if each
+occurrence of @racket[pattern-id] were replaced with the following pattern:
+@racketblock[(~literal literal-id #:phase phase-expr)]
+}
+
+@specsubform/subs[(code:line #:datum-literals (datum-literal ...))
+                  ([datum-literal literal-id
+                                  (pattern-id literal-id)])]{
+
+Like @racket[#:literals], but the literals are matched as symbols
+instead of as identifiers.
+
+In other words, the @racket[syntax-pattern]s are interpreted as if each
+occurrence of @racket[pattern-id] were replaced with the following
+pattern:
+@racketblock[(~datum literal-id)]
 }
 
 @specsubform/subs[(code:line #:literal-sets (literal-set ...))

collects/syntax/scribblings/parse/patterns.scrbl

@@ -40,7 +40,7 @@ means specifically @tech{@Spattern}.
                  (@#,ref[~var s-] id)
                  (@#,ref[~var s+] id syntax-class-id maybe-role)
                  (@#,ref[~var s+] id (syntax-class-id arg ...) maybe-role)
-                 (~literal literal-id)
+                 (~literal literal-id maybe-phase)
                  atomic-datum
                  (~datum datum)
                  (H-pattern . S-pattern)
@@ -298,7 +298,9 @@ combined with the syntax class's description in error messages.
 ]
 }
 
-@specsubform[(@#,defhere[~literal] literal-id)]{
+@specsubform/subs[(@#,defhere[~literal] literal-id maybe-phase)
+                  ([maybe-phase (code:line)
+                                (code:line #:phase phase-expr)])]{
 
 A @deftech{literal} identifier pattern. Matches any identifier
 @racket[free-identifier=?] to @racket[literal-id].
@@ -309,6 +311,10 @@ A @deftech{literal} identifier pattern. Matches any identifier
 (syntax-parse #'(lambda x 12)
   [((~literal define) var:id body:expr) 'ok])
 ]
+
+The identifiers are compared at the phase given by
+@racket[phase-expr], if it is given, or
+@racket[(syntax-local-phase-level)] otherwise.
 }
 
 @specsubform[atomic-datum]{

collects/syntax/scribblings/parse/stxclasses.scrbl

@@ -29,6 +29,7 @@ structures can share syntax class definitions.
                  (code:line #:commit)
                  (code:line #:no-delimit-cut)
                  (code:line #:literals (literal-entry ...))
+                 (code:line #:datum-literals (datum-literal-entry ...))
                  (code:line #:literal-sets (literal-set ...))
                  (code:line #:conventions (convention-id ...))
                  (code:line #:local-conventions (convention-rule ...))
@@ -107,7 +108,8 @@ It is an error to use both @racket[#:commit] and
 @racket[#:no-delimit-cut].
 }
 
-@specsubform[(code:line #:literals (literal-entry))]
+@specsubform[(code:line #:literals (literal-entry ...))]
+@specsubform[(code:line #:datum-literals (datum-literal-entry ...))]
 @specsubform[(code:line #:literal-sets (literal-set ...))]
 @specsubform[(code:line #:conventions (convention-id ...))]{
 

collects/tests/stxparse/test-litset.rkt

@@ -97,6 +97,18 @@
     (go #'begin #f)
     (void)))
 
+;; Litsets with datum-lits
+
+(test-case "litset, datum-lits"
+  (let ([one 1])
+    (define-literal-set lits-d #:datum-literals (one two) ())
+    (syntax-parse #'one #:literal-sets (lits-d)
+                  [one (void)])
+    (let ([one 2])
+      (syntax-parse #'one #:literal-sets (lits-d) [one (void)]))))
+
+;; literal-set->predicate
+
 (require (for-label '#%kernel))
 
 (test-case "litset->pred"

collects/tests/stxparse/test.rkt

@@ -79,6 +79,14 @@
              [+ (void)]
              [_ (error 'wrong)]))
 
+(test-case "datum literals"
+  (syntax-parse #'one #:datum-literals (one)
+    [one (void)]))
+(test-case "datum literals (not id=?)"
+  (let ([one 1])
+    (syntax-parse (let ([one 2]) #'one) #:datum-literals (one)
+      [one (void)])))
+
 ;; compound patterns
 (tok (a b c) (x y z)
      (and (bound (x 0) (y 0) (z 0)) (s= x 'a) (s= y 'b))