From 7473e7fd4c30b24eb72440eb4db952bf31fcb431 Mon Sep 17 00:00:00 2001
From: Bowen Fu <missing>
Date: Thu, 28 Jul 2022 21:22:17 +0800
Subject: [PATCH 1/6] Implement STM part 6

---
 test/hspp/stm.cpp | 135 +++++++++++++++++++++++++++++++---------------
 1 file changed, 93 insertions(+), 42 deletions(-)

diff --git a/test/hspp/stm.cpp b/test/hspp/stm.cpp
index 6c56d4f..616215d 100644
--- a/test/hspp/stm.cpp
+++ b/test/hspp/stm.cpp
@@ -458,6 +458,16 @@ struct TVar
     IORef<std::vector<MVar<_O_>>> waitQueue;
 };
 
+// constexpr auto newTVar = toGFunc<1> | [](auto a)
+// {
+//     using A = decltype(a);
+//     return io([&]
+//     {
+//         auto const readStamp = readIORef(globalClock).run();
+//         return TVar<A>{myTId.run(), initIORef(readStamp), {}, {}};
+//     });
+// };
+
 struct RSE
 {
     ID id;
@@ -500,7 +510,8 @@ class Commiter
 template <typename T>
 class CommitterRegister
 {
-    CommitterRegister()
+public:
+    constexpr CommitterRegister()
     {
         anyCommiters.emplace(std::type_index(typeid(T)), Commiter<T>{});
     }
@@ -509,7 +520,7 @@ class CommitterRegister
 template <typename A>
 struct WSEData
 {
-    static const CommitterRegister<A> dummy{};
+    constexpr static CommitterRegister<A> dummy{};
     IORef<A> content;
     A newValue;
 };
@@ -524,7 +535,7 @@ struct WSE
 
 constexpr auto toWSE = toGFunc<5> | [](Lock lock, IORef<Integer> writeStamp, IORef<std::vector<MVar<_O_>>> waitQueue, auto content, auto newValue)
 {
-    return WSE{lock, writeStamp, waitQueue, WSEData{content, newValue}};
+    return WSE{lock, writeStamp, waitQueue, WSEData<decltype(newValue)>{content, newValue}};
 };
 
 using ReadSet = IORef<std::set<RSE>>;
@@ -596,11 +607,10 @@ TEST(atomCAS, clock)
 
 template <typename A>
 class Valid : public std::pair<TState, A>
-{};
-
-constexpr auto toValid = toGFunc<2> | [](TState ts, auto a)
 {
-    return Valid{ts, a};
+public:
+    using T = A;
+    using std::pair<TState, A>::pair;
 };
 
 class Retry : public TState
@@ -614,6 +624,12 @@ class TResult : public std::variant<Valid<A>, Retry, Invalid>
 {
 public:
     using DataT = A;
+    using std::variant<Valid<A>, Retry, Invalid>::variant;
+};
+
+constexpr auto toValid = toGFunc<2> | [](TState ts, auto a)
+{
+    return TResult<decltype(a)>{Valid<decltype(a)>{ts, a}};
 };
 
 template <typename A, typename Func>
@@ -627,7 +643,7 @@ class STM
     constexpr STM(Func func)
     : mFunc{std::move(func)}
     {}
-    auto run(TState tState) const
+    auto run(TState tState) const -> RetT
     {
         return mFunc(tState);
     }
@@ -649,11 +665,6 @@ constexpr auto toSTM = toGFunc<1> | [](auto func)
     return toSTMImpl(func);
 };
 
-constexpr auto castToPtr = toGFunc<1> | [](auto obj)
-{
-    return ioData(std::any{obj});
-};
-
 constexpr auto putWS = toFunc<> | [](WriteSet ws, ID id, WSE wse)
 {
     return io([=]
@@ -691,9 +702,8 @@ constexpr auto writeTVarImpl(TVar<A> const& tvar, A const& newValue)
     return toSTM | [=](auto tState)
     {
         auto [lock, id, wstamp, content, queue] = tvar;
-        Id<WSE> wse;
+        WSE wse = (toWSE | lock | wstamp | queue | content | newValue);
         return do_(
-            wse <= (toWSE | lock | wstamp | queue | content | newValue),
             putWS | (getWriteSet | tState) | id | wse,
             return_ | (toValid | tState | _o_)
         );
@@ -718,28 +728,28 @@ constexpr auto readTVarImpl(TVar<A> const tvar)
 {
     return toSTM | [=](TState tState)
     {
-        Id<std::optional<std::any>> mptr;
-        auto const handleMPtr = toFunc<> | [=](TState tState, std::optional<WSE> mptr_)
+        Id<std::optional<WSE>> mwse;
+        auto const handleMWse = toFunc<> | [=](TState tState, std::optional<WSE> mwse_)
         {
             return io([=]() -> TResult<A>
             {
-                if (mptr_.has_value())
+                if (mwse_.has_value())
                 {
-                    auto const& wse = mptr_.value();
+                    auto const& wse = mwse_.value();
                     auto const& wseData = std::any_cast<WSEData<A> const&>(wse.wseData);
-                    return toValid | tState | wseData.newData;
+                    return toValid | tState | wseData.newValue;
                 }
                 else
                 {
                     auto [lock, id, wstamp, content, queue] = tvar;
 
-                    auto const lockVal = lock.data.get();
+                    auto lockVal = (readLock | lock).run();
                     if (isLocked | lockVal)
                     {
                         return Invalid{tState};
                     }
-                    auto const result = content.data.get();
-                    auto const lockVal2 = lock.data.get();
+                    auto const result = (readIORef | content).run();
+                    auto lockVal2 = (readLock | lock).run();
                     if ((lockVal != lockVal2) || (lockVal > (tState.readStamp)))
                     {
                         return Invalid{tState};
@@ -751,8 +761,8 @@ constexpr auto readTVarImpl(TVar<A> const tvar)
             });
         };
         return do_(
-            mptr <= (lookUpWS | (getWriteSet | tState) | tvar.id),
-            handleMPtr | tState | mptr
+            mwse <= (lookUpWS | (getWriteSet | tState) | tvar.id),
+            handleMWse | tState | mwse
         );
     };
 }
@@ -771,11 +781,11 @@ template <>
 class Applicative<STM>
 {
 public:
-    template <typename A, typename Repr>
-    constexpr static auto pure(A x)
+    constexpr static auto pure = toGFunc<1> | [](auto x)
     {
+        using A = decltype(x);
         return toSTM | [=](auto tState) { return ioData<TResult<A>>(toValid | tState | x); };
-    }
+    };
 };
 
 
@@ -784,7 +794,7 @@ class MonadBase<STM>
 {
 public:
     template <typename A, typename Repr, typename Func>
-    constexpr static auto bind(STM<A, Repr> const& t1, Func const& f)
+    constexpr static auto bind(STM<A, Repr> const& t1, Func const& func)
     {
         return toSTM || [=](TState tState)
         {
@@ -793,26 +803,28 @@ class MonadBase<STM>
             {
                 return io([=]
                 {
+                    using T = typename std::decay_t<decltype(func(std::declval<A>()).run(std::declval<TState>()).run())>::DataT;
+                    using RetT = TResult<T>;
                     return std::visit(overload(
-                        [=](Valid<A> const& v_) -> TResult<A>
+                        [=](Valid<A> const& v_) -> RetT
                         {
                             auto [nTState, v] = v_;
                             auto t2 = func(v);
-                            return t2(nTState).run();
+                            return t2.run(nTState).run();
                         },
-                        [=](Retry const&)
+                        [=](Retry const& retry_) -> RetT
                         {
-                            return tResult;
+                            return toValid | tState | T{};
                         },
-                        [=](Invalid const&)
+                        [=](Invalid const& invalid_) -> RetT
                         {
-                            return tResult;
+                            return toValid | tState | T{};
                         }
                     ), tResult);
                 });
             };
             return do_(
-                tRes <= t1(tState),
+                tRes <= t1.run(tState),
                 dispatchResult | tRes
             );
         };
@@ -1050,7 +1062,7 @@ constexpr auto addToWaitQueues = toFunc<> | [](MVar<_O_> mvar)
 
 
 template <typename A, typename Func>
-auto atomicallyImpl(STM<A, Func> const& stmac)
+auto atomicallyImpl(STM<A, Func> const& stmac) -> IO<A>
 {
     Id<TState> ts;
     Id<TResult<A>> r;
@@ -1067,11 +1079,11 @@ auto atomicallyImpl(STM<A, Func> const& stmac)
                     (void)ti;
                     (void)a;
                     auto wslist = (readIORef | nts.writeSet).run();
-                    auto [success, locks] = getLocks | nts.transId | wslist;
+                    auto [success, locks] = (getLocks | nts.transId | wslist).run();
                     if (success)
                     {
 						auto wstamp = incrementGlobalClock.run();
-						auto valid = validateReadSet | nts.readSet | nts.readStamp | nts.transId;
+						auto valid = (validateReadSet | nts.readSet | nts.readStamp | nts.transId).run();
 						if (valid)
                         {
                             (commitChangesToMemory | wstamp | wslist).run();
@@ -1118,11 +1130,50 @@ auto atomicallyImpl(STM<A, Func> const& stmac)
             ), tResult);
         });
     };
-    return do_(
-        ts <= newTState,
-        r <= stmac.run(ts),
+    return toTEIO | do_(
+        r <= stmac.run(newTState.run()),
         dispatchResult | r
     );
 }
 
+constexpr auto atomically = toGFunc<1> | [](auto const& stmac)
+{
+    return atomicallyImpl(stmac);
+};
+
 } // namespace concurrent
+
+template <template <template<typename...> typename Type, typename... Ts> class TypeClassT, typename... Args>
+struct hspp::TypeClassTrait<TypeClassT, STM<Args...>>
+{
+    using Type = TypeClassT<STM>;
+};
+
+template <typename A, typename Repr>
+struct hspp::DataTrait<STM<A, Repr>>
+{
+    using Type = A;
+};
+
+TEST(atomically, 1)
+{
+    constexpr auto transferSTM = toFunc<> | [](TVar<Integer> ma, TVar<Integer> mb, Integer d)
+    {
+        Id<Integer> wa, wb;
+        return do_(
+            wa <= (readTVar | ma),
+            wb <= (readTVar | mb),
+            writeTVar | ma | (wa - d),
+            writeTVar | mb | (wb + d)
+        );
+    };
+    constexpr auto transfer = toFunc<> | [=](TVar<Integer> ma, TVar<Integer> mb, Integer d)
+    {
+        return atomically || transferSTM | ma | mb | d;
+    };
+   // Id<TVar<Integer>> ia, ib;
+    // auto io_ = do_(
+    //     ia <= newTV
+    // );
+
+}
\ No newline at end of file

From afbbd10af615f7e36936c3c11dbef1f75e846be8 Mon Sep 17 00:00:00 2001
From: Bowen Fu <missing>
Date: Thu, 28 Jul 2022 21:27:29 +0800
Subject: [PATCH 2/6] Fix gcc

---
 test/hspp/stm.cpp | 1 +
 1 file changed, 1 insertion(+)

diff --git a/test/hspp/stm.cpp b/test/hspp/stm.cpp
index 616215d..9bd0e25 100644
--- a/test/hspp/stm.cpp
+++ b/test/hspp/stm.cpp
@@ -11,6 +11,7 @@
 #include <type_traits>
 #include <map>
 #include <typeindex>
+#include <variant>
 
 using namespace hspp;
 using namespace hspp::data;

From d8a581c2e3494c7a06a2302afb419ed0667020ab Mon Sep 17 00:00:00 2001
From: Bowen Fu <missing>
Date: Thu, 28 Jul 2022 21:50:59 +0800
Subject: [PATCH 3/6] Fix gcc

---
 develop/include/data.h  | 19 +++++++++++++++++++
 develop/include/range.h |  1 +
 include/hspp.h          | 39 ++++++++++++++++++++-------------------
 test/hspp/stm.cpp       |  1 -
 4 files changed, 40 insertions(+), 20 deletions(-)

diff --git a/develop/include/data.h b/develop/include/data.h
index ee8b7a6..a8daa81 100644
--- a/develop/include/data.h
+++ b/develop/include/data.h
@@ -851,6 +851,25 @@ using data::toGFunc;
 using data::unCurry;
 using data::id;
 
+// For io
+constexpr auto mapM_ = toGFunc<2> | [](auto func, auto lst)
+{
+    return data::io([=]
+    {
+        for (auto e : lst)
+        {
+            func(e).run();
+        }
+        return _o_;
+    });
+};
+
+constexpr auto even = toGFunc<1> | [](auto n)
+{
+    static_assert(std::is_integral_v<decltype(n)>);
+    return n % 2 == 0;
+};
+
 } // namespace hspp
 
 #endif // HSPP_DATA_H
\ No newline at end of file
diff --git a/develop/include/range.h b/develop/include/range.h
index 0069f9f..4daf4aa 100644
--- a/develop/include/range.h
+++ b/develop/include/range.h
@@ -9,6 +9,7 @@
 #include <stdexcept>
 #include <limits>
 #include <memory>
+#include <tuple>
 
 namespace hspp
 {
diff --git a/include/hspp.h b/include/hspp.h
index 0c13a1a..5b2d2e6 100644
--- a/include/hspp.h
+++ b/include/hspp.h
@@ -9,6 +9,7 @@
 #include <stdexcept>
 #include <limits>
 #include <memory>
+#include <tuple>
 
 namespace hspp
 {
@@ -1672,6 +1673,25 @@ using data::toGFunc;
 using data::unCurry;
 using data::id;
 
+// For io
+constexpr auto mapM_ = toGFunc<2> | [](auto func, auto lst)
+{
+    return data::io([=]
+    {
+        for (auto e : lst)
+        {
+            func(e).run();
+        }
+        return _o_;
+    });
+};
+
+constexpr auto even = toGFunc<1> | [](auto n)
+{
+    static_assert(std::is_integral_v<decltype(n)>);
+    return n % 2 == 0;
+};
+
 } // namespace hspp
 
 #endif // HSPP_DATA_H
@@ -4129,25 +4149,6 @@ constexpr auto apply = toGFunc<1> | [](auto p)
 
 } // namespace parser
 
-// For io
-constexpr auto mapM_ = toGFunc<2> | [](auto func, auto lst)
-{
-    return data::io([=]
-    {
-        for (auto e : lst)
-        {
-            func(e).run();
-        }
-        return _o_;
-    });
-};
-
-constexpr auto even = toGFunc<1> | [](auto n)
-{
-    static_assert(std::is_integral_v<decltype(n)>);
-    return n % 2 == 0;
-};
-
 } // namespace hspp
 
 #endif // HSPP_PARSER_H
diff --git a/test/hspp/stm.cpp b/test/hspp/stm.cpp
index 9bd0e25..616215d 100644
--- a/test/hspp/stm.cpp
+++ b/test/hspp/stm.cpp
@@ -11,7 +11,6 @@
 #include <type_traits>
 #include <map>
 #include <typeindex>
-#include <variant>
 
 using namespace hspp;
 using namespace hspp::data;

From 9d1341d831362358ebf374977c078db563828a38 Mon Sep 17 00:00:00 2001
From: Bowen Fu <missing>
Date: Thu, 28 Jul 2022 22:01:00 +0800
Subject: [PATCH 4/6] Fix gcc

---
 test/hspp/stm.cpp | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/test/hspp/stm.cpp b/test/hspp/stm.cpp
index 616215d..38a16bf 100644
--- a/test/hspp/stm.cpp
+++ b/test/hspp/stm.cpp
@@ -620,7 +620,10 @@ class Invalid : public TState
 {};
 
 template <typename A>
-class TResult : public std::variant<Valid<A>, Retry, Invalid>
+using TResultBase = std::variant<Valid<A>, Retry, Invalid>;
+
+template <typename A>
+class TResult : public TResultBase<A>
 {
 public:
     using DataT = A;
@@ -820,7 +823,7 @@ class MonadBase<STM>
                         {
                             return toValid | tState | T{};
                         }
-                    ), tResult);
+                    ), static_cast<TResultBase<A> const&>(tResult));
                 });
             };
             return do_(

From 51e1d64090a966363e1e3f8d103e9848580c397a Mon Sep 17 00:00:00 2001
From: Bowen Fu <missing>
Date: Thu, 28 Jul 2022 22:09:32 +0800
Subject: [PATCH 5/6] Fix gcc

---
 test/hspp/stm.cpp | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/hspp/stm.cpp b/test/hspp/stm.cpp
index 38a16bf..08d7488 100644
--- a/test/hspp/stm.cpp
+++ b/test/hspp/stm.cpp
@@ -1130,7 +1130,7 @@ auto atomicallyImpl(STM<A, Func> const& stmac) -> IO<A>
                 {
                     return atomicallyImpl(stmac).run();
                 }
-            ), tResult);
+            ), static_cast<TResultBase<A> const&>(tResult));
         });
     };
     return toTEIO | do_(

From cbda798c1decb213bab4822fbc6958d6216cc940 Mon Sep 17 00:00:00 2001
From: Bowen Fu <missing>
Date: Thu, 28 Jul 2022 22:16:24 +0800
Subject: [PATCH 6/6] Fix win

---
 test/hspp/stm.cpp | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/test/hspp/stm.cpp b/test/hspp/stm.cpp
index 08d7488..24d8dfc 100644
--- a/test/hspp/stm.cpp
+++ b/test/hspp/stm.cpp
@@ -520,11 +520,14 @@ class CommitterRegister
 template <typename A>
 struct WSEData
 {
-    constexpr static CommitterRegister<A> dummy{};
+    static const CommitterRegister<A> dummy;
     IORef<A> content;
     A newValue;
 };
 
+template <typename A>
+const CommitterRegister<A> WSEData<A>::dummy{};
+
 struct WSE
 {
     Lock lock;