From 601584b629653609f3260334aed5b06562d54ac4 Mon Sep 17 00:00:00 2001
From: Ben Greenman <benjaminlgreenman@gmail.com>
Date: Sun, 10 Oct 2021 17:32:32 -0400
Subject: [PATCH] add pyret-for, flaggable-app, js-dict

from https://github.com/syntax-objects/Summer2021/issues/11
and https://github.com/syntax-objects/Summer2021/issues/14
and https://github.com/syntax-objects/Summer2021/issues/17
cc @sorawee
---
 flaggable-app/flaggable-app-test.rkt |  18 ++++
 flaggable-app/flaggable-app.rkt      |  20 ++++
 flaggable-app/flaggable-app.scrbl    |  69 +++++++++++++
 index.scrbl                          |   3 +
 js-dict/js-dict-test.rkt             |  33 ++++++
 js-dict/js-dict.rkt                  |  66 ++++++++++++
 js-dict/js-dict.scrbl                | 148 +++++++++++++++++++++++++++
 pyret-for/pyret-for-test.rkt         |  20 ++++
 pyret-for/pyret-for.rkt              |  13 +++
 pyret-for/pyret-for.scrbl            |  75 ++++++++++++++
 10 files changed, 465 insertions(+)
 create mode 100644 flaggable-app/flaggable-app-test.rkt
 create mode 100644 flaggable-app/flaggable-app.rkt
 create mode 100644 flaggable-app/flaggable-app.scrbl
 create mode 100644 js-dict/js-dict-test.rkt
 create mode 100644 js-dict/js-dict.rkt
 create mode 100644 js-dict/js-dict.scrbl
 create mode 100644 pyret-for/pyret-for-test.rkt
 create mode 100644 pyret-for/pyret-for.rkt
 create mode 100644 pyret-for/pyret-for.scrbl

diff --git a/flaggable-app/flaggable-app-test.rkt b/flaggable-app/flaggable-app-test.rkt
new file mode 100644
index 0000000..e24e859
--- /dev/null
+++ b/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)))))
+
+)
diff --git a/flaggable-app/flaggable-app.rkt b/flaggable-app/flaggable-app.rkt
new file mode 100644
index 0000000..084bb80
--- /dev/null
+++ b/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} ...))
+
diff --git a/flaggable-app/flaggable-app.scrbl b/flaggable-app/flaggable-app.scrbl
new file mode 100644
index 0000000..43dfd10
--- /dev/null
+++ b/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}
+
+}
diff --git a/index.scrbl b/index.scrbl
index 04ee4f9..c785f22 100644
--- a/index.scrbl
+++ b/index.scrbl
@@ -36,3 +36,6 @@
 @include-example{dot-underscore}
 @include-example{try-catch-finally}
 @include-example{kw-ctc}
+@include-example{pyret-for}
+@include-example{flaggable-app}
+@include-example{js-dict}
diff --git a/js-dict/js-dict-test.rkt b/js-dict/js-dict-test.rkt
new file mode 100644
index 0000000..e7cd0f3
--- /dev/null
+++ b/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)))))
+)
diff --git a/js-dict/js-dict.rkt b/js-dict/js-dict.rkt
new file mode 100644
index 0000000..1c28d22
--- /dev/null
+++ b/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))
+
diff --git a/js-dict/js-dict.scrbl b/js-dict/js-dict.scrbl
new file mode 100644
index 0000000..5b4ec60
--- /dev/null
+++ b/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}
+
diff --git a/pyret-for/pyret-for-test.rkt b/pyret-for/pyret-for-test.rkt
new file mode 100644
index 0000000..d14c776
--- /dev/null
+++ b/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)))))
+)
diff --git a/pyret-for/pyret-for.rkt b/pyret-for/pyret-for.rkt
new file mode 100644
index 0000000..f5573f5
--- /dev/null
+++ b/pyret-for/pyret-for.rkt
@@ -0,0 +1,13 @@
+#lang racket/base
+(provide pyret-for)
+
+(require racket/match syntax/parse/define (for-syntax racket/base))
+
+(define-syntax-parse-rule
+  (pyret-for f:expr ([pat:expr arg:expr] ...) body:expr ...+)
+  #:with (x ...) (generate-temporaries (attribute arg)) 
+  (f (λ (x ...)
+       (match-define pat x) ...
+       body ...)
+     arg ...))
+
diff --git a/pyret-for/pyret-for.scrbl b/pyret-for/pyret-for.scrbl
new file mode 100644
index 0000000..2685bc8
--- /dev/null
+++ b/pyret-for/pyret-for.scrbl
@@ -0,0 +1,75 @@
+#lang syntax-parse-example
+@require[
+  (for-label racket/base syntax/parse syntax-parse-example/pyret-for/pyret-for)]
+
+@(define pyret-for-eval
+   (make-base-eval '(require racket/math racket/list racket/string syntax-parse-example/pyret-for/pyret-for)))
+
+@title{@tt{pyret-for}}
+@stxbee2021["sorawee" 11]
+
+@; =============================================================================
+
+@defmodule[syntax-parse-example/pyret-for/pyret-for]{}
+
+@defform[(pyret-for fn-expr ([pattern arg] ...) expr ...+)]{
+  Many common higher-order functions consume a function value as the first
+  argument, and @racket[_n] more arguments after that, where the function value
+  accepts @racket[_n] arguments, which corresponds to the arguments in the call
+  in some way.
+  Examples include: @racket[map], @racket[filter] (only one argument),
+  @racket[andmap], @racket[ormap].
+  (@racket[foldl] and @racket[foldr] have arguments in a wrong order, so they
+  don't quite work.)
+
+  @examples[#:label @elem{Example without @racket[pyret-for]:} #:eval pyret-for-eval
+    (define things     '(("pen") ("pineapple") ("apple") ("pen")))
+    (define quantities '(1       2             3         5))
+
+    (andmap (λ (thing quantity)
+              (or (string-contains? (first thing) "apple")
+                  (odd? quantity)))
+            things
+            quantities)
+
+  ]
+
+  The problem is that:
+
+  @itemlist[
+    @item{
+      It is difficult for readers to relate formal arguments of the function
+      value to the actual arguments of the call.
+    }
+    @item{
+      There is a lot of rightward drift.
+    }]
+
+  @examples[#:label @elem{Example with @racket[pyret-for]:} #:eval pyret-for-eval
+    (define things     '(("pen") ("pineapple") ("apple") ("pen")))
+    (define quantities '(1       2             3         5))
+
+    (pyret-for andmap ([thing things] [quantity quantities])
+      (or (string-contains? (first thing) "apple")
+          (odd? quantity)))
+  ]
+
+  The @racket[pyret-for] syntax, based on @hyperlink["https://www.pyret.org/docs/latest/Expressions.html#%28part._s~3afor-expr%29" @elem{Pyret's @tt{for}}],
+  can be used to invoke this kind of higher-order function.
+
+  @racket[pyret-for] additionally improves upon Pyret's for by allowing
+  arbitrary match pattern.
+
+  @examples[#:label @elem{Example with @racket[pyret-for] and match:} #:eval pyret-for-eval
+    (define things     '(("pen") ("pineapple") ("apple") ("pen")))
+    (define quantities '(1       2             3         5))
+
+    (pyret-for andmap ([(list thing) things] [quantity quantities])
+      (or (string-contains? thing "apple")
+          (odd? quantity)))]
+
+  Implementation:
+
+  @racketfile{pyret-for.rkt}
+
+}