diff --git a/CMakeLists.txt b/CMakeLists.txt index 851bff589..036888040 100644 --- a/CMakeLists.txt +++ b/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 diff --git a/include/cpp/jank/runtime/erasure.hpp b/include/cpp/jank/runtime/erasure.hpp index 23ee45582..618315c04 100644 --- a/include/cpp/jank/runtime/erasure.hpp +++ b/include/cpp/jank/runtime/erasure.hpp @@ -33,6 +33,7 @@ #include #include #include +#include #include #include @@ -281,6 +282,11 @@ namespace jank::runtime return fn(expect_object(erased), std::forward(args)...); } break; + case object_type::reduced: + { + return fn(expect_object(erased), std::forward(args)...); + } + break; case object_type::ns: { return fn(expect_object(erased), std::forward(args)...); diff --git a/include/cpp/jank/runtime/obj/reduced.hpp b/include/cpp/jank/runtime/obj/reduced.hpp new file mode 100644 index 000000000..1161971c1 --- /dev/null +++ b/include/cpp/jank/runtime/obj/reduced.hpp @@ -0,0 +1,31 @@ +#pragma once + +namespace jank::runtime +{ + template <> + struct static_object : 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; + using reduced_ptr = native_box; + } +} diff --git a/include/cpp/jank/runtime/obj/volatile.hpp b/include/cpp/jank/runtime/obj/volatile.hpp index ed5cd1a03..b04833e89 100644 --- a/include/cpp/jank/runtime/obj/volatile.hpp +++ b/include/cpp/jank/runtime/obj/volatile.hpp @@ -5,7 +5,7 @@ namespace jank::runtime template <> struct static_object : gc { - static constexpr native_bool pointer_free{ true }; + static constexpr native_bool pointer_free{ false }; static_object() = default; static_object(object_ptr o); diff --git a/include/cpp/jank/runtime/object.hpp b/include/cpp/jank/runtime/object.hpp index 4ef79ee12..9bd4e037e 100644 --- a/include/cpp/jank/runtime/object.hpp +++ b/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, diff --git a/src/cpp/jank/runtime/obj/reduced.cpp b/src/cpp/jank/runtime/obj/reduced.cpp new file mode 100644 index 000000000..b253048a6 --- /dev/null +++ b/src/cpp/jank/runtime/obj/reduced.cpp @@ -0,0 +1,40 @@ +#include + +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(reinterpret_cast(this)); + } + + object_ptr obj::reduced::deref() const + { + return val; + } +} diff --git a/src/cpp/jank/runtime/obj/volatile.cpp b/src/cpp/jank/runtime/obj/volatile.cpp index e8b101e23..4a3d4100e 100644 --- a/src/cpp/jank/runtime/obj/volatile.cpp +++ b/src/cpp/jank/runtime/obj/volatile.cpp @@ -1,4 +1,4 @@ -#include +#include namespace jank::runtime { diff --git a/src/jank/clojure/core.jank b/src/jank/clojure/core.jank index f3ccb81ab..d012c34fa 100644 --- a/src/jank/clojure/core.jank +++ b/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) + { 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(~{ 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(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) - { 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."