MVar

CMakeLists.txt

@@ -20,6 +20,11 @@ list(APPEND
     "$<$<OR:$<CXX_COMPILER_ID:Clang>,$<CXX_COMPILER_ID:AppleClang>,$<CXX_COMPILER_ID:GNU>>:-Wall;-Wextra;-pedantic;-Werror;-Wno-parentheses;-Wno-shadow;-Wconversion;-Wsign-conversion>"
         "$<$<CXX_COMPILER_ID:MSVC>:/W4>") # /WX for -Werror
 
+# Fix atomic lib linking for gcc.
+list(APPEND
+    BASE_ADDITIONAL_LIBS
+    "$<$<OR:$<CXX_COMPILER_ID:Clang>,$<CXX_COMPILER_ID:GNU>>:atomic>")
+
 set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${PROJECT_BINARY_DIR}/bin)
 set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY ${PROJECT_BINARY_DIR}/lib)
 set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${PROJECT_BINARY_DIR}/lib)

include/hspp.h

@@ -1262,18 +1262,32 @@ template <typename T>
 constexpr static auto isIOV = IsIO<std::decay_t<T>>::value;
 
 template <typename Func>
-auto io(Func func)
+constexpr auto io(Func func)
 {
     using Data = std::invoke_result_t<Func>;
-    return IO<Data, Func>{func};
+    return IO<Data, Func>{std::move(func)};
 }
 
 template <typename Data>
-auto ioData(Data data)
+constexpr auto ioData(Data data)
 {
     return io([data=std::move(data)] { return data; });
 }
 
