add define/with-datum

from syntax-objects/Summer2021#21

cc @shhyou

define-with-datum/define-with-datum-test.rkt

@@ -0,0 +1,23 @@
+#lang racket/base
+(module+ test
+  (require rackunit syntax-parse-example/define-with-datum/define-with-datum syntax/datum syntax/macro-testing)
+
+  (define/with-datum (x ((y z ...) ...))
+    '("X" (("Y1" "Z11" "Z12")
+           ("Y2" "Z21"))))
+
+  (check-equal? (datum x) "X")
+
+  (check-equal?
+    (with-datum ([w "W"])
+      (datum ((y w) ...)))
+    '(("Y1" "W") ("Y2" "W")))
+
+  (check-equal?
+    (datum ((^ z ... $) ...))
+    '((^ "Z11" "Z12" $) (^ "Z21" $)))
+
+  (check-exn #rx"x: pattern variable cannot be used outside of a template"
+    (lambda () (convert-compile-time-error x)))
+
+)

define-with-datum/define-with-datum.rkt

@@ -0,0 +1,57 @@
+#lang racket/base
+
+(provide define/with-datum)
+
+(require syntax/parse/define
+         syntax/datum
+         (for-syntax racket/base
+                     racket/syntax
+                     racket/private/sc))
+
+(begin-for-syntax
+  (define-syntax-class (fresh-temporary fresh-stx)
+    #:attributes (fresh-var)
+    (pattern name
+             #:with fresh-var (format-id fresh-stx "~a" (generate-temporary #'name))))
+
+  (define (count-ellipses-depth var...^n)
+    (for/fold ([var...^n var...^n]
+               [depth 0])
+              ([current-depth (in-naturals 1)]
+               #:break (not (pair? var...^n)))
+      (values (car var...^n) current-depth))))
+
+#|
+Source:
+  https://github.com/racket/racket/blob/8e83dc25f7f5767d9e975f20982fdbb82f62415a/racket/collects/racket/syntax.rkt#L22-#L59
+
+  racket/collects/racket/syntax.rktracket/collects/racket/syntax.rkt
+  Commit SHA: 8e83dc25f7f5767
+  Line: 22-59
+|#
+(define-syntax-parse-rule (define/with-datum pattern rhs)
+  #:attr matched-vars (get-match-vars #'define/with-datum
+                                      this-syntax
+                                      #'pattern
+                                      '())
+  #:with (((~var pvar (fresh-temporary #'here)) . depth) ...)
+  (for/list ([x (attribute matched-vars)])
+    (define-values (var depth)
+      (count-ellipses-depth x))
+    (cons var depth))
+
+  (begin
+    (define-values (pvar.fresh-var ...)
+      (with-datum ([pattern rhs])
+        (values (pvar-value pvar) ...)))
+    (define-syntax pvar
+      (make-s-exp-mapping 'depth (quote-syntax pvar.fresh-var)))
+    ...))
+
+;; auxiliary macro
+(define-syntax-parse-rule (pvar-value pvar:id)
+  #:attr mapping (syntax-local-value #'pvar)
+  #:do [(unless (s-exp-pattern-variable? (attribute mapping))
+          (raise-syntax-error #f "not a datum variable" #'pvar))]
+  #:with value-var (s-exp-mapping-valvar (attribute mapping))
+  value-var)

define-with-datum/define-with-datum.scrbl

@@ -0,0 +1,46 @@
+#lang syntax-parse-example
+@require[
+  (for-label racket/base syntax/parse racket/syntax syntax/datum syntax-parse-example/define-with-datum/define-with-datum)]
+
+@(define define-with-datum-eval
+   (make-base-eval '(require syntax/datum syntax-parse-example/define-with-datum/define-with-datum)))
+
+@title{@tt{define/with-datum}}
+
+@; =============================================================================
+
+@defmodule[syntax-parse-example/define-with-datum/define-with-datum]{}
+@stxbee2021["shhyou" 21]
+
+@defform[(define/with-datum pattern datum-expr)]{
+
+  Definition form of @racket[with-datum].
+  Matches the value result of @racket[datum-expr] and binds the pattern variables
+  in @racket[pattern].
+
+  The following example defines three pattern variables:
+  @racket[x] gets bound to a string,
+  @racket[y] (at @tech/syntax{ellipsis depth} 1) gets bound to a list of strings,
+  and @racket[z] (at ellipsis depth 2) gets bound to a list of lists of strings.
+
+  @examples[#:eval define-with-datum-eval
+    (define/with-datum (x ((y z ...) ...))
+      '("X" (("Y1" "Z11" "Z12")
+             ("Y2" "Z21"))))
+    (datum x)
+    (with-datum ([w "W"])
+      (datum ((y w) ...)))
+    (datum ((^ z ... $) ...))
+  ]
+
+  The implementation is similar to that of @racket[define/with-syntax]
+  (@hyperlink["https://github.com/racket/racket/blob/8e83dc25f7f5767d9e975f20982fdbb82f62415a/racket/collects/racket/syntax.rkt#L22-#L59" "link"])
+  but uses @racket[syntax-parse] pattern directives to express the procedural
+  code from the original.
+  These pattern directives allow escaping into arbitrary expansion-time
+  computation while retaining appropriate semantical meanings such as binding a
+  pattern variable (@racket[#:with]) or performing an imperative action (@racket[#:do]).
+
+  @racketfile{define-with-datum.rkt}
+
+}

index.scrbl

@@ -45,3 +45,4 @@
 @include-example{define-freevar}
 @include-example{fnarg}
 @include-example{fresh-variable}
+@include-example{define-with-datum}

render.rkt

@@ -23,6 +23,10 @@
   ;;  where the `....` is the module path for The Racket Reference
   ;; (If the name is too long for you, `rename-in` to something shorter.)
 
+  tech/syntax
+  ;; Usage: @tech/syntax{text}
+  ;;  where `text` refers to a definition from the `syntax` lib.
+
   racketfile
   ;; Usage: @racketfile{filename}
   ;;  where `filename` is a string representing a Racket file
@@ -88,6 +92,9 @@
 (define (tech/reference . text)
   (keyword-apply tech '(#:doc) '((lib "scribblings/reference/reference.scrbl")) text))
 
+(define (tech/syntax . text)
+  (keyword-apply tech '(#:doc) '((lib "syntax/scribblings/syntax.scrbl")) text))
+
 (define (github-user usr)
   (hyperlink (format "https://github.com/~a" usr) (tt usr)))