From 23829f5a50c3e224f139547c5082d012dcb1900f 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
---
 automaton/src/Data/Stream/Optimized.hs | 6 +++---
 rhine/src/FRP/Rhine/Reactimation.hs    | 3 ++-
 2 files changed, 5 insertions(+), 4 deletions(-)

diff --git a/automaton/src/Data/Stream/Optimized.hs b/automaton/src/Data/Stream/Optimized.hs
index ef30ff2c..e6a757d2 100644
--- a/automaton/src/Data/Stream/Optimized.hs
+++ b/automaton/src/Data/Stream/Optimized.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE RankNTypes #-}
@@ -160,8 +161,8 @@ handleOptimized f stream = Stateful $ f $ toStreamT stream
 See 'Data.Stream.reactimate'.
 -}
 reactimate :: (Monad m) => OptimizedStreamT m () -> m void
-reactimate (Stateful stream) = StreamT.reactimate stream
-reactimate (Stateless f) = go
+reactimate (Stateful !stream) = StreamT.reactimate stream
+reactimate (Stateless !f) = go
   where
     go = f *> go
 {-# INLINE reactimate #-}
@@ -173,7 +174,6 @@ since the optimized version doesn't create a state type.
 -}
 constM :: m a -> OptimizedStreamT m a
 constM = Stateless
-{-# INLINE constM #-}
 
 -- | Perform one step of a stream, resulting in an updated stream and an output value.
 stepOptimizedStream :: (Functor m) => OptimizedStreamT m a -> m (Result (OptimizedStreamT m a) a)
diff --git a/rhine/src/FRP/Rhine/Reactimation.hs b/rhine/src/FRP/Rhine/Reactimation.hs
index 7f07ab3c..47a68bc5 100644
--- a/rhine/src/FRP/Rhine/Reactimation.hs
+++ b/rhine/src/FRP/Rhine/Reactimation.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE GADTs #-}
 
 {- |
@@ -55,7 +56,7 @@ flow ::
   Rhine m cl () () ->
   m void
 flow rhine = do
-  automaton <- eraseClock rhine
+  !automaton <- eraseClock rhine
   reactimate $ automaton >>> arr (const ())
 {-# INLINE flow #-}