From e5ed5ba11c8b7479fcd9eef3160106dceb15af21 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 ef30ff2c5..e6a757d2d 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 7f07ab3c3..47a68bc56 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 #-}