support more atomic rewriting

redex-doc/redex/scribblings/ref/typesetting.scrbl

@@ -1048,18 +1048,21 @@ The @racket[proc] must match the contract @racket[(-> lw? lw?)].
 Its result should be the rewritten version version of the input.
 }
 
-@defform[(with-atomic-rewriter name-symbol
+@defform[(with-atomic-rewriter atom-name
                                string-or-thunk-returning-pict
                                expression)]{
 
 Extends the current set of atomic-rewriters with one
-new one that rewrites the value of name-symbol to
+new one that rewrites the value of atom-name to
 @racket[string-or-pict-returning-thunk] (applied, in the case of a
 thunk), during the evaluation of expression.
 
-@racket[name-symbol] is expected to evaluate to a symbol. The value
-of @racket[string-or-thunk-returning-pict] is used whenever the symbol
-appears in a pattern.
+ @racket[atom-name] is expected to evaluate to a symbol or
+ string. Note that to rewrite other literals, the string
+ representation of that literal should be used (e.g.
+ @racket["#t"] as the atom-name to rewrite @racket[#t], etc).
+ The value of @racket[string-or-thunk-returning-pict] is used
+ that atom appears in a pattern.
 
 @ex[
   (define-language lam-lang
@@ -1071,7 +1074,7 @@ appears in a pattern.
 ]
 }
 
-@defform[(with-atomic-rewriters ([name-symbol string-or-thunk-returning-pict] ...)
+@defform[(with-atomic-rewriters ([atom-name string-or-thunk-returning-pict] ...)
                                   expression)]{
 Shorthand for nested @racket[with-atomic-rewriter] expressions.
 @history[#:added "1.4"]}

redex-pict-lib/redex/private/core-layout.rkt

@@ -95,7 +95,7 @@
     (syntax-parse stx
       [(_ ([name transformer] ...) e:expr)
        #:declare name
-       (expr/c #'symbol?
+       (expr/c #'(or/c symbol? string?)
                #:name "atomic-rewriter name")
        #:declare transformer
        (expr/c #'(or/c (-> pict?) string?)
@@ -803,7 +803,8 @@
                 (string=? "#:" (substring atom 0 2))))
        (list (make-string-token col span atom (paren-style)))]
       [(string? atom)
-       (list (make-string-token col span atom (default-style)))]
+       (list (or (rewrite-atomic col span atom literal-style)
+                 (make-string-token col span atom (default-style))))]
       [else (error 'atom->tokens "unk ~s" atom)]))
 
   (define (rewrite-atomic col span e get-style)
@@ -818,7 +819,7 @@
     [(assoc e (atomic-rewrite-table))
      =>
      (λ (m)
-       (when (eq? (cadr m) e)
+       (when (equal? (cadr m) e)
          (error 'apply-rewrites "rewritten version of ~s is still ~s" e e))
        (let ([p (cadr m)])
          (if (procedure? p)