~technomancy/fennel

Implement early termination in loops. (for/each/collect/icollect) v1 APPLIED

Phil Hagelberg: 1
 Implement early termination in loops. (for/each/collect/icollect)

 4 files changed, 47 insertions(+), 2 deletions(-)
Export patchset (mbox)
How do I use this?

Copy & paste the following snippet into your terminal to import this patchset into git:

curl -s https://lists.sr.ht/~technomancy/fennel/patches/20893/mbox | git am -3
Learn more about email & git
View this thread in the archives

[PATCH] Implement early termination in loops. (for/each/collect/icollect) Export this patch

This allows more flexibility in loops without sacrificing the
consistency that arbitrary breaks would cause.
---
 changelog.md            |  1 +
 reference.md            | 22 ++++++++++++++++++++++
 src/fennel/specials.fnl | 17 ++++++++++++++++-
 test/loops.fnl          |  9 ++++++++-
 4 files changed, 47 insertions(+), 2 deletions(-)

diff --git a/changelog.md b/changelog.md
index 8c2665d..65af780 100644
--- a/changelog.md
+++ b/changelog.md
@@ -2,6 +2,7 @@

## 0.8.2 / ???

* Support `:until` clauses for early termination in all loops
* Support `:escape-newlines?` and `:prefer-colon?` options in fennel.view
* Add nil-safe table access operator `?.`
* Add support for guards using `where`/`or` clauses in `match`
diff --git a/reference.md b/reference.md
index 89ff31d..4615634 100644
--- a/reference.md
+++ b/reference.md
@@ -607,6 +607,15 @@ Example:
  (print key (f value)))
```

Any loop can be terminated early by placing an `:until` clause at the
end of the bindings:

```fennel
(local out [])
(each [_ value (pairs tbl) :until (< max-len (length out))]
  (table.insert out value))
```

Most iterators return two values, but `each` will bind any number. See
[Programming in Lua][4] for details about how iterators work.

@@ -624,6 +633,16 @@ Example:

This example will print all odd numbers under ten.

Like `each`, loops using `for` can also be terminated early with an
`:until` clause. The clause is checked before each iteration of the
body; if it is true at the beginning then the body will not run at all.

```fennel
(var x 0)
(for [i 1 128 :until (maxed-out? x)]
  (set x (+ x i)))
```

### `do` evaluate multiple forms returning last value

Accepts any number of forms and evaluates all of them in order,
@@ -844,6 +863,9 @@ value into a table is a no-op.
  tbl)
```

Like `each` and `for`, the table comprehensions support an `:until`
clause for early termination.

### `->`, `->>`, `-?>` and `-?>>` threading macros

The `->` macro takes its first value and splices it into the second
diff --git a/src/fennel/specials.fnl b/src/fennel/specials.fnl
index dd440a0..b1a1905 100644
--- a/src/fennel/specials.fnl
+++ b/src/fennel/specials.fnl
@@ -509,10 +509,22 @@ nested values, but all parents must contain an existing table.")
Takes any number of condition/body pairs and evaluates the first body where
the condition evaluates to truthy. Similar to cond in other lisps.")

(fn remove-until-condition [bindings]
  (when (= :until (. bindings (- (length bindings) 1)))
    (table.remove bindings (- (length bindings) 1))
    (table.remove bindings)))

(fn compile-until [condition scope chunk]
  (when condition
    (let [[condition-lua] (compiler.compile1 condition scope chunk {:nval 1})]
      (compiler.emit chunk (: "if %s then break end" :format condition-lua)
                     condition))))

(fn SPECIALS.each [ast scope parent]
  (compiler.assert (>= (# ast) 3) "expected body expression" (. ast 1))
  (let [binding (compiler.assert (utils.table? (. ast 2))
                                 "expected binding table" ast)
        until-condition (remove-until-condition binding)
        iter (table.remove binding (# binding)) ; last item is iterator call
        destructures []
        new-manglings []
@@ -537,6 +549,7 @@ the condition evaluates to truthy. Similar to cond in other lisps.")
                                                           :nomulti true
                                                           :symtype :each}))
      (compiler.apply-manglings sub-scope new-manglings ast)
      (compile-until until-condition sub-scope chunk)
      (compile-do ast sub-scope chunk 3)
      (compiler.emit parent chunk ast)
      (compiler.emit parent "end" ast))))
@@ -576,6 +589,7 @@ order, but can be used with any iterator.")
(fn for* [ast scope parent]
  (let [ranges (compiler.assert (utils.table? (. ast 2))
                                "expected binding table" ast)
        until-condition (remove-until-condition (. ast 2))
        binding-sym (table.remove (. ast 2) 1)
        sub-scope (compiler.make-scope scope)
        range-args []
@@ -587,10 +601,11 @@ order, but can be used with any iterator.")
                     "expected body expression" (. ast 1))
    (for [i 1 (math.min (# ranges) 3)]
      (tset range-args i (tostring (. (compiler.compile1 (. ranges i) sub-scope
                                                        parent {:nval 1}) 1))))
                                                         parent {:nval 1}) 1))))
    (compiler.emit parent (: "for %s = %s do" :format
                             (compiler.declare-local binding-sym [] sub-scope ast)
                             (table.concat range-args ", ")) ast)
    (compile-until until-condition sub-scope chunk)
    (compile-do ast sub-scope chunk 3)
    (compiler.emit parent chunk ast)
    (compiler.emit parent "end" ast)))
diff --git a/test/loops.fnl b/test/loops.fnl
index e7e465e..b6d5ff8 100644
--- a/test/loops.fnl
+++ b/test/loops.fnl
@@ -35,6 +35,13 @@
         (tonumber num))"
      [24 58 1999]))

(fn test-conditions []
  (== "(var x 0) (for [i 1 10 :until (= i 5)] (set x i)) x" 4)
  (== "(var x 0) (each [_ i (ipairs [1 2 3]) :until (< 2 x)] (set x i)) x" 3)
  (== "(icollect [_ i (ipairs [4 5 6]) :until (= i 5)] i)" [4])
  (== "(collect [i x (pairs [4 5 6]) :until (= x 6)] (values i x))" [4 5]))

{: test-each
 : test-for
 : test-comprehensions}
 : test-comprehensions
 : test-conditions}
-- 
2.20.1