Merge pull request #106 from Kodiologist/loop

Reimplement `loop`

NEWS.rst

@@ -3,15 +3,22 @@
 Unreleased
 ======================================================
 
+Breaking Changes
+------------------------------
+* `recur` is now a real object that must be imported from Hyrule when
+  using `loop`.
+
 New Features
 ------------------------------
 * New macro `pun`.
 * New macro `map-hyseq`.
+* `loop` allows more kinds of parameters.
 
 Bug Fixes
 ------------------------------
 * `map-model` now calls `as-model` only once (before its own recursion),
   and it does so unconditionally.
+* `loop` now works when nested.
 
 0.7.0 (released 2024-09-22; uses Hy ≥ 1)
 ======================================================

docs/index.rst

@@ -67,6 +67,7 @@ Reference
 .. hy:automacro:: lif
 .. hy:automacro:: list-n
 .. hy:automacro:: loop
+.. hy:autoclass:: recur
 .. hy:automacro:: unless
 
 ``destructure`` — Macros for destructuring collections

hyrule/control.hy

@@ -250,55 +250,40 @@
 
 
 (defmacro! loop [bindings #* body]
-  "The loop/recur macro allows you to construct functions that use
-  tail-call optimization to allow arbitrary levels of recursion.
-
-  ``loop`` establishes a recursion point. With ``loop``, ``recur``
-  rebinds the variables set in the recursion point and sends code
-  execution back to that recursion point. If ``recur`` is used in a
-  non-tail position, an exception is raised. which
-  causes chaos.
-
-  Usage: ``(loop bindings #* body)``
-
-  Examples:
-    ::
-
-       => (require hyrule.contrib.loop [loop])
-       => (defn factorial [n]
-       ...  (loop [[i n] [acc 1]]
-       ...    (if (= i 0)
-       ...      acc
-       ...      (recur (dec i) (* acc i)))))
-       => (factorial 1000)"
-  (setv [fnargs initargs] (if bindings (zip #* bindings) [[] []]))
-  (setv new-body (prewalk
-    (fn [x] (if (= x 'recur) g!recur-fn x))
-    body))
+  "Construct and immediately call an anonymous function with explicit `tail-call elimination <https://en.wikipedia.org/wiki/Tail-call_elimination>`__. To see how it's used, consider this tail-recursive implementation of the factorial function::
+
+    (defn factorial [n [acc 1]]
+      (if n
+        (factorial (- n 1) (* acc n))
+        acc))
+
+  With ``loop``, this would be written as::
+
+    (defn factorial [n]
+      (loop [[n n] [acc 1]]
+        (if n
+          (recur (- n 1) (* acc n))
+          acc)))
+
+  Don't forget to ``(import hyrule [recur])``. The :hy:class:`recur` object holds the arguments for the next call. When the function returns a :hy:class:`recur`, ``loop`` calls it again with the new arguments. Otherwise, ``loop`` ends and the final value is returned. Thus, what would be a nested set of recursive calls becomes a series of calls that are resolved entirely in sequence.
+
+  Note that while ``loop`` uses the same syntax as ordinary function definitions for its lambda list, all arguments other than ``#* args`` and ``#* kwargs`` must have a default value, because the function will first be called with no arguments."
+
   `(do
-    (import hyrule.control [_trampoline :as ~g!t])
-    (setv ~g!recur-fn (~g!t (fn [~@fnargs] ~@new-body)))
-    (~g!recur-fn ~@initargs)))
-
-(defn _trampoline [f]
-  "Wrap f function and make it tail-call optimized."
-  ;; Takes the function "f" and returns a wrapper that may be used for tail-
-  ;; recursive algorithms. Note that the returned function is not side-effect
-  ;; free and should not be called from anywhere else during tail recursion.
-
-  (setv result None)
-  (setv active False)
-  (setv accumulated [])
-
-  (fn [#* args]
-    (nonlocal active)
-    (.append accumulated args)
-    (when (not active)
-      (setv active True)
-      (while (> (len accumulated) 0)
-        (setv result (f #* (.pop accumulated))))
-      (setv active False)
-      result)))
+    (defn ~g!f ~bindings
+      ~@body)
+    (setv ~g!result (~g!f))
+    (while (isinstance ~g!result hy.I.hyrule.recur)
+      (setv ~g!result (~g!f
+        #* (. ~g!result args)
+        #** (. ~g!result kwargs))))
+    ~g!result))
+
+(defclass recur []
+  "A simple wrapper class used by :hy:func:`loop`. The attribute
+  ``args`` holds a tuple and ``kwargs`` holds a dictionary."
+  (defn __init__ [self #* args #** kwargs]
+    (setv  self.args args  self.kwargs kwargs)))
 
 
 (defmacro unless [test #* body]

hyrule/hy_init.hy

@@ -10,6 +10,7 @@
   hyrule.sequences *)
 (import
   hyrule.collections *
+  hyrule.control [recur]
   hyrule.destructure *
   hyrule.iterables *
   hyrule.macrotools *

tests/test_loop.hy

@@ -1,58 +1,64 @@
 (require
   hyrule [loop])
 (import
+  math
   sys
-  hyrule [inc dec])
+  hyrule [inc dec recur]
+  pytest)
 
 
-(defn tco-sum [x y]
-  (loop [[x x] [y y]]
-        (cond
-          (> y 0) (recur (inc x) (dec y))
-          (< y 0) (recur (dec x) (inc y))
-          True x)))
+(defn test-factorial []
+  (assert (=
+    (loop [[i 5] [acc 1]]
+      (if (= i 0)
+       acc
+       (recur (dec i) (* acc i))))
+    (math.factorial 5))))
 
 
-(defn non-tco-sum [x y]
-  (cond
-    (> y 0) (inc (non-tco-sum x (dec y)))
-    (< y 0) (dec (non-tco-sum x (inc y)))
-    True x))
+(defn test-tco-sum []
 
+  ; This plain old tail-recursive function should exceed Python's
+  ; default maximum recursion depth.
+  (defn non-tco-sum [x y]
+    (cond
+      (> y 0) (inc (non-tco-sum x (dec y)))
+      (< y 0) (dec (non-tco-sum x (inc y)))
+      True x))
+  (with [(pytest.raises RecursionError)]
+    (non-tco-sum 100 10,000))
 
-(defn test-loop []
-  ;; non-tco-sum should fail
-  (try
-   (setv n (non-tco-sum 100 10000))
-   (except [e RuntimeError]
-     (assert True))
-   (else
-    (assert False)))
+  ; With `loop`, it should work.
+  (defn tco-sum [x y]
+    (loop [[x x] [y y]]
+      (cond
+        (> y 0) (recur (inc x) (dec y))
+        (< y 0) (recur (dec x) (inc y))
+        True x)))
+  (assert (= (tco-sum 100 10,000) 10,100)))
 
-  ;; tco-sum should not fail
-  (try
-   (setv n (tco-sum 100 10000))
-   (except [e RuntimeError]
-     (assert False))
-   (else
-    (assert (= n 10100)))))
 
+(defn test-nested []
+  (assert (=
+    (loop [[x 1]]
+      (if (< x 3)
+        (recur (+ x 1))
+        [x (loop [[y 1]]
+          (if (< y 5)
+            (recur (+ y 1))
+            y))]))
+    [3 5])))
 
-(defn test-recur-in-wrong-loc []
-  (defn bad-recur [n]
-    (loop [[i n]]
-          (if (= i 0)
-            0
-            (inc (recur (dec i))))))
 
-  (try
-   (bad-recur 3)
-   (except [e TypeError]
-     (assert True))
-   (else
-    (assert False))))
+(defn test-fancier-args []
+  (assert (=
+    (loop [[x 1] #* a #** b]
+      (if (= x 1)
+        (recur 2 3 4 :foo "bar")
+        [x a b]))
+    [2 #(3 4) {"foo" "bar"}])))
 
 
 (defn test-recur-string []
-  "test that `loop` doesn't touch a string named `recur`"
+  "`loop` shouldn't touch a string named `recur`."
   (assert (= (loop [] (+ "recur" "1")) "recur1")))