add pyret-for, flaggable-app, js-dict

from syntax-objects/Summer2021#11
and syntax-objects/Summer2021#14
and syntax-objects/Summer2021#17
cc @sorawee

flaggable-app/flaggable-app-test.rkt

@@ -0,0 +1,18 @@
+#lang racket/base
+(module+ test
+  (require rackunit syntax/macro-testing syntax-parse-example/flaggable-app/flaggable-app)
+
+  (test-case "example"
+    (define (f c #:a [a #f] #:b [b #f])
+      (list c a b))
+    (check-equal? (f 0 #:a #:b)       '(0 #t #t))
+    (check-equal? (f 0 #:a)           '(0 #t #f))
+    (check-equal? (f 0 #:b)           '(0 #f #t))
+    (check-equal? (f 0 #:a 10 #:b)    '(0 10 #t))
+    (check-equal? (f 0 #:a #:b 20)    '(0 #t 20))
+    (check-equal? (f 0 #:a 10 #:b 20) '(0 10 20))
+    (check-equal? (f 0)               '(0 #f #f))
+    (check-exn exn:fail:syntax?
+      (lambda () (convert-compile-time-error (f #:a 0 1)))))
+
+)

flaggable-app/flaggable-app.rkt

@@ -0,0 +1,20 @@
+#lang racket/base
+(provide #%app)
+
+(require syntax/parse/define
+         (only-in racket [#%app racket:#%app])
+         (for-syntax racket/base))
+
+(begin-for-syntax
+  (define-splicing-syntax-class arg/keyword
+    #:attributes (k v)
+    ;; first case: something like #:a 1
+    (pattern {~seq k:keyword v:expr})
+    ;; second case: something like #:a.
+    (pattern {~seq k:keyword}
+             #:with v #'#t)))
+
+(define-syntax-parse-rule
+  (#%app f arg/no-keyword:expr ... arg/keyword:arg/keyword ...)
+  (racket:#%app f arg/no-keyword ... {~@ arg/keyword.k arg/keyword.v} ...))
+

flaggable-app/flaggable-app.scrbl

@@ -0,0 +1,69 @@
+#lang syntax-parse-example
+@require[
+  (for-label (except-in racket/base #%app) syntax/parse syntax-parse-example/flaggable-app/flaggable-app)]
+
+@(define plain-eval
+   (make-base-eval '(require racket/string)))
+
+@(define flaggable-app-eval
+   (make-base-eval '(require racket/string syntax-parse-example/flaggable-app/flaggable-app)))
+
+@title{@tt{flaggable-app}}
+@stxbee2021["sorawee" 14]
+
+@; =============================================================================
+
+@defmodule[syntax-parse-example/flaggable-app/flaggable-app]{}
+
+@defform[(#%app fn expr ...+)]{
+  Many functions accept optional boolean keyword arguments.
+  These arguments are known as flags.
+  As a simple example, the following function accepts two flags
+  @racket[#:left] and @racket[#:right]:
+
+  @examples[#:label #f #:eval flaggable-app-eval
+    (define (trim s #:left? [left? #f] #:right? [right? #f])
+      (string-trim s #:left? left? #:right? right?))
+  ]
+  @examples[#:hidden #:eval plain-eval
+    (define (trim s #:left? [left? #f] #:right? [right? #f])
+      (string-trim s #:left? left? #:right? right?))
+  ]
+
+  The function may be invoked with any number of flags, but if a flag keyword
+  appears then it needs an argument as well:
+
+  @examples[#:label #f #:eval plain-eval
+    (trim " 1 2 3 " #:left? #t)
+    (eval:error (trim " 1 2 3 " #:left?))
+  ]
+
+  Flaggable @racket[#%app] allows users to instead write:
+
+  @examples[#:label #f #:eval flaggable-app-eval
+    (trim " 1 2 3 " #:left?)
+    (trim " 1 2 3 " #:left? #:right?)
+  ]
+
+  That is, a keyword that doesn't come with an argument will default the
+  value to @racket[#t]. Arguments are still supported.
+
+  This does come at a cost: all keyword arguments must be specified after
+  positional arguments to avoid ambiguity. Without this restriction, it is hard
+  to tell whether:
+
+  @racketblock[
+    (f #:a 1)
+  ]
+
+  is meant to be itself or:
+
+  @racketblock[
+    (f 1 #:a #t)
+  ]
+
+  Note: inspired by @hyperlink["https://www.reddit.com/r/Racket/comments/oytknk/keyword_arguments_without_values/h7w67dd/" "reddit.com/r/Racket/comments/oytknk/keyword_arguments_without_values/h7w67dd"].
+
+  @racketfile{flaggable-app.rkt}
+
+}

index.scrbl

@@ -29,3 +29,6 @@
 @include-example{syntax-class-contract}
 @include-example{except-in-quiet}
 @include-example{dot-underscore}
+@include-example{pyret-for}
+@include-example{flaggable-app}
+@include-example{js-dict}

js-dict/js-dict-test.rkt

@@ -0,0 +1,33 @@
+#lang racket/base
+(module+ test
+  (require rackunit syntax-parse-example/js-dict/js-dict)
+
+  (test-begin
+    (define d 4)
+    (define base-1 (js-dict [x '((10))] [b 20]))
+    (define base-2 (js-dict [y 30] [a 40]))
+    (define obj
+      (js-dict
+       [a 1]
+       #:merge base-1
+       [b 2]
+       #:merge base-2
+       [#:expr (string->symbol "c") 3]
+       d))
+
+    (test-case "js-dict"
+      (check-equal? obj '#hash((a . 40) (b . 2) (c . 3) (d . 4) (x . ((10))) (y . 30))))
+
+    (test-case "js-extract"
+      (js-extract ([#:expr (string->symbol "a") f]
+               c
+               d
+               [x (list (list x))]
+               #:rest rst)
+              obj)
+      (check-equal? f  40)
+      (check-equal? c 3)
+      (check-equal? d 4)
+      (check-equal? x 10)
+      (check-equal? rst '#hash((b . 2) (y . 30)))))
+)

js-dict/js-dict.rkt

@@ -0,0 +1,66 @@
+#lang racket/base
+(provide js-dict js-extract)
+
+(require syntax/parse/define
+         racket/match
+         racket/hash
+         racket/splicing
+         (for-syntax racket/base
+                     racket/list))
+
+(begin-for-syntax
+  (define-splicing-syntax-class key
+    (pattern {~seq #:expr key:expr}
+             #:with static #'())
+    (pattern {~seq key*:id}
+             #:with key #''key*
+             #:with static #'(key*)))
+
+  (define-splicing-syntax-class construct-spec
+    (pattern {~seq [key:key val:expr]}
+             #:with code #'`[#:set ,key.key ,val]
+             #:with (static ...) #'key.static)
+    (pattern {~seq #:merge e:expr}
+             #:with code #'`[#:merge ,e]
+             #:with (static ...) #'())
+    (pattern {~seq x:id}
+             #:with code #'`[#:set x ,x]
+             #:with (static ...) #'(x)))
+
+  (define-syntax-class extract-spec
+    (pattern [key*:key pat:expr]
+             #:with key #'key*.key
+             #:with (static ...) #'key*.static)
+    (pattern x:id
+             #:with key #''x
+             #:with pat #'x
+             #:with (static ...) #'(x))))
+
+(define (make-dict . xs)
+  (for/fold ([h (hash)]) ([x (in-list xs)])
+    (match x
+      [`[#:set ,key ,val] (hash-set h key val)]
+      [`[#:merge ,d] (hash-union h d #:combine (λ (a b) b))])))
+
+(define-syntax-parse-rule (js-dict spec:construct-spec ...)
+  #:fail-when
+  (check-duplicate-identifier (append* (attribute spec.static)))
+  "duplicate static key"
+  (make-dict spec.code ...))
+
+(define-syntax-parser extract
+  [(_ () pat-rst rst-obj) #'(match-define pat-rst rst-obj)]
+  [(_ (spec:extract-spec specs ...) pat-rst rst-obj)
+   #'(splicing-let ([KEY spec.key]
+                    [OBJ rst-obj])
+       (match-define spec.pat (hash-ref OBJ KEY))
+       (extract (specs ...) pat-rst (hash-remove OBJ KEY)))])
+
+(define-syntax-parse-rule (js-extract (spec:extract-spec ...
+                                       {~optional {~seq #:rest e:expr}})
+                                      obj:expr)
+  #:fail-when
+  (check-duplicate-identifier (append* (attribute spec.static)))
+  "duplicate static key"
+  (extract (spec ...) (~? e _) obj))
+

js-dict/js-dict.scrbl

@@ -0,0 +1,148 @@
+#lang syntax-parse-example
+@require[
+  (for-label racket/base syntax/parse syntax-parse-example/js-dict/js-dict)]
+
+@(define js-dict-eval
+   (make-base-eval '(require syntax-parse-example/js-dict/js-dict)))
+
+@(define (codeverb . elem*) (nested #:style 'code-inset (apply verbatim elem*)))
+
+@title{JavaScript-Inspired Dictionary Syntax}
+@stxbee2021["sorawee" 17]
+
+JavaScript (JS) has really elegant syntax to manipulate dictionaries.
+
+
+@bold{JS Dictionary Creation}
+
+Given @tt{x = 42} the following syntax makes a dictionary with four entries:
+
+@codeverb|{
+ {a: 1 + 2, b: 3, ['a' + 'b']: 4, x}
+}|
+
+@itemlist[
+  @item{@tt{'a'} maps to @tt{3};}
+  @item{@tt{'b'} maps to @tt{3};}
+  @item{@tt{'ab'} maps to @tt{4}; and}
+  @item{@tt{'x'} maps to @tt{42}}
+]
+
+@bold{JS Dictionary Merging}
+
+Other dictionaries can be merged as a part of dictionary creation.
+
+Given:
+
+@codeverb{
+let a = {a: 1, c: 2};
+let b = {b: 2, c: 3};
+}
+
+Then the following dictionary has four entries:
+
+@codeverb{
+{b: 42, ...a, ...b, a: 4, d: 5}
+}
+
+@itemlist[
+@item{@tt{'a'} maps to @tt{4};}
+@item{@tt{'b'} maps to @tt{2};}
+@item{@tt{'c'} maps to @tt{3}; and}
+@item{@tt{'d'} maps to @tt{5}}
+]
+
+Note that the merging syntax can be used to set a value functionally without
+mutating the dictionary.
+
+@bold{JS Dictionary Extraction}
+
+Given:
+
+@codeverb{
+let x = {a: 1, b: 2, c: 3, d: 4};
+}
+
+Then the following syntax:
+
+@codeverb{
+`let {a, b: bp} = x;`
+}
+
+binds @tt{a} to @tt{1} and @tt{bp} to @tt{2}.
+
+
+
+@bold{JS Dictionary Extraction of the rest}
+
+As a part of extraction, there can be at most one @tt{...}, which will function as
+the extraction of the rest
+
+For example:
+
+@codeverb{
+  let {a, b: bp, ...y} = x;
+}
+
+binds @tt{a} to @tt{1}, @tt{bp} to @tt{2}, @tt{y} to @tt{{c: 3, d: 4}}.
+
+
+@; =============================================================================
+
+@defmodule[syntax-parse-example/js-dict/js-dict]{}
+
+The @racket[js-dict] and @racket[js-extract] macros bring these operations to
+Racket, using immutable hash tables as the data structure.
+Additionally, the @racket[js-extract] macro improves upon JS by supporting
+arbitrary match pattern.
+
+@defform[(js-dict construct-spec ...)
+         #:grammar ([ccnstruct-spec [key expr]
+                                    (#:merge expr)
+                                    id]
+                    [key (#:expr expr) id])]{
+
+  @examples[#:eval js-dict-eval
+    (define d 4)
+    (define base-1 (js-dict [x '((10))] [b 20]))
+    (define base-2 (js-dict [y 30] [a 40]))
+    (define obj
+      (js-dict
+       [a 1]
+       #:merge base-1
+       [b 2]
+       #:merge base-2
+       [#:expr (string->symbol "c") 3]
+       d))
+     obj
+  ]
+
+}
+
+@defform[(js-extract (extract-spec ... maybe-rest) obj-expr)
+         #:grammar ([extract-spec [key pattern-expr]
+                                  id]
+                    [maybe-rest (code:line) #:rest expr]
+                    [key (#:expr expr) id])]{
+
+  With the above @racket[_obj], in the following code adds five definitions:
+
+  @examples[#:eval js-dict-eval
+    (js-extract ([#:expr (string->symbol "a") f]
+                 c
+                 d
+                 [x (list (list x))]
+                 #:rest rst)
+                obj)
+    f
+    c
+    d
+    x
+    rst
+  ]
+}
+
+Implementation:
+
+@racketfile{js-dict.rkt}
+

pyret-for/pyret-for-test.rkt

@@ -0,0 +1,20 @@
+#lang racket/base
+(module+ test
+  (require rackunit racket/list racket/string syntax-parse-example/pyret-for/pyret-for)
+
+  (test-case "no-match"
+    (define things     '(("pen") ("pineapple") ("apple") ("pen")))
+    (define quantities '(1       2             3         5))
+    (check-true
+      (pyret-for andmap ([thing things] [quantity quantities])
+        (or (string-contains? (first thing) "apple")
+            (odd? quantity)))))
+
+  (test-case "match"
+    (define things     '(("pen") ("pineapple") ("apple") ("pen")))
+    (define quantities '(1       2             3         5))
+    (check-true
+      (pyret-for andmap ([(list thing) things] [quantity quantities])
+        (or (string-contains? thing "apple")
+            (odd? quantity)))))
+)