3b965ed...master · effectful

git.iko.soy/effectful

on master help sign in

.github/workflows/haskell-ci.yml−5

since splitsnapshots

unifiedsplit

@@ -37,11 +37,6 @@ jobs:

37 compilerVersion: 9.2.1

38 setup-method: ghcup

39 allow-failure: false

40− - compiler: ghc-9.0.1

41− compilerKind: ghc

42− compilerVersion: 9.0.1

43− setup-method: hvr-ppa

44− allow-failure: false

45 - compiler: ghc-8.10.7

40 - compiler: ghc-8.10.7

46 compilerKind: ghc

41 compilerKind: ghc

47 compilerVersion: 8.10.7

42 compilerVersion: 8.10.7

effectful-core/effectful-core.cabal+1−1

@@ -18,7 +18,7 @@ description: An easy to use, performant extensible effects library with seamless

19extra-source-files: CHANGELOG.md

21−tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.1 || ==9.2.1

21+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.2.1

23bug-reports: https://github.com/arybczak/effectful/issues

24source-repository head

effectful-core/src/Effectful/Internal/Env.hs+21−16

@@ -1,3 +1,4 @@

1+{-# LANGUAGE MagicHash #-}

1{-# OPTIONS_HADDOCK not-home #-}

2{-# OPTIONS_HADDOCK not-home #-}

2-- | The environment for the 'Effectful.Internal.Monad.Eff' monad.

3-- | The environment for the 'Effectful.Internal.Monad.Eff' monad.

3--

4--

@@ -42,7 +43,7 @@ import Control.Monad

42import Control.Monad.Primitive

43import Control.Monad.Primitive

43import Data.IORef

44import Data.IORef

44import Data.Primitive.SmallArray

45import Data.Primitive.SmallArray

45−import GHC.Exts (Any)

46+import GHC.Exts (Any, SmallMutableArray#)

46import GHC.Stack (HasCallStack)

47import GHC.Stack (HasCallStack)

47import Unsafe.Coerce

48import Unsafe.Coerce

48import qualified Data.IntMap.Strict as IM

49import qualified Data.IntMap.Strict as IM

@@ -421,7 +422,7 @@ getEnv

421 => Env es

422 => Env es

422 -> IO (adapter e)

423 -> IO (adapter e)

423getEnv env = do

424getEnv env = do

424− (i, es) <- getLocation (reifyIndex @e @es) env

425+ Location i es <- getLocation (reifyIndex @e @es) env

425 fromAny <$> readSmallArray es i

426 fromAny <$> readSmallArray es i

426

427

427-- | Replace the data type in the environment with a new value (in place).

428-- | Replace the data type in the environment with a new value (in place).

@@ -431,7 +432,7 @@ putEnv

431 -> adapter e

432 -> adapter e

432 -> IO ()

433 -> IO ()

433putEnv env e = do

434putEnv env e = do

434− (i, es) <- getLocation (reifyIndex @e @es) env

435+ Location i es <- getLocation (reifyIndex @e @es) env

435 e `seq` writeSmallArray es i (toAny e)

436 e `seq` writeSmallArray es i (toAny e)

436

437

437-- | Modify the data type in the environment (in place) and return a value.

438-- | Modify the data type in the environment (in place) and return a value.

@@ -441,7 +442,7 @@ stateEnv

441 -> (adapter e -> (a, adapter e))

442 -> (adapter e -> (a, adapter e))

442 -> IO a

443 -> IO a

443stateEnv env f = do

444stateEnv env f = do

444− (i, es) <- getLocation (reifyIndex @e @es) env

445+ Location i es <- getLocation (reifyIndex @e @es) env

445 (a, e) <- f . fromAny <$> readSmallArray es i

446 (a, e) <- f . fromAny <$> readSmallArray es i

446 e `seq` writeSmallArray es i (toAny e)

447 e `seq` writeSmallArray es i (toAny e)

447 pure a

448 pure a

@@ -453,7 +454,7 @@ modifyEnv

453 -> (adapter e -> adapter e)

454 -> (adapter e -> adapter e)

454 -> IO ()

455 -> IO ()

455modifyEnv env f = do

456modifyEnv env f = do

456− (i, es) <- getLocation (reifyIndex @e @es) env

457+ Location i es <- getLocation (reifyIndex @e @es) env

457 e <- f . fromAny <$> readSmallArray es i

458 e <- f . fromAny <$> readSmallArray es i

458 e `seq` writeSmallArray es i (toAny e)

459 e `seq` writeSmallArray es i (toAny e)

459

460

@@ -469,13 +470,17 @@ emptyEnvRef = do

469 fs <- newSmallArray 0 undefinedData

470 fs <- newSmallArray 0 undefinedData

470 newIORef $ EnvRef 0 es fs

471 newIORef $ EnvRef 0 es fs

471

472

473+-- | Location with unboxed fields to make GHC generate Core without unnecessary

474+-- reboxing around the local 'go' function from 'getLocation'.

475+data Location = Location !Int !(SmallMutableArray RealWorld Any)

476+

472-- | Determine location of the data type in the environment.

477-- | Determine location of the data type in the environment.

473getLocation

478getLocation

474 :: Int

479 :: Int

475 -> Env es

480 -> Env es

476− -> IO (Int, SmallMutableArray RealWorld Any)

481+ -> IO Location

477getLocation ixE (Env fork ref _) = do

482getLocation ixE (Env fork ref _) = do

478− EnvRef n es _ <- readIORef ref

483+ EnvRef n es@(SmallMutableArray es#) _ <- readIORef ref

479 -- Optimized for the common access pattern:

484 -- Optimized for the common access pattern:

480 --

485 --

481 -- - Most application code has no access to forks, in which case we look at

486 -- - Most application code has no access to forks, in which case we look at

@@ -484,25 +489,25 @@ getLocation ixE (Env fork ref _) = do

484 -- - Effect handlers will most likely access the newest fork with handler

489 -- - Effect handlers will most likely access the newest fork with handler

485 -- specific effects for reinterpretation.

490 -- specific effects for reinterpretation.

486 case fork of

491 case fork of

487− NoFork -> pure (ix n, es)

492+ NoFork -> pure $ Location (ix n) es

488 Forks _ baseIx lref forks -> do

493 Forks _ baseIx lref forks -> do

489 EnvRef ln les _ <- readIORef lref

494 EnvRef ln les _ <- readIORef lref

490 let i = ix (baseIx + ln)

495 let i = ix (baseIx + ln)

491 if i >= baseIx

496 if i >= baseIx

492− then pure (i - baseIx, les)

497+ then pure $ Location (i - baseIx) les

493− else go es i forks

498+ else go es# i forks

494 where

499 where

495− go :: SmallMutableArray RealWorld Any

500+ go :: SmallMutableArray# RealWorld Any

496 -> Int

501 -> Int

497 -> Forks

502 -> Forks

498− -> IO (Int, SmallMutableArray RealWorld Any)

503+ -> IO Location

499− go es i = \case

504+ go es# i = \case

500− NoFork -> pure (i, es)

505+ NoFork -> pure $ Location i (SmallMutableArray es#)

501 Forks _ baseIx lref forks -> do

506 Forks _ baseIx lref forks -> do

502 EnvRef _ les _ <- readIORef lref

507 EnvRef _ les _ <- readIORef lref

503 if i >= baseIx

508 if i >= baseIx

504− then pure (i - baseIx, les)

509+ then pure $ Location (i - baseIx) les

505− else go es i forks

510+ else go es# i forks

506

511

507 ix :: Int -> Int

512 ix :: Int -> Int

508 ix n = n - ixE - 1

513 ix n = n - ixE - 1

effectful-core/src/Effectful/Writer/Local.hs+3−3

@@ -55,9 +55,9 @@ tell w = stateData $ \(DataA (Writer w0)) -> ((), DataA (Writer (w0 <> w)))

55-- | Execute an action and append its output to the overall output of the

56-- 'Writer'.

57--

58−-- /Note:/ if a runtime exception is received while the action is executed, the

58+-- /Note:/ if an exception is received while the action is executed, the partial

59−-- partial output of the action will still be appended to the overall output of

59+-- output of the action will still be appended to the overall output of the

60−-- the 'Writer':

60+-- 'Writer':

61--

62-- >>> :{

63-- runEff . execWriter @String $ do

effectful-core/src/Effectful/Writer/Shared.hs+3−3

@@ -59,9 +59,9 @@ tell w1 = unsafeEff $ \es -> do

59-- | Execute an action and append its output to the overall output of the

60-- 'Writer'.

61--

62−-- /Note:/ if a runtime exception is received while the action is executed, the

62+-- /Note:/ if an exception is received while the action is executed, the partial

63−-- partial output of the action will still be appended to the overall output of

63+-- output of the action will still be appended to the overall output of the

64−-- the 'Writer':

64+-- 'Writer':

65--

66-- >>> :{

67-- runEff . execWriter @String $ do

effectful/bench/Main.hs+3−3

@@ -97,11 +97,11 @@ filesize n = bgroup (show n)

97#ifdef VERSION_eff

98 , bench "eff" $ nfAppIO eff_calculateFileSizesDeep (take n files)

99#endif

100−#ifdef VERSION_polysemy

101− , bench "polysemy" $ nfAppIO poly_calculateFileSizesDeep (take n files)

102−#endif

103#ifdef VERSION_mtl

100#ifdef VERSION_mtl

104 , bench "mtl" $ nfAppIO mtl_calculateFileSizesDeep (take n files)

101 , bench "mtl" $ nfAppIO mtl_calculateFileSizesDeep (take n files)

102+#endif

103+#ifdef VERSION_polysemy

104+ , bench "polysemy" $ nfAppIO poly_calculateFileSizesDeep (take n files)

105#endif

106 ]

107 ]

effectful/effectful.cabal+1−1

@@ -20,7 +20,7 @@ description: An easy to use, performant extensible effects library with seamless

21extra-source-files: CHANGELOG.md

23−tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.1 || ==9.2.1

23+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.2.1

25bug-reports: https://github.com/arybczak/effectful/issues

26source-repository head