mitranim · June 7, 2021 11:49 · Mar 11, 2018 · Oct 24, 2017 · Oct 24, 2017
diff --git a/flat-block-macros.clj b/flat-block-macros.clj
@@ -1,27 +1,32 @@
+(defmacro return-or [sym expr] {:pre [(symbol? sym)]}
+  `(if (reduced? ~sym) (unreduced ~sym) ~expr))
 
-(defn block-imp [exprs]
-  (when-let [[expr & tail-exprs] (seq exprs)]
-    (match expr
+(defn imp-block [[expr & tail-exprs]]
+  (match expr
 
-      (('let pattern init) :seq)
-      (match (block-imp tail-exprs)
+    (('let pattern init) :seq)
+    (if-not tail-exprs
+      (list init)
+      (match (imp-block tail-exprs)
         (((((:or 'let `let) bindings & tail) :seq)) :seq)
         `((let [~pattern ~init ~@bindings] ~@tail))
         block-tail
-        `((let [~pattern ~init] ~@block-tail)))
+        `((let [~pattern ~init] ~@block-tail))))
 
-      (('let & _) :seq)
-      (throw (new IllegalArgumentException
-                  "in 'imp' root, 'let' must have the form: (let pattern init)"))
+    (('let & _) :seq)
+    (throw (new IllegalArgumentException
+                "in the root of an `imp` block, `let` must have the form: (let pattern init)"))
 
-      :else
-      `(~expr ~@(block-imp tail-exprs)))))
+    :else
+    (if-not tail-exprs
+      (list expr)
+      `(~expr ~@(imp-block tail-exprs)))))
 
 (defn list-to-expr [[expr & tail-exprs]]
   (if-not tail-exprs expr `(do ~expr ~@tail-exprs)))
 
 (defmacro imp
-  "Variant of a 'do' block where 'let' emulates imperative-style variable
+  "Variant of a `do` block where `let` emulates imperative-style variable
   assignment. Convenient for inserting assertions and other side-effectul
   operations between bindings.
 
@@ -35,97 +40,94 @@
       <exprs>
       ...)
 
-  Each 'let' creates a subscope. Adjacent lets are merged together.
+  Each `let` creates a subscope. Adjacent lets are merged together.
 
   Examines only the let expressions at the root level that start with the
   raw 'let symbol. Ignores subforms and 'clojure.core/let."
   [& exprs]
-  (list-to-expr (block-imp exprs)))
-
-
-
-(defn err? [value]
-  (and (instance? clojure.lang.ILookup value)
-       (contains? value :error)))
-
-(defn to-err [value] (if (err? value) value {:error value}))
-
-(defn err-when [value] (when value (to-err value)))
+  (list-to-expr (imp-block exprs)))
 
 
 
 (defmacro do?
-  "Variant of a 'do' block with early interruption, in the style of
-  Haskell's 'do' notation. Supports the popular Clojure pattern
-  of '{:error _}' vs result.
-
-  When a subform evaluates to '{:error _}', the block short-curcuits,
-  immediately returning this value.
-
-  See also: 'err?', 'to-err'.
+  "Variant of a `do` block with early interruption via clojure.core/reduced.
+  When a subform satisfies clojure.core/reduced?, the block short-curcuits,
+  immediately returning that value.
 
   Expansion:
 
     (do?
-      expr  |  (let [value expr] (if (err? value) value
-      expr  |    (let [value expr] (if (err? value) value
-      expr  |      (let [value expr] (if (err? value) value)))))))
+      expr  |  (let [value expr] (if (reduced? value) (unreduced value)
+      expr  |    (let [value expr] (if (reduced? value) (unreduced value)
+      expr  |      (let [value expr] (if (reduced? value) (unreduced value) value)))))))
   "