+template <typename Data, typename Func>
+constexpr auto toTEIOImpl(IO<Data, Func> const& p)
+{
+    return IO<Data>{[p]{
+        return p.run();
+    }};
+}
+
+constexpr auto toTEIO = toGFunc<1> | [](auto p)
+{
+    return toTEIOImpl(p);
+};
+
+
 constexpr auto putChar = toFunc<> | [](char c)
 {
     return io(
@@ -2663,7 +2677,7 @@ class Functor<data::Reader, FirstArg>
     template <typename Func, typename Repr, typename Ret, typename... Args>
     constexpr static auto fmap(Func&& func, data::Reader<FirstArg, Ret, Repr> const& in)
     {
-        return data::toReader | func <o> (data::runReader | in);
+        return data::toReader || func <o> (data::runReader | in);
     }
 };
 
@@ -2832,12 +2846,12 @@ class Applicative<data::Reader, FirstArg> : public Functor<data::Reader, FirstAr
 public:
     constexpr static auto pure = toGFunc<1> | [](auto ret)
     {
-        return data::toReader | data::toFunc<>([ret=std::move(ret)](FirstArg){ return ret; });
+        return data::toReader || data::toFunc<>([ret=std::move(ret)](FirstArg){ return ret; });
     };
     template <typename Reader1, typename Reader2>
     constexpr static auto ap(Reader1 func, Reader1 in)
     {
-        return data::toReader | data::toFunc<>(
+        return data::toReader || data::toFunc<>(
             [func=std::move(func), in=std::move(in)](FirstArg arg)
             {
                 return data::runReader | func | arg || data::runReader | in | arg;
@@ -3564,6 +3578,17 @@ constexpr auto nullary(T const &t)
     return Nullary<T>{t};
 }
 
+template <typename T>
+constexpr auto toTENullaryImpl(Nullary<T> const &t)
+{
+    return nullary(std::function<std::invoke_result_t<T>>{t});
+}
+
+constexpr auto toTENullary = toGFunc<1> | [](auto const& t)
+{
+    return toTENullaryImpl(t);
+};
+
 template <typename T>
 class IsNullary : public std::false_type
 {
@@ -3577,6 +3602,13 @@ class IsNullary<Nullary<T>> : public std::true_type
 template <typename T>
 constexpr auto isNullary = IsNullary<std::decay_t<T>>::value;
 
+template <typename ClassT, typename T , typename = std::enable_if_t<isNullary<T>, void>>
+constexpr auto evalDeferredImpl(T&& t)
+{
+    static_assert(std::is_same_v<MonadType<ClassT>, MonadType<std::invoke_result_t<T>>>);
+    return t();
+}
+
 template <typename T>
 class IsNullaryOrId : public IsNullary<T>
 {
@@ -3825,7 +3857,15 @@ template <typename Head, typename... Rest>
 constexpr auto do_(Head const& head, Rest const&... rest)
 {
     using MClass = MonadClassType<Head, Rest...>;
-    return doImpl<MClass>(head, rest...);
+    auto result = doImpl<MClass>(head, rest...);
+    static_assert(!isNullaryOrIdV<decltype(result)>);
+    return result;
+}
+
+template <typename... Args>
+constexpr auto doInner(Args&&... args)
+{
+    return nullary([=] { return do_(evaluate_(args)...); });
 }
 
 template <typename Head, typename... Rest>

test/hspp/CMakeLists.txt

@@ -1,6 +1,5 @@
 add_executable(unittests test.cpp stm.cpp)
 target_include_directories(unittests PRIVATE)
-target_compile_options(unittests PRIVATE ${BASE_COMPILE_FLAGS})
-target_link_libraries(unittests PRIVATE hspp gtest_main)
+target_link_libraries(unittests PRIVATE hspp gtest_main ${BASE_ADDITIONAL_LIBS})
 set_target_properties(unittests PROPERTIES CXX_EXTENSIONS OFF)
 gtest_discover_tests(unittests)

test/hspp/stm.cpp

@@ -6,6 +6,7 @@
 #include <cctype>
 #include <thread>
 #include <atomic>
+#include <shared_mutex>
 
 using namespace hspp;
 using namespace hspp::data;
@@ -51,31 +52,216 @@ TEST(forkIO, 1)
     io_.run();
 }
 
-TEST(forkIO, 2)
+constexpr auto setReminder = toFunc<> | [](std::string const& s)
 {
-    auto setReminder = toFunc<> | [](std::string const& s)
-    {
-        Id<size_t> n;
-        return do_(
-            n = (hspp::read<size_t> | s),
-            putStr | "Ok, I'll remind you in ",
-            print | n,
-            putStrLn | " seconds",
-            threadDelay | (1000000U * n),
-            print | n,
-            putStrLn | " seconds is up! BING!BEL"
-        );
-    };
+    Id<size_t> n;
+    return do_(
+        n = (hspp::read<size_t> | s), // let expression.
+        putStr | "Ok, I'll remind you in ",
+        print | n,
+        putStrLn | " seconds",
+        threadDelay | (1000000U * n),
+        print | n,
+        putStrLn | " seconds is up! BING!BEL"
+    );
+};
 
+TEST(forkIO, 2)
+{
     Id<std::string> s;
     auto io_ = forever || do_(
         s <= getLine,
         forkIO || setReminder | s
     );
     // io.run();
     (void)io_;
+
+}
+
+TEST(forkIO, 3)
+{
+    IO<_O_> loop0 = []{ return _o_; };
+    auto loop = loop0;
+
+    Id<std::string> s;
+    loop = toTEIO | do_(
+        s <= getLine,
+        ifThenElse(s == "exit")
+            || loop0
+            || toTEIO | (doInner(forkIO || setReminder | s,
+                nullary([&]{ return loop;}))) // capturing by ref is important, so that loop is not fixed to loop0.
+    );
+
+    // loop.run();
+    (void)loop;
+}
+
+template <typename A>
+struct MVar
+{
+    using T = std::pair<std::optional<A>, std::shared_mutex>;
+    std::shared_ptr<T> data = std::make_shared<T>();
+    MVar() = default;
+    MVar(A a)
+    : data{std::make_shared<T>(a, {})}
+    {}
+};
+
+template <typename A>
+constexpr auto newEmptyMVar = io([]{ return MVar<A>{}; });
+
+template <typename A>
+constexpr auto newMVarImpl(A a)
+{
+    return io([&]{ return MVar<A>{std::move(a)}; });
+}
+
+constexpr auto newMVar = toGFunc<1> | [](auto a)
+{
+    return newMVarImpl(a);
+};
+
+template <typename A>
+constexpr auto takeMVarImpl(MVar<A> const& a)
+{
+    return io([a]
+    {
+        while (true)
+        {
+            {
+                std::unique_lock lock{a.data->second};
+                if (a.data->first.has_value())
+                {
+                    auto result = std::move(a.data->first.value());
+                    a.data->first.reset();
+                    return result;
+                }
+            }
+            std::this_thread::yield();
+        }
+    });
+}
+
+constexpr auto takeMVar = toGFunc<1> | [](auto a)
+{
+    return takeMVarImpl(a);
+};
+
+template <typename A>
+constexpr auto putMVarImpl(MVar<A>& a, A new_)
+{
+    return io([a, new_]
+    {
+        while (true)
+        {
+            {
+                std::unique_lock lock{a.data->second};
+                if (!a.data->first.has_value())
+                {
+                    a.data->first = new_;
+                    return _o_;
+                }
+            }
+            std::this_thread::yield();
+        }
+    });
+}
+
+constexpr auto putMVar = toGFunc<2> | [](auto a, auto new_)
+{
+    return putMVarImpl(a, new_);
+};
+
+TEST(MVar, 1)
+{
+    (void)newMVar;
+
+    Id<MVar<char>> m;
+    Id<char> r;
+    auto const io_ = do_(
+        m <= newEmptyMVar<char>,
+        forkIO || putMVar | m | 'x',
+        r <= (takeMVar | m),
+        print | r
+    );
+    io_.run();
+}
+
+TEST(MVar, 2)
+{
+    Id<MVar<char>> m;
+    Id<char> r;
+    auto io_ = do_(
+        m <= newEmptyMVar<char>,
+        forkIO || doInner(
+            putMVar | m | 'x',
+            putMVar | m | 'y'
+        ),
+        r <= (takeMVar | m),
+        print | r,
+        r <= (takeMVar | m),
+        print | r
+    );
+    io_.run();
+}
+
+TEST(MVar, 3)
+{
+    Id<MVar<char>> m;
+    auto io_ = do_(
+        m <= newEmptyMVar<char>,
+        takeMVar | m
+    );
+    // stuck
+    (void)io_;
+    // io_.run();
 }
 
+#if 0
+class Message : public std::string{};
+class Stop : public MVar<_O_>{};
+
+using LogCommand = std::variant<Message, Stop>;
+class Logger : public MVar<LogCommand>{};
+
+
+auto logger(Logger& m)
+{
+    IO<_O_> loop0 = []{ return _o_; };
+    auto loop = loop0;
+
+    auto const dispatchCmd = toFunc<> | [&loop](LogCommand const& lc)
+    {
+        return std::visit(overload(
+            [&](Message const& msg){
+                return toTEIO | do_(print | msg, loop);
+            },
+            [](Stop s){
+                return toTEIO | do_(putStrLn | "logger: stop", putMVar | s | _o_);
+            }
+        ), lc);
+    };
+
+    Id<LogCommand> cmd;
+    loop = toTEIO | do_(
+        cmd <= (takeMVar | m),
+        dispatchCmd | cmd
+    );
+}
+
+constexpr auto initLoggerImpl()
+{
+    Id<LogCommand> m;
+    Id<Logger> l;
+    return do_(
+        m <= newEmptyMVar<LogCommand>,
+        l = (Logger | m),
+        forkIO | (logger | l),
+        return_ | l
+    );
+}
+#endif // 0
+
 template <typename A>
 struct IORef
 {