cleff 0.3.1.0 → 0.3.2.0

raw patch · 14 files changed

+204/−312 lines, 14 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−1
• README.md +21/−15
• cleff.cabal +2/−3
• src/Cleff.hs +2/−1
• src/Cleff/Error.hs +2/−2
• src/Cleff/Internal.hs +59/−0
• src/Cleff/Internal/Any.hs +0/−26
• src/Cleff/Internal/Base.hs +2/−1
• src/Cleff/Internal/Interpret.hs +3/−2
• src/Cleff/Internal/Monad.hs +22/−53
• src/Cleff/Internal/Rec.hs +80/−75
• src/Cleff/Internal/TH.hs +2/−2
• src/Cleff/Mask.hs +1/−1
• test/RecSpec.hs +0/−130

@@ -1,6 +1,13 @@ # Changelog for `cleff` -## 0.3.0.1 (2022-02-28)+## 0.3.2.0 (2022-03-13)++### Changed++- Slight performance improvements+- `(:>)` is now a typeclass by itself instead of a type synonym++## 0.3.1.0 (2022-02-28)  ### Added 

@@ -5,35 +5,37 @@  `cleff` is an extensible effects library for Haskell, with a focus on the balance of performance, expressiveness and ease of use. It provides a set of predefined effects that you can conveniently reuse in your program, as well as low-boilerplate mechanisms for defining and interpreting new domain-specific effects on your own. -## Overview+In essence, `cleff` offers: -Different from [many](`polysemy`) [previous](`fused-effects`) [libraries](`freer-simple`), `cleff` does not use techniques like Freer monads or monad transformers. Instead, the `Eff` monad is essentially a `ReaderT IO`, which provides predictable semantics and reliable performance. The only caveat is that `cleff` does not support nondeterminism and continuations in the `Eff` monad - but after all, [most effects libraries has broken nondeterminism support](https://github.com/polysemy-research/polysemy/issues/246), and we encourage users to wrap another monad transformer with support of nondeterminism (e.g. `ListT`) over the main `Eff` monad in such cases.+- **Performance**: -### Performance+  `cleff` does not use techniques like Freer monads or monad transformers. Instead, `cleff`'s `Eff` monad is essentially implemented as a `ReaderT IO`. This concrete formulation [allows more GHC optimizations to fire][alexis-talk], and has lower performance overhead. [In microbenchmarks](#benchmarks), `cleff` outperforms [`polysemy`] and even `mtl`. -`cleff`'s `Eff` monad is essentially implemented as a `ReaderT IO`. This concrete formulation [allows more GHC optimizations to fire][alexis-talk], and brings lower performance overhead. This is first done by [`eff`], and then [`effectful`]; it proved to work, so we followed this path.+  The only caveat is that `cleff` does not support nondeterminism and continuations in the `Eff` monad - but after all, [most effects libraries has broken nondeterminism support](https://github.com/polysemy-research/polysemy/issues/246), and we encourage users to wrap another monad transformer with support of nondeterminism (*e.g.* `ListT`) over the main `Eff` monad in such cases. -[In microbenchmarks](#benchmarks), `cleff` outperforms [`polysemy`], and is slightly behind [`effectful`]. However, note that `effectful` and `cleff` have very different design principles. While `effectful` prioritizes performance over anything else (by [providing static dispatch](https://github.com/arybczak/effectful/blob/master/effectful-core/src/Effectful/Reader/Static.hs)), `cleff` focuses on balancing expressivity and performance. If you would like minimal performance overhead, consider [`effectful`].+- **Low boilerplate**: -### Low-boilerplate+  `cleff` supports user-defined effects and provides simple yet flexible API for implementing them. Implementations of effects are simply case-splitting functions, and users familiar with [`polysemy`] or [`freer-simple`] will find it very easy to get along with `cleff`. [Take a look at the examples](#example). -`cleff` supports user-defined effects and provides simple yet flexible API for that. Users familiar with [`polysemy`], [`freer-simple`] or [`effectful`] will find it very easy to get along with `cleff`. `cleff`'s effect interpretation API include:+- **Interoperability**: -- Arbitrary lifting and subsumption of effects-- Interpreting and reinterpreting, without needing to distinguish first-order and higher-order interpreters like `polysemy`-- *Translation* of effects, i.e. handling an effect in terms of a simple transformation into another effect, as seen in `polysemy`'s `rewrite` and `freer-simple`'s `translate`+  `cleff`'s simple underlying structure allows us to implement near-seamless interop with the current ecosystem, mainly classes like `MonadUnliftIO`, `MonadCatch` and `MonadBaseControl`. In other words, you can directly use libraries like `unliftio`, `exceptions` and `lifted-async` in `cleff` without writing any "adapter" code. -### Predictable semantics+- **Predictable semantics**: -Traditional effect libraries have many surprising behaviors, such as [`mtl` reverts state when an error is thrown][alexis-talk-2], and [more so when interacting with `IO`][readert]. By implementing `State` and `Writer` as `IORef` operations, and `Error` as `Exceptions`, `cleff` is able to interact well with `IO` and provide semantics that are predictable in the presence of concurrency and exceptions. Moreover, any potentially surprising behavior is carefully documented for each effect.+  Traditional effect libraries have many surprising behaviors. For example, `mtl` reverts the state when an error is thrown, and has [a lot more subtleties when interacting with `IO`][readert]. `cleff` implements `State` and `Writer` as `IORef` operations, and `Error` as `Exceptions`, so it is able to interact well with `IO` and provide semantics that are predictable in the presence of concurrency and exceptions. Moreover, any potentially surprising behavior is carefully documented for each effect. -### Higher-order effects+- **Higher-order effects**: -*Higher-order* effects are effects that take monadic computations. They are often useful in real world applications, as examples of higher-order effect operations include `local`, `catchError` and `mask`. Implementing higher-order effects is often tedious, or even not supported in some effect libraries. `polysemy` is the first library that aims to provide easy higher-order effects mechanism with its [`Tactics`](https://hackage.haskell.org/package/polysemy-1.7.1.0/docs/Polysemy.html#g:16) API. Following its path, `cleff` provides a set of combinators that can be used to implement higher-order effects. These combinators are as expressive as `polysemy`'s, and are also easier to use correctly.+  *Higher-order* effects are effects that "wraps" monadic computations, like `local`, `catchError` and `mask`. Implementing higher-order effects is often tedious, or outright not supported in most effect libraries. `polysemy` is the first library that aims to provide easy higher-order effects mechanism with its `Tactics` API. Following its path, `cleff` provides a set of combinators that can be used to implement higher-order effects. These combinators are as expressive as `polysemy`'s, and are also easier to use correctly. +- **Ergonomics without sacrificing flexibility**:++  Unlike `mtl`, `cleff` doesn't have functional dependencies on effects, so you can have *e.g.* multiple `State` effects. As a side effect, GHC will sometimes ask you to provide which effect you're operating on via `TypeApplications`, or otherwise the effect usage will be ambiguous. This can be verbose at times, and we have a solution for that: [`cleff-plugin`](https://github.com/re-xyr/cleff/tree/master/cleff-plugin) is a GHC plugin that works like `mtl`'s functional dependencies, and can resolve most type ambiguities involving effects for you.+ ## Example -This is the code that defines `Teletype` effect. It only takes 20 lines to define the effect and two interpretations, one using stdio and another reading from and writing to a list:+This is the code that defines the classic `Teletype` effect. It only takes 20 lines to define the effect and two interpretations, one using stdio and another reading from and writing to a list:  ```haskell import Cleff@@ -88,6 +90,10 @@ - `countdown`: ![countdown benchmark result](https://raw.githubusercontent.com/re-xyr/cleff/master/docs/img/effect-zoo-countdown.png) - `file-sizes`: ![file-sizes benchmark result](https://raw.githubusercontent.com/re-xyr/cleff/master/docs/img/effect-zoo-file-sizes.png) - `reinterpretation`: ![reinterpretation benchmark result](https://raw.githubusercontent.com/re-xyr/cleff/master/docs/img/effect-zoo-reinterpretation.png)++### Differences from `effectful`++If you know about [`effectful`], you may notice that `cleff` and `effectful` seem to make many similar claims and have a similar underlying implementation. In microbenchmarks, `cleff` is slightly behind `effectful`. This may make you confused about the differences between the two libraries. To put it simply, `cleff` has a more versatile and expressive effect interpretation mechanism, and a lighter weight API. In contrast, `effectful` gains its performance advantage by providing static dispatch for some internal effects, which means they cannot have multiple interpretations.  ## References 

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           cleff-version:        0.3.1.0+version:        0.3.2.0 synopsis:       Fast and concise extensible effects description:    Please see the README on GitHub at <https://github.com/re-xyr/cleff#readme> category:       Control, Effect, Language@@ -43,7 +43,7 @@       Cleff.Fail       Cleff.Fresh       Cleff.Input-      Cleff.Internal.Any+      Cleff.Internal       Cleff.Internal.Base       Cleff.Internal.Instances       Cleff.Internal.Interpret@@ -177,7 +177,6 @@       HigherOrderSpec       InterposeSpec       MaskSpec-      RecSpec       StateSpec       ThSpec       Paths_cleff

