diff --git a/define-with-datum/define-with-datum-test.rkt b/define-with-datum/define-with-datum-test.rkt
new file mode 100644
index 0000000..fda63ba
--- /dev/null
+++ b/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)))
+
+)
diff --git a/define-with-datum/define-with-datum.rkt b/define-with-datum/define-with-datum.rkt
new file mode 100644
index 0000000..d47191f
--- /dev/null
+++ b/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)
diff --git a/define-with-datum/define-with-datum.scrbl b/define-with-datum/define-with-datum.scrbl
new file mode 100644
index 0000000..f01feac
--- /dev/null
+++ b/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}
+
+}
diff --git a/index.scrbl b/index.scrbl
index a5ad43b..700c7a7 100644
--- a/index.scrbl
+++ b/index.scrbl
@@ -45,3 +45,4 @@
@include-example{define-freevar}
@include-example{fnarg}
@include-example{fresh-variable}
+@include-example{define-with-datum}
diff --git a/render.rkt b/render.rkt
index 5263317..e154fb0 100644
--- a/render.rkt
+++ b/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)))
pFad - Phonifier reborn
Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.
Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.
Alternative Proxies:
Alternative Proxy
pFad Proxy
pFad v3 Proxy
pFad v4 Proxy