~technomancy/fennel

This thread contains a patchset. You're looking at the original emails, but you may wish to use the patch review UI. Review patch

[PATCH] implement new prefix syntax for match macro (without transformation)

Details
Message ID
<20210222103009.152794-1-andreyorst@gmail.com>
DKIM signature
pass
Download raw message
Patch: +124 -43
New syntax replaces and extend old question mark `?' based guards with
prefix `where' guards and optional pattern ORing with `or' special
form.

This patch begs to be refactored, but I've understood that I couldn't
come up with a more clear implementation for match macro. Basically I
had to convert all `(values condition bindings)` to `[[condition
bindings]]` data structures, in order to have uniform iteration over
those in the final construction phase. I don't like this, as it adds
too much nesting, and I would personally vote for the other patch I've
sent to the list a bit earlier this day, which uses much more clear
approach of transforming new syntax into old sytax first, and then
using well tested match* on the transformation result.

I've added tests for the new syntax, and ensured that all old tests
pass. I've also removed old syntax from the reference.md. It is still
accessible and will continue to work, but I think we should encourage
to use prefix notation by default.

Below some examples of new syntax and its old syntax variants.

Guard clauses:

    ;; old
    (match [1 2 3]
      ([a b c] ? (= a 1) (> b 0) (= (// c 3) 0)) :match
      :no-match)

    ;; new
    (match [1 2 3]
      (where [a b c] (= a 1) (> b 0) (= (// c 3) 0)) :match
      :no-match)

Sharing same body across patterns:

    ;; old
    (match [1 2 3]
      [4 5 6] :match
      [1 2 3] :match
      :no-match)

    ;; new
    (match [1 2 3]
      (where (or [4 5 6] [1 2 3])) :match
      :no-match)

Combined guards and pattern oring:

    ;; old
    (match [1 2 3]
      ([a 2 5] ? (> a 0)) :match
      ([a 2 3] ? (> a 0)) :match
      :no-match)

    ;; new
    (match [1 2 3]
      (where (or [a 2 5] [a 2 3]) (> a 0)) :match
      :no-match)
---
 reference.md          | 27 ++++++++--------
 src/fennel/macros.fnl | 67 +++++++++++++++++++++++++--------------
 test/macro.fnl        | 73 ++++++++++++++++++++++++++++++++++++++-----
 3 files changed, 124 insertions(+), 43 deletions(-)

diff --git a/reference.md b/reference.md
index ac96573..7eed5d0 100644
--- a/reference.md
+++ b/reference.md
@@ -107,10 +107,10 @@ This style of anonymous function is useful as a parameter to
higher order functions, such as those provided by Lua libraries
like lume and luafun.

The current implementation only allows for either functions functions with
up to 9 arguments, each named `$1` through `$9`, or those with varargs,
delineated by `$...` instead of the usual `...`. A lone `$` in a hash function
is treated as an alias for `$1`.
The current implementation only allows for hash functions to use up to
9 arguments, each named `$1` through `$9`, or those with varargs,
delineated by `$...` instead of the usual `...`. A lone `$` in a hash
function is treated as an alias for `$1`.

Hash functions are defined with the `hashfn` macro or special character `#`,
which wraps its single argument in a function literal. For example,
@@ -393,18 +393,19 @@ or specific value. In these cases you can use guard clauses:

```fennel
(match [91 12 53]
  ([a b c] ? (= 5 a)) :will-not-match
  ([a b c] ? (= 0 (math.fmod (+ a b c) 2)) (= 91 a)) c) ; -> 53
  (where [a b c] (= 5 a)) :will-not-match
  (where [a b c] (= 0 (math.fmod (+ a b c) 2)) (= 91 a)) c) ; -> 53
```

In this case the pattern should be wrapped in parens (like when
matching against multiple values) but the second thing in the parens
is the `?` symbol. Each form following this marker is a condition;
all the conditions must evaluate to true for that pattern to match.
In this case the pattern should be wrapped in parentheses (like when
matching against multiple values) but the first thing in the
parentheses is the `where` symbol. Each form following this marker is
a condition; all the conditions must evaluate to true for that pattern
to match.

**Note:**: The `match` macro can be used in place of the `if-let` macro
from Clojure. The reason Fennel doesn't have `if-let` is that `match`
makes it redundant.
**Note:**: The `match` macro can be used in place of the `if-some`
macro from Clojure. The reason Fennel doesn't have `if-some` is that
`match` makes it redundant.

### `global` set global variable

diff --git a/src/fennel/macros.fnl b/src/fennel/macros.fnl
index 911a80d..9ff2c8c 100644
--- a/src/fennel/macros.fnl
+++ b/src/fennel/macros.fnl
@@ -84,7 +84,7 @@ encountering an error before propagating it."
        closer `(fn close-handlers# [ok# ...] (if ok# ...
                                                  (error ... 0)))
        traceback `(. (or package.loaded.fennel debug) :traceback)]
    (for [i 1 (# closable-bindings) 2]
    (for [i 1 (length closable-bindings) 2]
      (assert (sym? (. closable-bindings i))
              "with-open only allows symbols in bindings")
      (table.insert closer 4 `(: ,(. closable-bindings i) :close)))
@@ -178,11 +178,11 @@ that argument name begins with ?."
        has-internal-name? (sym? (. args 1))
        arglist (if has-internal-name? (. args 2) (. args 1))
        docstring-position (if has-internal-name? 3 2)
        has-docstring? (and (> (# args) docstring-position)
        has-docstring? (and (> (length args) docstring-position)
                            (= :string (type (. args docstring-position))))
        arity-check-position (- 4 (if has-internal-name? 0 1)
                                (if has-docstring? 0 1))
        empty-body? (< (# args) arity-check-position)]
        empty-body? (< (length args) arity-check-position)]
    (fn check! [a]
      (if (table? a)
          (each [_ a (pairs a)]
@@ -251,12 +251,12 @@ Example:
  (let [condition `(and)
        bindings []]
    (each [i pat (ipairs pattern)]
      (let [(subcondition subbindings) (match-pattern [(. vals i)] pat
      (let [[[subcondition subbindings]] (match-pattern [(. vals i)] pat
                                                      unifications)]
        (table.insert condition subcondition)
        (each [_ b (ipairs subbindings)]
          (table.insert bindings b))))
    (values condition bindings)))
    [[condition bindings]]))

(fn match-table [val pattern unifications match-pattern]
  (let [condition `(and (= (type ,val) :table))
@@ -273,12 +273,12 @@ Example:
               (= "&" (tostring (. pattern (- k 1)))))
          nil ; don't process the pattern right after &; already got it
          (let [subval `(. ,val ,k)
                (subcondition subbindings) (match-pattern [subval] pat
                [[subcondition subbindings]] (match-pattern [subval] pat
                                                          unifications)]
            (table.insert condition subcondition)
            (each [_ b (ipairs subbindings)]
              (table.insert bindings b)))))
    (values condition bindings)))
    [[condition bindings]]))

(fn match-pattern [vals pattern unifications]
  "Takes the AST of values and a single pattern and returns a condition
@@ -294,26 +294,47 @@ introduce for the duration of the body if it does match."
                     (= :nil (tostring pattern))))
            (and (multi-sym? pattern)
                 (in-scope? (. (multi-sym? pattern) 1))))
        (values `(= ,val ,pattern) [])
        [[`(= ,val ,pattern) []]]
        ;; unify a local we've seen already
        (and (sym? pattern) (. unifications (tostring pattern)))
        (values `(= ,(. unifications (tostring pattern)) ,val) [])
        [[`(= ,(. unifications (tostring pattern)) ,val) []]]
        ;; bind a fresh local
        (sym? pattern)
        (let [wildcard? (: (tostring pattern) :find "^_")]
          (if (not wildcard?) (tset unifications (tostring pattern) val))
          (values (if (or wildcard? (string.find (tostring pattern) "^?"))
                      true `(not= ,(sym :nil) ,val))
                  [pattern val]))
        ;; guard clause
          [[(if (or wildcard? (string.find (tostring pattern) "^?"))
                true `(not= ,(sym :nil) ,val))
            [pattern val]]])
        ;; guard clause (deprecated) - (pat ? guard guards*)
        (and (list? pattern) (= (. pattern 2) `?))
        (let [(pcondition bindings) (match-pattern vals (. pattern 1)
                                                   unifications)
        (let [[[pcondition bindings]] (match-pattern vals (. pattern 1)
                                                 unifications)
              condition `(and ,pcondition)]
          (for [i 3 (# pattern)] ; splice in guard clauses
          (for [i 3 (length pattern)] ; splice in guard clauses
            (table.insert condition (. pattern i)))
          (values `(let ,bindings ,condition) bindings))

          [[`(let ,bindings ,condition) bindings]])
        ;; where guard clause with ORed patterns - (where (or pat pats*) guard guards*)
        (and (list? pattern) (= (. pattern 1) `where)
             (list? (. pattern 2) (= (. pattern 2 1) `or)))
        (let [bindings-conditions []]
          (for [i 2 (length (. pattern 2))]
            (table.insert
             bindings-conditions
             (let [[[pcondition bindings]] (match-pattern vals (. pattern 2 i)
                                                        unifications)
                   condition `(and ,pcondition)]
               (for [i 3 (length pattern)] ; splice in guard clauses
                 (table.insert condition (. pattern i)))
               [`(let ,bindings ,condition) bindings])))
          bindings-conditions)
        ;; where guard clause - (where pat guard guards*)
        (and (list? pattern) (= (. pattern 1) `where))
        (let [[[pcondition bindings]] (match-pattern vals (. pattern 2)
                                                 unifications)
              condition `(and ,pcondition)]
          (for [i 3 (length pattern)] ; splice in guard clauses
            (table.insert condition (. pattern i)))
          [[`(let ,bindings ,condition) bindings]])
        ;; multi-valued patterns (represented as lists)
        (list? pattern)
        (match-values vals pattern unifications match-pattern)
@@ -321,7 +342,7 @@ introduce for the duration of the body if it does match."
        (= (type pattern) :table)
        (match-table val pattern unifications match-pattern)
        ;; literal value
        (values `(= ,val ,pattern) []))))
        [[`(= ,val ,pattern) []]])))

(fn match-condition [vals clauses]
  "Construct the actual `if` AST for the given match values and clauses."
@@ -330,10 +351,10 @@ introduce for the duration of the body if it does match."
  (let [out `(if)]
    (for [i 1 (length clauses) 2]
      (let [pattern (. clauses i)
            body (. clauses (+ i 1))
            (condition bindings) (match-pattern vals pattern {})]
        (table.insert out condition)
        (table.insert out `(let ,bindings ,body))))
            body (. clauses (+ i 1))]
        (each [_ [condition bindings] (ipairs (match-pattern vals pattern {}))]
          (table.insert out condition)
          (table.insert out `(let ,bindings ,body)))))
    out))