@@ -90,6 +90,7 @@   , MonadUnliftIO (..)   ) where +import           Cleff.Internal import           Cleff.Internal.Base import           Cleff.Internal.Instances () import           Cleff.Internal.Interpret@@ -191,7 +192,7 @@ -- runFilesystemPure fs --   = 'fmap' 'fst'           -- runState returns (Eff es (a, s)), so we need to extract the first component to get (Eff es a) --   . 'Cleff.State.runState' fs        -- (State (Map FilePath String) : es) ==> es---   . 'filesystemToState'  -- (Filesystem : es) ==> (State (Map FilePath String) : es)+--   . filesystemToState  -- (Filesystem : es) ==> (State (Map FilePath String) : es) -- @ -- -- Both of these interpreters can then be applied to computations with the @Filesystem@ effect to give different

@@ -33,7 +33,7 @@   ) where  import           Cleff-import           Cleff.Internal.Any+import           Cleff.Internal import           Cleff.Internal.Base import           Control.Exception    (Exception) import           Data.Atomics.Counter (AtomicCounter, incrCounter, newCounter)@@ -165,7 +165,7 @@ -- incur an exception, and we won't be quite able to display the details of that exception properly at that point. -- Therefore please properly handle the errors in the forked threads separately. ----- However if you use @async@ and @wait@ for the action in the same effect scope (i.e. they get to be interpreted by+-- However if you use @async@ and @wait@ for the action in the same effect scope (/i.e./ they get to be interpreted by -- the same 'runError' handler), the error /will/ be caught in the parent thread even if you don't deal with it in the -- forked thread. But if you passed the @Async@ value out of the effect scope and @wait@ed for it elsewhere, the error -- will again not be caught. The best choice is /not to pass @Async@ values around randomly/.

