Disarming Syntax Objects Before Parsing in syntax/parse

syntax-parse-disarm.rkt

#|
By: @ryanc
From: https://racket.slack.com/archives/C06V96CKX/p1583783757431900?thread_ts=1583782250.431100&cid=C06V96CKX
In thread: https://racket.slack.com/archives/C06V96CKX/p1583782250431100

sorawee Today at 2:30 PM
Question (particularly for @ryanc I think): is there a way to make `syntax-parse`
works nicely with `syntax-disarm`? I’m trying to do something similar to
errortrace which needs to disarm/rearm syntax object for each depth
(https://github.com/racket/errortrace/blob/master/errortrace-lib/errortrace/stacktrace.rkt#L385).
If I attempt to do any more complex pattern matching, the result will be tainted.

ryanc  2 hours ago
Here's a pattern form that disarms the current term and then matches it against
the given subpattern. In the `simplify` macro below, if you remove the `~disarm`
wrapper, you should get a tainted identifier error, but with `~disarm` it works.
|#

#lang racket/base
(require (for-syntax racket/base syntax/parse))(begin-for-syntax
  (require (for-syntax racket/base))  ;; S-pattern ::= ... | (~disarm S-pattern)
  ;; The pattern (~disarm p) matches a term t if p matches the term
  ;; after being disarmed with syntax-disarm.
  (define-syntax ~disarm
    (pattern-expander
     (lambda (stx)
       (syntax-case stx ()
         [(_ pattern)
          #'(~and x (~parse pattern (syntax-disarm #'x #f)))])))))(define-syntax thunk
  (syntax-parser
    [(_ e) (syntax-protect #'(lambda () e))]))(define-syntax simplify
  (syntax-parser
    [(_ e)
     (define ee (local-expand #'e 'expression null))
     (syntax-parse ee
       #:literal-sets (kernel-literals)
       [(let-values ([(x:id) (~disarm (#%plain-lambda () e:expr))])
          (#%plain-app y:id))
        #:when (free-identifier=? #'x #'y)
        (eprintf "simplifying to ~e\n" (syntax->datum #'e))
        #'e]
       [e
        (eprintf "could not simplify\n")
        #'e])]))(simplify (let ([t (thunk (+ 1 2))]) (t)))