From 09b273ed61685a67123586c867a4b06fe1fb5f7c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Manuel=20B=C3=A4renz?= <programming@manuelbaerenz.de>
Date: Fri, 19 Apr 2024 11:01:21 +0200
Subject: [PATCH] WIP Clock erasure should happen at compile time, but can't
 achieve it through strictness

* Maybe through simplifying initClock (https://github.com/turion/rhine/issues/304)
* Looking at the Core it turns out that erased clock isn't completely simplified,
  and it's somehow obvious because it can't be inlined since it's recursive
* I was hoping that if the automaton is evaluated strictly enough, it would be reduced to WHNF before reactimation starts
  but it's unclear whether this would even be visible in Core
---
 rhine/src/Data/Automaton/MSF.hs       | 3 ++-
 rhine/src/Data/Automaton/Optimized.hs | 5 +++--
 rhine/src/FRP/Rhine/Reactimation.hs   | 3 ++-
 3 files changed, 7 insertions(+), 4 deletions(-)

diff --git a/rhine/src/Data/Automaton/MSF.hs b/rhine/src/Data/Automaton/MSF.hs
index 434f0eacd..a64a43adc 100644
--- a/rhine/src/Data/Automaton/MSF.hs
+++ b/rhine/src/Data/Automaton/MSF.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE BangPatterns #-}
 
 module Data.Automaton.MSF where
 
@@ -244,7 +245,7 @@ stepMSF (MSF automatonT) a =
 {-# INLINE stepMSF #-}
 
 reactimate :: (Monad m) => MSF m () () -> m void
-reactimate (MSF automaton) = AutomatonOptimized.reactimate $ hoist (`runReaderT` ()) automaton
+reactimate (MSF !automaton) = AutomatonOptimized.reactimate $ hoist (`runReaderT` ()) automaton
 {-# INLINE reactimate #-}
 
 -- FIXME rename to mapMSF? if yes change in document
diff --git a/rhine/src/Data/Automaton/Optimized.hs b/rhine/src/Data/Automaton/Optimized.hs
index 83ee30b22..f99b13468 100644
--- a/rhine/src/Data/Automaton/Optimized.hs
+++ b/rhine/src/Data/Automaton/Optimized.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE BangPatterns #-}
 
 module Data.Automaton.Optimized where
 
@@ -112,8 +113,8 @@ handleS :: (Functor m) => (AutomatonT m a -> AutomatonT n b) -> OptimizedAutomat
 handleS f automaton = Stateful $ f $ toAutomatonT automaton
 
 reactimate :: (Monad m) => OptimizedAutomatonT m () -> m void
-reactimate (Stateful automaton) = AutomatonT.reactimate automaton
-reactimate (Stateless f) = go
+reactimate (Stateful !automaton) = AutomatonT.reactimate automaton
+reactimate (Stateless !f) = go
   where
     go = f *> go
 {-# INLINE reactimate #-}
diff --git a/rhine/src/FRP/Rhine/Reactimation.hs b/rhine/src/FRP/Rhine/Reactimation.hs
index c27cb0030..8d07702fe 100644
--- a/rhine/src/FRP/Rhine/Reactimation.hs
+++ b/rhine/src/FRP/Rhine/Reactimation.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE BangPatterns #-}
 
 {- |
 Run closed 'Rhine's (which are signal functions together with matching clocks)
@@ -55,7 +56,7 @@ flow ::
   Rhine m cl () () ->
   m void
 flow rhine = do
-  msf <- eraseClock rhine
+  !msf <- eraseClock rhine
   reactimate $ msf >>> arr (const ())
 {-# INLINE flow #-}