@@ -0,0 +1,59 @@+-- |+-- Copyright: (c) 2021 Xy Ren+-- License: BSD3+-- Maintainer: xy.r@outlook.com+-- Stability: unstable+-- Portability: non-portable (GHC only)+--+-- This module contains common definitions for the @cleff@ internals.+--+-- __This is an /internal/ module and its API may change even between minor versions.__ Therefore you should be+-- extra careful if you're to depend on this module.+module Cleff.Internal+  ( -- * Basic types+    Effect+  , type (~>)+  , type (++)+    -- * The 'Any' type+  , Any+  , fromAny+  , toAny+  ) where++import           Data.Kind     (Type)+import           GHC.Exts      (Any)+import           Unsafe.Coerce (unsafeCoerce)++-- | The type of effects. An effect @e m a@ takes an effect monad type @m :: 'Type' -> 'Type'@ and a result type+-- @a :: 'Type'@.+type Effect = (Type -> Type) -> Type -> Type++-- | A natural transformation from @f@ to @g@. With this, instead of writing+--+-- @+-- runSomeEffect :: 'Cleff.Eff' (SomeEffect : es) a -> 'Cleff.Eff' es a+-- @+--+-- you can write:+--+-- @+-- runSomeEffect :: 'Cleff.Eff' (SomeEffect : es) ~> 'Cleff.Eff' es+-- @+type f ~> g = ∀ a. f a -> g a++-- | Type level list concatenation.+type family xs ++ ys where+  '[] ++ ys = ys+  (x : xs) ++ ys = x : (xs ++ ys)+infixr 5 ++++-- | Coerce any boxed value into 'Any'.+toAny :: a -> Any+toAny = unsafeCoerce+{-# INLINE toAny #-}++-- | Coerce 'Any' to a boxed value. This is /generally unsafe/ and it is your responsibility to ensure that the type+-- you're coercing into is the original type that the 'Any' is coerced from.+fromAny :: Any -> a+fromAny = unsafeCoerce+{-# INLINE fromAny #-}

@@ -1,26 +0,0 @@--- |--- Copyright: (c) 2021 Xy Ren--- License: BSD3--- Maintainer: xy.r@outlook.com--- Stability: unstable--- Portability: non-portable (GHC only)------ This module contains utility functions for 'Any'.------ __This is an /internal/ module and its API may change even between minor versions.__ Therefore you should be--- extra careful if you're to depend on this module.-module Cleff.Internal.Any (Any, fromAny, toAny) where--import           GHC.Exts      (Any)-import           Unsafe.Coerce (unsafeCoerce)---- | Coerce any boxed value into 'Any'.-toAny :: a -> Any-toAny = unsafeCoerce-{-# INLINE toAny #-}---- | Coerce 'Any' to a boxed value. This is /generally unsafe/ and it is your responsibility to ensure that the type--- you're coercing into is the original type that the 'Any' is coerced from.-fromAny :: Any -> a-fromAny = unsafeCoerce-{-# INLINE fromAny #-}

@@ -32,6 +32,7 @@   , fromIO   ) where +import           Cleff.Internal import           Cleff.Internal.Interpret import           Cleff.Internal.Monad import           Control.Monad.Base          (MonadBase (liftBase))@@ -139,7 +140,7 @@ -- * Unwrapping 'Eff'  -- | Unsafely eliminate an 'IOE' effect from the top of the effect stack. This is mainly for implementing effects that--- uses 'IO' but does not do anything really /impure/ (i.e. can be safely used 'unsafeDupablePerformIO' on), such as a+-- uses 'IO' but does not do anything really /impure/ (/i.e./ can be safely used 'unsafeDupablePerformIO' on), such as a -- State effect. thisIsPureTrustMe :: Eff (IOE : es) ~> Eff es thisIsPureTrustMe = interpret \case

@@ -48,6 +48,7 @@   , withFromEff   ) where +import           Cleff.Internal import           Cleff.Internal.Monad import           Cleff.Internal.Rec   (Rec) import qualified Cleff.Internal.Rec   as Rec@@ -58,7 +59,7 @@ -- | Adjust the effect stack by a contravariant transformation function over the stack. This function reveals the -- profunctorial nature of 'Eff'; in particular, 'Eff' is a profunctor @['Effect'] -> 'Data.Kind.Type'@, @lmap@ is -- 'adjust', and @rmap@ is 'fmap'.-adjust :: ∀ es es'. (∀ f. Rec f es' -> Rec f es) -> Eff es ~> Eff es'+adjust :: ∀ es es'. (Rec es' -> Rec es) -> Eff es ~> Eff es' adjust f m = Eff (unEff m . adjustEnv f)  -- | Lift a computation into a bigger effect stack with one more effect. For a more general version see 'raiseN'.@@ -165,7 +166,7 @@ -- the @reflection@ library directly so as not to expose this piece of implementation detail to the user. newtype InstHandling esSend e es a = InstHandling (Handling esSend e es => a) --- | Instantiate an 'Handling' typeclass, i.e. pass an implicit send-site environment in. This function shouldn't+-- | Instantiate an 'Handling' typeclass, /i.e./ pass an implicit send-site environment in. This function shouldn't -- be directly used anyhow. instHandling :: ∀ esSend e es a. (Handling esSend e es => a) -> SendSite esSend e -> a instHandling x = unsafeCoerce (InstHandling x :: InstHandling esSend e es a)

@@ -13,14 +13,8 @@ -- __This is an /internal/ module and its API may change even between minor versions.__ Therefore you should be -- extra careful if you're to depend on this module. module Cleff.Internal.Monad-  ( -- * Basic types-    Effect-  , type (:>)-  , type (:>>)-  , type (~>)-  , type (++)-    -- * The 'Eff' monad-  , InternalHandler (InternalHandler, runHandler)+  ( -- * The 'Eff' monad+    InternalHandler (InternalHandler, runHandler)   , Eff (Eff, unEff)     -- * Effect environment   , Env@@ -33,52 +27,24 @@   , replaceEnv   , appendEnv   , updateEnv-    -- * Performing effect operations+    -- * Constraints on effect stacks+  , (:>)+  , (:>>)   , KnownList   , Subset+    -- * Performing effect operations   , send   , sendVia   ) where -import           Cleff.Internal.Any  (Any, fromAny, toAny)-import           Cleff.Internal.Rec  (Elem, KnownList, Rec, Subset, type (++))+import           Cleff.Internal+import           Cleff.Internal.Rec  (HandlerPtr (HandlerPtr, unHandlerPtr), KnownList, Rec, Subset, type (:>)) import qualified Cleff.Internal.Rec  as Rec import           Control.Applicative (Applicative (liftA2)) import           Control.Monad.Fix   (MonadFix (mfix)) import           Data.IntMap.Strict  (IntMap) import qualified Data.IntMap.Strict  as Map-import           Data.Kind           (Constraint, Type)---- * Basic types---- | The type of effects. An effect @e m a@ takes an effect monad type @m :: 'Type' -> 'Type'@ and a result type--- @a :: 'Type'@.-type Effect = (Type -> Type) -> Type -> Type---- | @e ':>' es@ means the effect @e@ is present in the effect stack @es@, and therefore can be used in an--- @'Cleff.Eff' es@ computation.-type (:>) = Elem-infix 0 :>---- | @xs ':>>' es@ means the list of effects @xs@ are all present in the effect stack @es@. This is a convenient type--- alias for @(e1 ':>' es, ..., en ':>' es)@.-type family xs :>> es :: Constraint where-  '[] :>> _ = ()-  (x : xs) :>> es = (x :> es, xs :>> es)-infix 0 :>>---- | A natural transformation from @f@ to @g@. With this, instead of writing------ @--- runSomeEffect :: 'Eff' (SomeEffect : es) a -> 'Eff' es a--- @------ you can write:------ @--- runSomeEffect :: 'Eff' (SomeEffect : es) ~> 'Eff' es--- @-type f ~> g = ∀ a. f a -> g a+import           Data.Kind           (Constraint)  -- * The 'Eff' monad @@ -148,13 +114,9 @@ -- retain correct HO semantics. For more details on this see https://github.com/re-xyr/cleff/issues/5. type role Env nominal data Env (es :: [Effect]) = Env-  {-# UNPACK #-} !Int-  {-# UNPACK #-} !(Rec HandlerPtr es)-  !(IntMap Any)---- | A pointer to 'InternalHandler' in an 'Env'.-type role HandlerPtr nominal-newtype HandlerPtr (e :: Effect) = HandlerPtr { unHandlerPtr :: Int }+  {-# UNPACK #-} !Int -- ^ The next address to allocate.+  {-# UNPACK #-} !(Rec es) -- ^ The effect stack storing pointers to handlers.+  !(IntMap Any) -- ^ The map that corresponds pointers to handlers.  -- | Create an empty 'Env' with no address allocated. emptyEnv :: Env '[]@@ -162,7 +124,7 @@ {-# INLINE emptyEnv #-}  -- | Adjust the effect stack via an function over 'Rec'.-adjustEnv :: ∀ es' es. (Rec HandlerPtr es -> Rec HandlerPtr es') -> Env es -> Env es'+adjustEnv :: ∀ es' es. (Rec es -> Rec es') -> Env es -> Env es' adjustEnv f (Env n re mem) = Env n (f re) mem {-# INLINE adjustEnv #-} @@ -172,7 +134,7 @@ {-# INLINE allocaEnv #-}  -- | Read the handler a pointer points to. \( O(1) \).-readEnv :: ∀ e es. Rec.Elem e es => Env es -> InternalHandler e+readEnv :: ∀ e es. e :> es => Env es -> InternalHandler e readEnv (Env _ re mem) = fromAny $ mem Map.! unHandlerPtr (Rec.index @e re) {-# INLINE readEnv #-} @@ -182,7 +144,7 @@ {-# INLINE writeEnv #-}  -- | Replace the handler pointer of an effect in the stack. \( O(n) \).-replaceEnv :: ∀ e es. Rec.Elem e es => HandlerPtr e -> InternalHandler e -> Env es -> Env es+replaceEnv :: ∀ e es. e :> es => HandlerPtr e -> InternalHandler e -> Env es -> Env es replaceEnv (HandlerPtr m) x (Env n re mem) = Env n (Rec.update @e (HandlerPtr m) re) (Map.insert m (toAny x) mem) {-# INLINE replaceEnv #-} @@ -197,6 +159,13 @@ {-# INLINE updateEnv #-}  -- * Performing effect operations++-- | @xs ':>>' es@ means the list of effects @xs@ are all present in the effect stack @es@. This is a convenient type+-- alias for @(e1 ':>' es, ..., en ':>' es)@.+type family xs :>> es :: Constraint where+  '[] :>> _ = ()+  (x : xs) :>> es = (x :> es, xs :>> es)+infix 0 :>>  -- | Perform an effect operation, /i.e./ a value of an effect type @e :: 'Effect'@. This requires @e@ to be in the -- effect stack.

@@ -1,4 +1,6 @@ {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE MagicHash           #-}+{-# LANGUAGE UnboxedTuples       #-} {-# OPTIONS_HADDOCK not-home #-} -- | -- Copyright: (c) 2021 Xy Ren@@ -18,7 +20,8 @@ -- __This is an /internal/ module and its API may change even between minor versions.__ Therefore you should be -- extra careful if you're to depend on this module. module Cleff.Internal.Rec-  ( Rec (Rec)+  ( HandlerPtr (HandlerPtr, unHandlerPtr)+  , Rec   , type (++)     -- * Construction   , empty@@ -31,37 +34,32 @@   , tail   , drop     -- * Retrieval and updating-  , Elem+  , (:>)   , Subset   , index   , pick   , update-    -- * Helpers-  , newArr   ) where -import           Cleff.Internal.Any        (Any, fromAny, toAny)-import           Control.Monad.ST          (ST)-import           Data.Kind                 (Type)-import           Data.Primitive.SmallArray (SmallArray, SmallMutableArray, cloneSmallArray, copySmallArray,-                                            indexSmallArray, newSmallArray, runSmallArray, thawSmallArray,-                                            writeSmallArray)-import           GHC.TypeLits              (ErrorMessage (ShowType, Text, (:<>:)), TypeError)-import           Prelude                   hiding (all, any, concat, drop, head, length, tail, take, zipWith)+import           Cleff.Internal+import           Data.Primitive.PrimArray (MutablePrimArray (MutablePrimArray), PrimArray (PrimArray), copyPrimArray,+                                           indexPrimArray, newPrimArray, writePrimArray)+import           GHC.Exts                 (runRW#, unsafeFreezeByteArray#)+import           GHC.ST                   (ST (ST))+import           GHC.TypeLits             (ErrorMessage (ShowType, Text, (:<>:)), TypeError)+import           Prelude                  hiding (concat, drop, head, tail, take) --- | Extensible record type supporting efficient \( O(1) \) reads. The underlying implementation is 'SmallArray'--- slices, therefore suits small numbers of entries (/i.e./ less than 128).-type role Rec representational nominal-data Rec (f :: k -> Type) (es :: [k]) = Rec+-- | A pointer to an effect handler.+type role HandlerPtr nominal+newtype HandlerPtr (e :: Effect) = HandlerPtr { unHandlerPtr :: Int }++-- | Extensible record type supporting efficient \( O(1) \) reads. The underlying implementation is 'PrimArray'+-- slices.+type role Rec nominal+data Rec (es :: [Effect]) = Rec   {-# UNPACK #-} !Int -- ^ The offset.   {-# UNPACK #-} !Int -- ^ The length.-  {-# UNPACK #-} !(SmallArray Any) -- ^ The array content.---- | Create a new 'SmallMutableArray' with no contents.-newArr :: Int -> ST s (SmallMutableArray s Any)-newArr len = newSmallArray len $ error-  "Cleff.Internal.Rec.newArr: Attempting to read an element of the underlying array of a 'Rec'. Please report this \-  \as a bug."+  {-# UNPACK #-} !(PrimArray Int) -- ^ The array content.  unreifiable :: String -> String -> String -> a unreifiable clsName funName comp = error $@@ -69,39 +67,40 @@   \to define an instance for the '" <> clsName <> "' typeclass, which you should not be doing whatsoever. If that or \   \other shenanigans seem unlikely, please report this as a bug." +runPrimArray :: (∀ s. ST s (MutablePrimArray s a)) -> PrimArray a+runPrimArray (ST f) = let+  !(# _, ba# #) = runRW# \s1 ->+    let !(# s2, MutablePrimArray mba# #) = f s1+    in unsafeFreezeByteArray# mba# s2+  in PrimArray ba#+ -- | Create an empty record. \( O(1) \).-empty :: Rec f '[]-empty = Rec 0 0 $ runSmallArray $ newArr 0+empty :: Rec '[]+empty = Rec 0 0 $ runPrimArray $ newPrimArray 0  -- | Prepend one entry to the record. \( O(n) \).-cons :: f e -> Rec f es -> Rec f (e : es)-cons x (Rec off len arr) = Rec 0 (len + 1) $ runSmallArray do-  marr <- newArr (len + 1)-  writeSmallArray marr 0 (toAny x)-  copySmallArray marr 1 arr off len+cons :: HandlerPtr e -> Rec es -> Rec (e : es)+cons x (Rec off len arr) = Rec 0 (len + 1) $ runPrimArray do+  marr <- newPrimArray (len + 1)+  writePrimArray marr 0 (unHandlerPtr x)+  copyPrimArray marr 1 arr off len   pure marr --- | Type level list concatenation.-type family xs ++ ys where-  '[] ++ ys = ys-  (x : xs) ++ ys = x : (xs ++ ys)-infixr 5 ++- -- | Concatenate two records. \( O(m+n) \).-concat :: Rec f es -> Rec f es' -> Rec f (es ++ es')-concat (Rec off len arr) (Rec off' len' arr') = Rec 0 (len + len') $ runSmallArray do-  marr <- newArr (len + len')-  copySmallArray marr 0 arr off len-  copySmallArray marr len arr' off' len'+concat :: Rec es -> Rec es' -> Rec (es ++ es')+concat (Rec off len arr) (Rec off' len' arr') = Rec 0 (len + len') $ runPrimArray do+  marr <- newPrimArray (len + len')+  copyPrimArray marr 0 arr off len+  copyPrimArray marr len arr' off' len'   pure marr  -- | Slice off one entry from the top of the record. \( O(1) \).-tail :: Rec f (e : es) -> Rec f es+tail :: Rec (e : es) -> Rec es tail (Rec off len arr) = Rec (off + 1) (len - 1) arr --- | @'KnownList' es@ means the list @es@ is concrete, i.e. is of the form @'[a1, a2, ..., an]@ instead of a type+-- | @'KnownList' es@ means the list @es@ is concrete, /i.e./ is of the form @'[a1, a2, ..., an]@ instead of a type -- variable.-class KnownList (es :: [k]) where+class KnownList (es :: [Effect]) where   -- | Get the length of the list.   reifyLen :: Int   reifyLen = unreifiable "KnownList" "Cleff.Internal.Rec.reifyLen" "the length of a type-level list"@@ -110,47 +109,52 @@   reifyLen = 0  instance KnownList es => KnownList (e : es) where-  reifyLen = 1 + reifyLen @_ @es+  reifyLen = 1 + reifyLen @es  -- | Slice off several entries from the top of the record. \( O(1) \).-drop :: ∀ es es' f. KnownList es => Rec f (es ++ es') -> Rec f es'+drop :: ∀ es es'. KnownList es => Rec (es ++ es') -> Rec es' drop (Rec off len arr) = Rec (off + len') (len - len') arr-  where len' = reifyLen @_ @es+  where len' = reifyLen @es  -- | Get the head of the record. \( O(1) \).-head :: Rec f (e : es) -> f e-head (Rec off _ arr) = fromAny $ indexSmallArray arr off+head :: Rec (e : es) -> HandlerPtr e+head (Rec off _ arr) = HandlerPtr $ indexPrimArray arr off  -- | Take elements from the top of the record. \( O(m) \).-take :: ∀ es es' f. KnownList es => Rec f (es ++ es') -> Rec f es-take (Rec off _ arr) = Rec 0 len $ cloneSmallArray arr off len-  where len = reifyLen @_ @es+take :: ∀ es es'. KnownList es => Rec (es ++ es') -> Rec es+take (Rec off _ arr) = Rec 0 len $ runPrimArray do+  marr <- newPrimArray len+  copyPrimArray marr 0 arr off len+  pure marr+  where len = reifyLen @es --- | The element @e@ is present in the list @es@.-class Elem (e :: k) (es :: [k]) where+-- | @e ':>' es@ means the effect @e@ is present in the effect stack @es@, and therefore can be 'Cleff.send'ed in an+-- @'Cleff.Eff' es@ computation.+class (e :: Effect) :> (es :: [Effect]) where   -- | Get the index of the element.   reifyIndex :: Int   reifyIndex = unreifiable "Elem" "Cleff.Internal.Rec.reifyIndex" "the index of an element of a type-level list"+infix 0 :>  -- | The element closer to the head takes priority.-instance {-# OVERLAPPING #-} Elem e (e : es) where+instance {-# OVERLAPPING #-} e :> e : es where   reifyIndex = 0 -instance Elem e es => Elem e (e' : es) where-  reifyIndex = 1 + reifyIndex @_ @e @es+instance e :> es => e :> e' : es where+  reifyIndex = 1 + reifyIndex @e @es  type ElemNotFound e = Text "The element '" :<>: ShowType e :<>: Text "' is not present in the constraint" -instance TypeError (ElemNotFound e) => Elem e '[] where+instance TypeError (ElemNotFound e) => e :> '[] where   reifyIndex = error-    "Cleff.Internal.Rec.reifyIndex: Attempting to refer to a nonexistent member. Please report this as a bug."+    "Cleff.Internal.reifyIndex: Attempting to refer to a nonexistent member. Please report this as a bug."  -- | Get an element in the record. Amortized \( O(1) \).-index :: ∀ e es f. Elem e es => Rec f es -> f e-index (Rec off _ arr) = fromAny $ indexSmallArray arr (off + reifyIndex @_ @e @es)+index :: ∀ e es. e :> es => Rec es -> HandlerPtr e+index (Rec off _ arr) = HandlerPtr $ indexPrimArray arr (off + reifyIndex @e @es) --- | @es@ is a subset of @es'@, i.e. all elements of @es@ are in @es'@.-class KnownList es => Subset (es :: [k]) (es' :: [k]) where+-- | @es@ is a subset of @es'@, /i.e./ all elements of @es@ are in @es'@.+class KnownList es => Subset (es :: [Effect]) (es' :: [Effect]) where   -- | Get a list of indices of the elements.   reifyIndices :: [Int]   reifyIndices = unreifiable@@ -159,25 +163,26 @@ instance Subset '[] es where   reifyIndices = [] -instance (Subset es es', Elem e es') => Subset (e : es) es' where-  reifyIndices = reifyIndex @_ @e @es' : reifyIndices @_ @es @es'+instance (Subset es es', e :> es') => Subset (e : es) es' where+  reifyIndices = reifyIndex @e @es' : reifyIndices @es @es'  -- | Get a subset of the record. Amortized \( O(m) \).-pick :: ∀ es es' f. Subset es es' => Rec f es' -> Rec f es-pick (Rec off _ arr) = Rec 0 (reifyLen @_ @es) $ runSmallArray do-  marr <- newArr (reifyLen @_ @es)-  go marr 0 (reifyIndices @_ @es @es')+pick :: ∀ es es'. Subset es es' => Rec es' -> Rec es+pick (Rec off _ arr) = Rec 0 (reifyLen @es) $ runPrimArray do+  marr <- newPrimArray (reifyLen @es)+  go marr 0 (reifyIndices @es @es')   pure marr   where-    go :: SmallMutableArray s Any -> Int -> [Int] -> ST s ()+    go :: MutablePrimArray s Int -> Int -> [Int] -> ST s ()     go _ _ [] = pure ()     go marr newIx (ix : ixs) = do-      writeSmallArray marr newIx $ indexSmallArray arr (off + ix)+      writePrimArray marr newIx $ indexPrimArray arr (off + ix)       go marr (newIx + 1) ixs  -- | Update an entry in the record. \( O(n) \).-update :: ∀ e es f. Elem e es => f e -> Rec f es -> Rec f es-update x (Rec off len arr) = Rec 0 len $ runSmallArray do-  marr <- thawSmallArray arr off len-  writeSmallArray marr (reifyIndex @_ @e @es) (toAny x)+update :: ∀ e es. e :> es => HandlerPtr e -> Rec es -> Rec es+update x (Rec off len arr) = Rec 0 len $ runPrimArray do+  marr <- newPrimArray len+  copyPrimArray marr 0 arr off len+  writePrimArray marr (reifyIndex @e @es) (unHandlerPtr x)   pure marr

@@ -27,7 +27,7 @@ import           Language.Haskell.TH.PprLib   (text, (<>)) import           Prelude                      hiding ((<>)) --- | For a datatype @T@ representing an effect, @'makeEffect' T@ generates functions defintions for performing the+-- | For a datatype @T@ representing an effect, @'makeEffect' T@ generates function defintions for performing the -- operations of @T@ via 'send'. For example, -- -- @@@ -58,7 +58,7 @@ -- documentation to the function signature, /e.g./: -- -- @--- data Identity :: 'Effect' where+-- data Identity :: 'Cleff.Effect' where --   Noop :: Identity m () -- 'makeEffect_' ''Identity --

@@ -48,7 +48,7 @@  makeEffect_ ''Mask --- | Prevents a computation from receiving asynchronous exceptions, i.e. being interrupted by another thread. Also+-- | Prevents a computation from receiving asynchronous exceptions, /i.e./ being interrupted by another thread. Also -- provides a function to restore receiving async exceptions for a computation. -- -- However, some potentially blocking actions like @takeMVar@ can still be interrupted, and for them also not to be

@@ -1,130 +0,0 @@-{-# OPTIONS_GHC -Wno-orphans #-}-module RecSpec where--import           Cleff.Internal.Rec        (Elem, Rec (Rec), type (++))-import qualified Cleff.Internal.Rec        as Rec-import           Data.Functor.Identity     (Identity (Identity))-import           Data.Primitive.SmallArray (indexSmallArray, sizeofSmallArray)-import           Data.Typeable             (cast)-import           Test.Hspec--type I = Identity-i :: a -> Identity a-i = Identity---- | Test the size invariant of 'Rec'.-sizeInvariant :: Rec f es -> Rec f es-sizeInvariant xs@(Rec off len arr)-  | tracked == actual = xs-  | otherwise = error $-    "Cleff.Internal.Rec.sizeInvariant: tracked size " <> show tracked <> ", actual size " <> show actual-  where-    tracked = len + off-    actual = sizeofSmallArray arr---- | Test whether all fields of 'Rec' are really set.-allAccessible :: Rec f es -> Rec f es-allAccessible xs@(Rec off len arr) = go 0-  where-    go n-      | n == len = xs-      | otherwise = indexSmallArray arr (off + n) `seq` go (n + 1)---- | Test all invariants.-invariant :: Rec f es -> Rec f es-invariant = allAccessible . sizeInvariant--singleton :: f e -> Rec f '[e]-singleton x = x <:> Rec.empty--(<:>) :: f e -> Rec f es -> Rec f (e : es)-(<:>) = Rec.cons-infixr 5 <:>--(<++>) :: Rec f es -> Rec f es' -> Rec f (es ++ es')-(<++>) = Rec.concat-infixr 5 <++>--(<//>) :: Elem e es => f e -> Rec f es -> Rec f es-(<//>) = Rec.update-infixr 9 <//>--instance Eq (Rec f '[]) where-  _ == _ = True--instance (Eq (Rec f xs), Eq (f x)) => Eq (Rec f (x : xs)) where-  xs == ys = Rec.head xs == Rec.head ys && Rec.tail xs == Rec.tail ys--instance Show (Rec f '[]) where-  show _ = "empty"--instance (Show (f x), Show (Rec f xs)) => Show (Rec f (x : xs)) where-  showsPrec p xs = showParen (p > consPrec) $-    showsPrec (consPrec + 1) (Rec.head xs) . showString " <:> " . showsPrec consPrec (Rec.tail xs)-    where consPrec = 5--spec :: Spec-spec = describe "Rec (SmallArray)" $ parallel do-  it "is Typeable" do-    let-      x = i (5 :: Int) <:> i False <:> Rec.empty-      y = cast x :: Maybe (Rec I '[Int, String])-      z = cast x :: Maybe (Rec I '[Int, Bool])-    y `shouldBe` Nothing-    z `shouldBe` Just x--  it "can be constructed with 'empty', 'cons', 'concat'" do-    let-      x = invariant $ i (5 :: Int) <:> i False <:> i 'X' <:> i (Just 'O') <:> Rec.empty-      y = invariant $ singleton (i (5 :: Int)) <++> singleton (i False)-        <++> singleton (i 'X') <++> singleton (i (Just 'O'))-      a = invariant $ i (5 :: Int) <:> singleton (i False)-      b = invariant $  singleton (i 'X') <++> singleton (i (Just 'O'))-    x `shouldBe` y-    invariant (a <++> b) `shouldBe` x--  it "can contain multiple fields of the same type" do-    let-      x = i (5 :: Int) <:> i False <:> i 'X' <:> i (Just 'O') <:> Rec.empty-      y = i (5 :: Int) <:> i False <:> i 'X' <:> i (Just 'O') <:> i (6 :: Int) <:> i (Just 'A') <:> Rec.empty-    invariant (x <++> 6 <:> i (Just 'A') <:> Rec.empty) `shouldBe` y--  it "can be destructed via 'head', 'tail', 'take', 'drop'" do-    let-      a = (x <:> y) <++> singleton z-      x = i (5 :: Int)-      y = i (singleton $ i False) <:> i 'X' <:> Rec.empty-      z = i (Just 'O')-    Rec.head a `shouldBe` x-    invariant (Rec.drop @'[Int, Rec I '[Bool], Char] a) `shouldBe` singleton z-    invariant (Rec.tail a) `shouldBe` invariant (y <++> singleton z)-    invariant (Rec.take @'[Int, Rec I '[Bool], Char] a) `shouldBe` (x <:> y)--  it "can get elements via 'index'" do-    let x = i (5 :: Int) <:> i False <:> i 'X' <:> i (Just 'O') <:> Rec.empty-    Rec.index @Int x `shouldBe` 5-    Rec.index @Bool x `shouldBe` i False-    Rec.index @Char x `shouldBe` i 'X'-    Rec.index @(Maybe Char) x `shouldBe` i (Just 'O')--  it "can get the topmost element among the duplicate ones" do-    let y = i (5 :: Int) <:> i False <:> i 'X' <:> i (Just 'O') <:> i (6 :: Int) <:> i (Just 'A') <:> Rec.empty-    Rec.index @Int y `shouldBe` 5-    Rec.index @Bool y `shouldBe` i False-    Rec.index @Char y `shouldBe` i 'X'-    Rec.index @(Maybe Char) y `shouldBe` i (Just 'O')--  it "can set elements via 'update'" do-    let x = i (5 :: Int) <:> i False <:> i 'X' <:> i (Just 'O') <:> Rec.empty-    invariant (Rec.update @Int 6 x) `shouldBe` 6 <:> i False <:> i 'X' <:> i (Just 'O') <:> Rec.empty-    invariant (i True <//> x) `shouldBe` 5 <:> i True <:> i 'X' <:> i (Just 'O') <:> Rec.empty-    invariant (i 'O' <//> x) `shouldBe` 5 <:> i False <:> i 'O' <:> i (Just 'O') <:> Rec.empty-    invariant (i (Just 'P') <//> x) `shouldBe` 5 <:> i False <:> i 'X' <:> i (Just 'P') <:> Rec.empty--  it "can get multiple elements via 'pick'" do-    let x = i (5 :: Int) <:> i False <:> i 'X' <:> i (Just 'O') <:> Rec.empty-    invariant (Rec.pick @'[Int, Maybe Char] x) `shouldBe` 5 <:> i (Just 'O') <:> Rec.empty--  it "can reorder elements via 'pick'" do-    let x = i (5 :: Int) <:> i False <:> i 'X' <:> i (Just 'O') <:> Rec.empty-    invariant (Rec.pick @'[Bool, Int, Maybe Char] x) `shouldBe` i False <:> 5 <:> i (Just 'O') <:> Rec.empty