Add reduced and friends

CMakeLists.txt

@@ -186,6 +186,7 @@ add_library(
   src/cpp/jank/runtime/obj/native_array_sequence.cpp
   src/cpp/jank/runtime/obj/native_vector_sequence.cpp
   src/cpp/jank/runtime/obj/volatile.cpp
+  src/cpp/jank/runtime/obj/reduced.cpp
   src/cpp/jank/runtime/behavior/callable.cpp
   src/cpp/jank/runtime/behavior/metadatable.cpp
   src/cpp/jank/runtime/math.cpp

include/cpp/jank/runtime/erasure.hpp

@@ -33,6 +33,7 @@
 #include <jank/runtime/obj/native_array_sequence.hpp>
 #include <jank/runtime/obj/native_vector_sequence.hpp>
 #include <jank/runtime/obj/volatile.hpp>
+#include <jank/runtime/obj/reduced.hpp>
 #include <jank/runtime/ns.hpp>
 #include <jank/runtime/var.hpp>
 
@@ -281,6 +282,11 @@ namespace jank::runtime
           return fn(expect_object<obj::volatile_>(erased), std::forward<Args>(args)...);
         }
         break;
+      case object_type::reduced:
+        {
+          return fn(expect_object<obj::volatile_>(erased), std::forward<Args>(args)...);
+        }
+        break;
       case object_type::ns:
         {
           return fn(expect_object<ns>(erased), std::forward<Args>(args)...);

include/cpp/jank/runtime/obj/reduced.hpp

@@ -0,0 +1,31 @@
+#pragma once
+
+namespace jank::runtime
+{
+  template <>
+  struct static_object<object_type::reduced> : gc
+  {
+    static constexpr native_bool pointer_free{ false };
+
+    static_object() = default;
+    static_object(object_ptr o);
+
+    /* behavior::objectable */
+    native_bool equal(object const &) const;
+    native_persistent_string to_string() const;
+    void to_string(fmt::memory_buffer &buff) const;
+    native_hash to_hash() const;
+
+    /* behavior::derefable */
+    object_ptr deref() const;
+
+    object base{ object_type::reduced };
+    object_ptr val{};
+  };
+
+  namespace obj
+  {
+    using reduced = static_object<object_type::reduced>;
+    using reduced_ptr = native_box<reduced>;
+  }
+}

include/cpp/jank/runtime/obj/volatile.hpp

@@ -5,7 +5,7 @@ namespace jank::runtime
   template <>
   struct static_object<object_type::volatile_> : gc
   {
-    static constexpr native_bool pointer_free{ true };
+    static constexpr native_bool pointer_free{ false };
 
     static_object() = default;
     static_object(object_ptr o);

include/cpp/jank/runtime/object.hpp

@@ -41,6 +41,7 @@ namespace jank::runtime
     persistent_list_sequence,
     persistent_set_sequence,
     volatile_,
+    reduced,
     ns,
     var,
     var_thread_binding,

src/cpp/jank/runtime/obj/reduced.cpp

@@ -0,0 +1,40 @@
+#include <jank/runtime/obj/reduced.hpp>
+
+namespace jank::runtime
+{
+  obj::reduced::static_object(object_ptr const o)
+    : val{ o }
+  {
+    assert(val);
+  }
+
+  native_bool obj::reduced::equal(object const &o) const
+  {
+    return &o == &base;
+  }
+
+  native_persistent_string obj::reduced::to_string() const
+  {
+    fmt::memory_buffer buff;
+    to_string(buff);
+    return native_persistent_string{ buff.data(), buff.size() };
+  }
+
+  void obj::reduced::to_string(fmt::memory_buffer &buff) const
+  {
+    fmt::format_to(std::back_inserter(buff),
+                   "{}@{}",
+                   magic_enum::enum_name(base.type),
+                   fmt::ptr(&base));
+  }
+
+  native_hash obj::reduced::to_hash() const
+  {
+    return static_cast<native_hash>(reinterpret_cast<uintptr_t>(this));
+  }
+
+  object_ptr obj::reduced::deref() const
+  {
+    return val;
+  }
+}

src/cpp/jank/runtime/obj/volatile.cpp

@@ -1,4 +1,4 @@
-#include <jank/runtime/obj/nil.hpp>
+#include <jank/runtime/obj/volatile.hpp>
 
 namespace jank::runtime
 {

src/jank/clojure/core.jank

@@ -807,17 +807,72 @@
     ([x y & zs] (not (apply f x y zs)))))
 
 ; Utils.
-; f should be a function of 2 arguments. If val is not supplied,
-; returns the result of applying f to the first 2 items in coll, then
-; applying f to that result and the 3rd item, etc. If coll contains no
-; items, f must accept no arguments as well, and reduce returns the
-; result of calling f with no arguments.  If coll has only 1 item, it
-; is returned and f is not called.  If val is supplied, returns the
-; result of applying f to val and the first item in coll, then
-; applying f to that result and the 2nd item, etc. If coll contains no
-; items, returns val and f is not called.
-; TODO: Support for `reduced`
+(defn deref
+  "Also reader macro: @ref/@agent/@var/@atom/@delay/@future/@promise. Within a transaction,
+  returns the in-transaction-value of ref, else returns the
+  most-recently-committed value of ref. When applied to a var, agent
+  or atom, returns its current state. When applied to a delay, forces
+  it if not already forced. When applied to a future, will block if
+  computation not complete. When applied to a promise, will block
+  until a value is delivered.  The variant taking a timeout can be
+  used for blocking references (futures and promises), and will return
+  timeout-val if the timeout (in milliseconds) is reached before a
+  value is available. See also - realized?."
+  ([ref]
+   (native/raw "__value = visit_object
+               (
+                [=](auto const typed_ref) -> object_ptr
+                {
+                 using T = typename decltype(typed_ref)::value_type;
+
+                 if constexpr(behavior::derefable<T>)
+                 { return typed_ref->deref(); }
+                 else
+                 { ~{ (throw (ex-info :not-derefable {:ref ref})) }; }
+                 },
+                ~{ ref }
+               );"))
+  ; TODO: Blocking.
+  ([ref timeout-ms timeout-val]
+   ;(if (instance? clojure.lang.IBlockingDeref ref)
+   ;  (.deref ^clojure.lang.IBlockingDeref ref timeout-ms timeout-val)
+   ;  (deref-future ref timeout-ms timeout-val))
+   ))
+
+(defn reduced
+  "Wraps x in a way such that a reduce will terminate with the value x"
+  [x]
+  (native/raw "__value = make_box<obj::reduced>(~{ x });"))
+
+(defn reduced?
+  "Returns true if x is the result of a call to reduced"
+  ([x]
+   (native/raw "__value = make_box(~{ x }->type == object_type::reduced);")))
+
+(defn ensure-reduced
+  "If x is already reduced?, returns it, else returns (reduced x)"
+  [x]
+  (if (reduced? x)
+    x
+    (reduced x)))
+
+(defn unreduced
+  "If x is reduced?, returns (deref x), else returns x"
+  [x]
+  (if (reduced? x)
+    (deref x)
+    x))
+
 (defn reduce
+  "f should be a function of 2 arguments. If val is not supplied,
+  returns the result of applying f to the first 2 items in coll, then
+  applying f to that result and the 3rd item, etc. If coll contains no
+  items, f must accept no arguments as well, and reduce returns the
+  result of calling f with no arguments.  If coll has only 1 item, it
+  is returned and f is not called.  If val is supplied, returns the
+  result of applying f to val and the first item in coll, then
+  applying f to that result and the 2nd item, etc. If coll contains no
+  items, returns val and f is not called."
   ([f coll]
    (let [s (seq coll)]
      (if s
@@ -830,7 +885,14 @@
                 {
                   object_ptr res{ ~{ val } };
                   for(auto it(typed_coll->fresh_seq()); it != nullptr; it = next_in_place(it))
-                  { res = dynamic_call(~{ f }, res, it->first()); }
+                  {
+                    res = dynamic_call(~{ f }, res, it->first());
+                    if(res->type == object_type::reduced)
+                    {
+                      res = expect_object<obj::reduced>(res)->val;
+                      break;
+                    }
+                  }
                   return res;
                  },
                 [=]() -> object_ptr
@@ -903,38 +965,6 @@
   [coll]
   (native/raw "__value = runtime::pop(~{ coll });"))
 
-(defn deref
-  "Also reader macro: @ref/@agent/@var/@atom/@delay/@future/@promise. Within a transaction,
-  returns the in-transaction-value of ref, else returns the
-  most-recently-committed value of ref. When applied to a var, agent
-  or atom, returns its current state. When applied to a delay, forces
-  it if not already forced. When applied to a future, will block if
-  computation not complete. When applied to a promise, will block
-  until a value is delivered.  The variant taking a timeout can be
-  used for blocking references (futures and promises), and will return
-  timeout-val if the timeout (in milliseconds) is reached before a
-  value is available. See also - realized?."
-  ([ref]
-   (native/raw "__value = visit_object
-               (
-                [=](auto const typed_ref) -> object_ptr
-                {
-                 using T = typename decltype(typed_ref)::value_type;
-
-                 if constexpr(behavior::derefable<T>)
-                 { return typed_ref->deref(); }
-                 else
-                 { ~{ (throw (ex-info :not-derefable {:ref ref})) }; }
-                 },
-                ~{ ref }
-               );"))
-  ; TODO: Blocking.
-  ([ref timeout-ms timeout-val]
-   ;(if (instance? clojure.lang.IBlockingDeref ref)
-   ;  (.deref ^clojure.lang.IBlockingDeref ref timeout-ms timeout-val)
-   ;  (deref-future ref timeout-ms timeout-val))
-   ))
-
 ; Volatiles.
 (defn volatile!
   "Creates and returns a Volatile with an initial value of val."