-  [& exprs]
-  (when-let [[expr & tail-exprs] (seq exprs)]
-    (if-not tail-exprs
-      expr
-      `(let [value# ~expr]
-         (if (err? value#) value# (do? ~@tail-exprs))))))
+  [& [expr & tail-exprs]]
+  (if tail-exprs
+    `(let [value# ~expr]
+       (return-or value# (do? ~@tail-exprs)))
+    `(unreduced ~expr)))
 
 
 
-(defn expr-imp? [[expr & tail-exprs]]
-  (if-not tail-exprs
-    expr
+(defn imp?-expr [exprs]
+  (when-let [[expr & tail-exprs] (seq exprs)]
     (match expr
 
       (('let pattern init) :seq)
       `(let [value# ~init]
-         (if (err? value#) value# (let [~pattern value#] ~(expr-imp? tail-exprs))))
+         (return-or
+           value#
+           (let [~pattern value#] ~(imp?-expr tail-exprs))))
 
       (('let & _) :seq)
       (throw (new IllegalArgumentException
-                  "in 'imp' root, 'let' must have the form: (let pattern init)"))
+                  "in the root of an `imp?` block, `let` must have the form: (let pattern init)"))
 
       :else
-      `(let [value# ~expr]
-         (if (err? value#) value# ~(expr-imp? tail-exprs))))))
+      (if
+        tail-exprs
+        `(let [value# ~expr]
+           (return-or value# ~(imp?-expr tail-exprs)))
+        `(unreduced ~expr)))))
 
 (defmacro imp?
-  "Variant of a 'do' block that emulates imperative assignment and early
-  interruption. Based on 'imp' and 'do?'. See '(doc imp)' for assignment,
-  and '(doc do?)' for interruption.
+  "Variant of a `do` block that emulates imperative assignment and supports
+  early interruption via clojure.core/reduced. Conceptual combination of `imp`
+  and `do?`. See `(doc imp)` for assignment, and `(doc do?)` for interruption.
 
   Usage:
 
     (imp?
-      (let pattern error-or-result)
-      (let pattern error-or-result)
-      error-or-result
-      error-or-result
-      (let pattern error-or-result)
-      error-or-result
+      (let [one two] (range 10))
+      (when (> one 10)
+        (reduced :early-result))
+      (let [three four] (range 20))
+      :late-result)
+
+  General form:
+
+    (imp?
+      (let pattern reduced-or-result)
+      (let pattern reduced-or-result)
+      reduced-or-result
+      reduced-or-result
+      (let pattern reduced-or-result)
+      reduced-or-result
       ...)
 
   Expansion:
 
     (imp?
-      (let pattern init)  |  (let [result init] (if (err? result) result (let [pattern result]
-      (let pattern init)  |    (let [result init] (if (err? result) result (let [pattern result]
-      expr                |      (let [result expr] (if (err? result) result
-      (let pattern init)  |        (let [result init] (if (err? result) result (let [pattern result]
-      expr                |          (let [result expr] (if (err? result) result
-      expr                |            (let [result expr] (if (err? result) result
-      (let pattern init)  |              (let [result init] (if (err? result) result (let [pattern result]
-      (let pattern init)  |                (let [result init] (if (err? result) result (let [pattern result]
-      expr                |                  (let [result expr] (if (err? result) result
-      expr                |                    (let [result expr] (if (err? result) result)))))))))))))))))))))))))
+      (let pattern init)  |  (let [value init] (if (reduced? value) (unreduced value) (let [pattern value]
+      (let pattern init)  |    (let [value init] (if (reduced? value) (unreduced value) (let [pattern value]
+      expr                |      (let [value expr] (if (reduced? value) (unreduced value)
+      (let pattern init)  |        (let [value init] (if (reduced? value) (unreduced value) (let [pattern value]
+      expr                |          (let [value expr] (if (reduced? value) (unreduced value)
+      expr                |            (let [value expr] (if (reduced? value) (unreduced value)
+      (let pattern init)  |              (let [value init] (if (reduced? value) (unreduced value) (let [pattern value]
+      (let pattern init)  |                (let [value init] (if (reduced? value) (unreduced value) (let [pattern value]
+      expr                |                  (let [value expr] (if (reduced? value) (unreduced value)
+      expr                |                    (let [value expr] (if (reduced? value) (unreduced value) value)))))))))))))))))))))))))
   "
   [& exprs]
-  (expr-imp? exprs))
+  (imp?-expr exprs))
diff --git a/flat-block-macros.clj b/flat-block-macros.clj
@@ -1,4 +1,59 @@
 
+(defn block-imp [exprs]
+  (when-let [[expr & tail-exprs] (seq exprs)]
+    (match expr
+
+      (('let pattern init) :seq)
+      (match (block-imp tail-exprs)
+        (((((:or 'let `let) bindings & tail) :seq)) :seq)
+        `((let [~pattern ~init ~@bindings] ~@tail))
+        block-tail
+        `((let [~pattern ~init] ~@block-tail)))
+
+      (('let & _) :seq)
+      (throw (new IllegalArgumentException
+                  "in 'imp' root, 'let' must have the form: (let pattern init)"))
+
+      :else
+      `(~expr ~@(block-imp tail-exprs)))))
+
+(defn list-to-expr [[expr & tail-exprs]]
+  (if-not tail-exprs expr `(do ~expr ~@tail-exprs)))
+
+(defmacro imp
+  "Variant of a 'do' block where 'let' emulates imperative-style variable
+  assignment. Convenient for inserting assertions and other side-effectul
+  operations between bindings.
+
+  Usage:
+
+    (imp
+      (let pattern <expr>)
+      (when-not <assertion> (throw <fail>))
+      (let pattern <expr>)
+      (let pattern <expr>)
+      <exprs>
+      ...)
+
+  Each 'let' creates a subscope. Adjacent lets are merged together.
+
+  Examines only the let expressions at the root level that start with the
+  raw 'let symbol. Ignores subforms and 'clojure.core/let."
+  [& exprs]
+  (list-to-expr (block-imp exprs)))
+
+
+
+(defn err? [value]
+  (and (instance? clojure.lang.ILookup value)
+       (contains? value :error)))
+
+(defn to-err [value] (if (err? value) value {:error value}))
+
+(defn err-when [value] (when value (to-err value)))
+
+
+
 (defmacro do?
   "Variant of a 'do' block with early interruption, in the style of
   Haskell's 'do' notation. Supports the popular Clojure pattern

diff --git a/flat-block-macros.clj b/flat-block-macros.clj
@@ -0,0 +1,76 @@
+
+(defmacro do?
+  "Variant of a 'do' block with early interruption, in the style of
+  Haskell's 'do' notation. Supports the popular Clojure pattern
+  of '{:error _}' vs result.
+
+  When a subform evaluates to '{:error _}', the block short-curcuits,
+  immediately returning this value.
+
+  See also: 'err?', 'to-err'.
+
+  Expansion:
+
+    (do?
+      expr  |  (let [value expr] (if (err? value) value
+      expr  |    (let [value expr] (if (err? value) value
+      expr  |      (let [value expr] (if (err? value) value)))))))
+  "
+  [& exprs]
+  (when-let [[expr & tail-exprs] (seq exprs)]
+    (if-not tail-exprs
+      expr
+      `(let [value# ~expr]
+         (if (err? value#) value# (do? ~@tail-exprs))))))
+
+
+
+(defn expr-imp? [[expr & tail-exprs]]
+  (if-not tail-exprs
+    expr
+    (match expr
+
+      (('let pattern init) :seq)
+      `(let [value# ~init]
+         (if (err? value#) value# (let [~pattern value#] ~(expr-imp? tail-exprs))))
+
+      (('let & _) :seq)
+      (throw (new IllegalArgumentException
+                  "in 'imp' root, 'let' must have the form: (let pattern init)"))
+
+      :else
+      `(let [value# ~expr]
+         (if (err? value#) value# ~(expr-imp? tail-exprs))))))
+
+(defmacro imp?
+  "Variant of a 'do' block that emulates imperative assignment and early
+  interruption. Based on 'imp' and 'do?'. See '(doc imp)' for assignment,
+  and '(doc do?)' for interruption.
+
+  Usage:
+
+    (imp?
+      (let pattern error-or-result)
+      (let pattern error-or-result)
+      error-or-result
+      error-or-result
+      (let pattern error-or-result)
+      error-or-result
+      ...)
+
+  Expansion:
+
+    (imp?
+      (let pattern init)  |  (let [result init] (if (err? result) result (let [pattern result]
+      (let pattern init)  |    (let [result init] (if (err? result) result (let [pattern result]
+      expr                |      (let [result expr] (if (err? result) result
+      (let pattern init)  |        (let [result init] (if (err? result) result (let [pattern result]
+      expr                |          (let [result expr] (if (err? result) result
+      expr                |            (let [result expr] (if (err? result) result
+      (let pattern init)  |              (let [result init] (if (err? result) result (let [pattern result]
+      (let pattern init)  |                (let [result init] (if (err? result) result (let [pattern result]
+      expr                |                  (let [result expr] (if (err? result) result
+      expr                |                    (let [result expr] (if (err? result) result)))))))))))))))))))))))))
+  "
+  [& exprs]
+  (expr-imp? exprs))