Add an generic quasiquote to data/collection/experimental/quasi

Author: lexi-lambda

collections-doc/scribblings/data/collection/collection/experimental.scrbl

@@ -0,0 +1,57 @@
+#lang scribble/manual
+
+@(require
+   racket/require
+   (for-label (subtract-in
+               (combine-in
+                racket/base
+                racket/list
+                racket/set
+                racket/dict
+                racket/math)
+               data/collection)
+              (prefix-in base: racket/base)
+              data/collection
+              racket/function
+              racket/generic
+              racket/contract
+              racket/stream
+              racket/string
+              racket/match
+              racket/generator)
+   scribble/core
+   "../private/utils.rkt")
+
+@(module racket-forms racket/base
+   (require (for-label racket/base)
+            scribble/manual)
+   (provide racket:quasiquote)
+   (define racket:quasiquote
+     (racket quasiquote)))
+@(require 'racket-forms)
+
+@title[#:tag "experimental"]{Experimental Forms and Functions}
+
+@(define (yellow . content)
+   (make-element (make-style #f (list (make-background-color-property "yellow"))) content))
+
+@nested[#:style 'inset]{
+ @yellow{@bold{WARNING}}: The following forms and functions are @emph{experimental}; compatibility
+         will not be maintained.}
+
+@section{Generic Quasiquotation}
+
+@defmodule[data/collection/experimental/quasi]
+
+@defform[(quasiquote datum)]{
+Equivalent to @racket:quasiquote from @racketmodname[racket/base], except that uses of
+@racket[unquote-splicing] accept arbitrary @racket[sequence?] values instead of only lists.
+
+Note that this handling only applies to uses of @racket[unquote-splicing], not @racket[unquote], so
+@racket[`(1 @#,racketvalfont{.} ,_more)] will produce different results from @racket[`(1 ,@_more)]
+when @racket[_more] is a non-list sequence.
+
+@(coll-examples
+  `(1 2 ,(+ 1 2))
+  `(Z = ,@(take 5 (naturals)) ...)
+  `#s(prefab i ,@#(ii iii iv) v))}

collections-doc/scribblings/data/collection/collection/reference.scrbl

@@ -19,7 +19,6 @@
               racket/string
               racket/match
               racket/generator)
-   scribble/eval
    "../private/utils.rkt")
 
 @title[#:tag "collections-api"]{API Documentation}

collections-doc/scribblings/data/collection/collections.scrbl

@@ -1,7 +1,6 @@
 #lang scribble/manual
 
-@(require
-   "private/utils.rkt")
+@(require "private/utils.rkt")
 
 @title{Generic Collections}
 
@@ -20,4 +19,5 @@ this reason, this @emph{may} not be a drop-in replacement for existing code.
 
 @include-section["collection/introduction.scrbl"]
 @include-section["collection/examples.scrbl"]
-@include-section["collection/reference.scrbl"]
+@include-section["collection/reference.scrbl"]
+@include-section["collection/experimental.scrbl"]

collections-doc/scribblings/data/collection/private/utils.rkt

@@ -18,6 +18,7 @@
    #:lang 'racket
    '(racket/generic
      data/collection
+     data/collection/experimental/quasi
      racket/generator)))
 
 (define-syntax-rule (coll-interaction . body)

collections-lib/data/collection/experimental/quasi.rkt

@@ -0,0 +1,57 @@
+#lang racket/base
+
+(require (for-syntax racket/base)
+         data/collection
+         syntax/parse/define
+         (only-in racket/base [cons pair]))
+
+(provide quasiquote unquote unquote-splicing)
+
+(begin-for-syntax
+  (define-syntax-class qqed
+    #:attributes [expr]
+    #:description #f
+    #:literals [unquote]
+    [pattern (uq:unquote ~! e:expr)
+             #:attr expr (syntax-property #'e
+                                          'disappeared-use
+                                          (syntax-local-introduce #'uq))]
+    [pattern x
+             #:attr expr #'(quasiquote x)])
+
+  (define-syntax-class qqed/splicing
+    #:attributes [expr]
+    #:description #f
+    #:literals [unquote-splicing]
+    [pattern (uqs:unquote-splicing ~! e)
+             #:declare e (expr/c #'sequence?
+                                 #:macro 'unquote-splicing
+                                 #:name "argument")
+             #:attr expr (syntax-property #'e.c
+                                          'disappeared-use
+                                          (syntax-local-introduce #'uqs))]
+    [pattern e:qqed
+             #:attr expr #`(list #,(attribute e.expr))]))
+
+(define-syntax-parser quasiquote
+  [(_ (x:qqed/splicing ...))
+   #'(sequence->list (append x.expr ...))]
+  [(_ #(x:qqed/splicing ...))
+   #'(extend #() (append x.expr ...))]
+  [(_ (a:qqed . b:qqed))
+   #'(pair a.expr b.expr)]
+  [(_ prefab)
+   #:when (prefab-struct-key (syntax-e #'prefab))
+   #:with key (prefab-struct-key (syntax-e #'prefab))
+   #:with #(_ x:qqed/splicing ...) (struct->vector (syntax-e #'prefab))
+   #'(apply make-prefab-struct 'key (append x.expr ...))]
+  [(_ hsh)
+   #:do [(define datum (syntax-e #'hsh))]
+   #:when (hash? datum)
+   #:with [(k . v:qqed) ...] (hash->list datum)
+   #:with ctor (cond [(hash-eq? datum) #'make-immutable-hasheq]
+                     [(hash-eqv? datum) #'make-immutable-hasheqv]
+                     [else #'make-immutable-hash])
+   #'(ctor (list (pair 'k v.expr) ...))]
+  [(_ other)
+   #''other])

collections-test/tests/data/collection/experimental/quasi.rkt

@@ -0,0 +1,24 @@
+#lang racket/base
+
+(require data/collection/experimental/quasi
+         racket/stream
+         rackunit)
+
+(test-case
+ "Simple successful quasiquotation"
+ (check-equal? `(1 . #(,(+ 1 1)
+                       #hash((a . #s(sct ,(string-append "a" "b" "c")))
+                             (b . ,(- 4 3)))
+                       4))
+               '(1 . #(2
+                       #hash((a . #s(sct "abc"))
+                             (b . 1))
+                       4))))
+
+(test-case
+ "Splicing quasiquotation with sequences"
+ (check-equal? `(1 ,@(list 2 3 4)
+                   ,@(stream 5 6 7)
+                   #hash((a . #s(sct i ,@(vector-immutable 'ii 'iii 'iv) v))))
+               '(1 2 3 4 5 6 7
+                   #hash((a . #s(sct i ii iii iv v))))))