(fn match-val-syms [clauses]
diff --git a/test/macro.fnl b/test/macro.fnl
index fa319df..76e08b6 100644
--- a/test/macro.fnl
+++ b/test/macro.fnl
@@ -130,17 +130,76 @@
               "(match [:a [:b :c]] [a b :c] :no [:a [:b c]] c)" "c"
               "(match [:a {:b 8}] [a b :c] :no [:a {:b b}] b)" 8
               "(match [{:sieze :him} 5]
            ([f 4] ? f.sieze (= f.sieze :him)) 4
            ([f 5] ? f.sieze (= f.sieze :him)) 5)" 5
                  ([f 4] ? f.sieze (= f.sieze :him)) 4
                  ([f 5] ? f.sieze (= f.sieze :him)) 5)" 5
               "(match nil _ :yes nil :no)" "yes"
               "(match {:a 1 :b 2} {:c 3} :no {:a n} n)" 1
               "(match {:sieze :him}
            (tbl ? (. tbl :no)) :no
            (tbl ? (. tbl :sieze)) :siezed)" "siezed"
                  (tbl ? (. tbl :no)) :no
                  (tbl ? (. tbl :sieze)) :siezed)" "siezed"
               "(match {:sieze :him}
            (tbl ? tbl.sieze tbl.no) :no
            (tbl ? tbl.sieze (= tbl.sieze :him)) :siezed2)" "siezed2"
               "(var x 1) (fn i [] (set x (+ x 1)) x) (match (i) 4 :N 3 :n 2 :y)" "y"}]
                  (tbl ? tbl.sieze tbl.no) :no
                  (tbl ? tbl.sieze (= tbl.sieze :him)) :siezed2)" "siezed2"
               "(var x 1) (fn i [] (set x (+ x 1)) x) (match (i) 4 :N 3 :n 2 :y)" "y"
               ;; New syntax -- general case
               "(match [1 2 3 4]
                  1 :nope1
                  [1 2 4] :nope2
                  (where [1 2 4]) :nope3
                  (where (or [1 2 4] [4 5 6])) :nope4
                  (where [a 1 2] (> a 0)) :nope5
                  (where [a b c] (> a 2) (> b 0) (> c 0)) :nope6
                  (where (or [a 1] [a -2 -3] [a 2 3 4]) (> a 0)) :success
                  :nope7)" :success
               ;; Booleans are OR'ed as patterns
               "(match false
                  (where (or false true)) :false
                  _ :nil)" :false
               "(match true
                  (where (or false true)) :true
                  _ :nil)" :true
               ;; Old syntax as well as new syntax
               "(match [1 2 3 4]
                  (where (or [1 2 4] [4 5 6])) :nope1
                  (where [a 2 3 4] (> a 10)) :nope2
                  ([a 2 3 4] ? (> a 10)) :nope3
                  ([a 2 3 4] ? (= a 1)) :success)" :success
               "(match [1 2 3 4]
                  (where (or [1 2 4] [4 5 6])) :nope1
                  (where [a 2 3 4] (> a 0)) :success1
                  ([a 2 3 4] ? (> a 10)) :nope3
                  ([a 2 3 4] ? (= a 1)) :success2)" :success1
               ;; nil matching
               "(match nil
                  1 :nope1
                  1.2 :nope2
                  :2 :nope3
                  \"3 4\" :nope4
                  [1] :nope5
                  [1 2] :nope6
                  (1) :nope7
                  (1 2) :nope8
                  {:a 1} :nope9
                  [[1 2] [3 4]] :nope10
                  nil :success
                  :nope11)" :success
               ;; no match
               "(match [1 2 3 4]
                  (1 2 3 4) :nope1
                  {:a 1 :b 2} :nope2
                  (where [a b c d] (= 100 (* a b c d))) :nope3
                  ([a b c d] ? (= 100 (* a b c d))) :nope4
                  :success)" :success
               ;; old tests adopted to new syntax
               "(match [{:sieze :him} 5]
                  (where [f 4] f.sieze (= f.sieze :him)) 4
                  (where [f 5] f.sieze (= f.sieze :him)) 5)" 5
               "(match {:sieze :him}
                  (where tbl (. tbl :no)) :no
                  (where tbl (. tbl :sieze)) :siezed)" :siezed
               "(match {:sieze :him}
                  (where tbl tbl.sieze tbl.no) :no
                  (where tbl tbl.sieze (= tbl.sieze :him)) :siezed2)" :siezed2}]
    (each [code expected (pairs cases)]
      (l.assertEquals (fennel.eval code {:correlate true}) expected code))))

-- 
2.29.2
Reply to thread Export thread (mbox)