ryantrinkle/weak-refs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Minor cleanups

Browse Source
This commit is contained in:
Ryan Trinkle 2023-04-10 22:32:12 -04:00
parent 7a2d4162cf
commit ee8b926ab8
2 changed files with 12 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Test/UIO.hs
View File

@ -1,5 +1,5 @@
{-# LANGUAGE RecursiveDo #-} {-# LANGUAGE RecursiveDo #-}
{-# OPTIONS_GHC -fplugin UIO.Plugin #-} {-# OPTIONS_GHC -fplugin UIO #-}
module Test.UIO where module Test.UIO where
import Data.IORef import Data.IORef

38
src/UIO.hs
View File

@ -1,33 +1,18 @@
{-# LANGUAGE MagicHash #-} {-# LANGUAGE MagicHash #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE ScopedTypeVariables #-} module UIO
{-# LANGUAGE RecursiveDo #-} ( module UIO
module UIO where , module X
) where
import System.Mem
import System.Mem.Weak
import Data.IORef
import GHC.IORef
import GHC.STRef
import GHC.IO
import GHC.Weak
import GHC.Prim
import Control.Monad.Primitive
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import System.IO.Unsafe
import Control.Monad
import Control.Concurrent
import Data.Foldable
import Data.These
import Unsafe.Coerce
import Control.Monad.Fix import Control.Monad.Fix
import Data.List.NonEmpty (NonEmpty (..)) import Data.Foldable
import Data.Semigroup import Data.Semigroup
import GHC.Magic import GHC.IO
import GHC.Prim
import UIO.Plugin as X
data RemainingWork = RemainingWork data RemainingWork = RemainingWork
@ -55,7 +40,7 @@ instance Applicative UIO2 where
{-# INLINE pure #-} {-# INLINE pure #-}
{-# INLINE (*>) #-} {-# INLINE (*>) #-}
{-# INLINE (<*>) #-} {-# INLINE (<*>) #-}
pure x = UIO2 (\s -> (RemainingWork, x)) pure x = UIO2 (\_ -> (RemainingWork, x))
UIO2 m *> UIO2 k = UIO2 (\s -> UIO2 m *> UIO2 k = UIO2 (\s ->
let (ms, _) = m (uniqueState 1# s) let (ms, _) = m (uniqueState 1# s)
(ks, b) = k (uniqueState 2# s) (ks, b) = k (uniqueState 2# s)
@ -75,6 +60,7 @@ instance Monad UIO2 where
in (ms <> ks, b)) in (ms <> ks, b))
instance MonadFix UIO2 where instance MonadFix UIO2 where
{-# INLINE mfix #-}
mfix k = UIO2 (\s -> mfix k = UIO2 (\s ->
let (ks, result) = unUIO2 (k result) s let (ks, result) = unUIO2 (k result) s
in (ks, result)) in (ks, result))
@ -103,5 +89,3 @@ uniqueState = uniqueState'
{-# NOINLINE uniqueState' #-} {-# NOINLINE uniqueState' #-}
uniqueState' :: Int# -> State# RealWorld -> State# RealWorld uniqueState' :: Int# -> State# RealWorld -> State# RealWorld
uniqueState' _ s = s uniqueState' _ s = s
-- This implementation seems to work sometimes, but I don't understand why, and it seems highly dependent on other aspects of the implementation.
-- uniqueState = runRW# (\s _ _ -> s)