c851bda · effectful · git.iko.soy

git.iko.soy/effectful

on master help sign in

unsafe{Put,State,Modify}Env are safe

c851bdaAndrzej Rybczak5 years ago

effectful-core/src/Effectful/Internal/Env.hs+34−28

compare with master

unifiedsplit

@@ -9,22 +9,22 @@ module Effectful.Internal.Env

9 , Relinker(..)

10 , noRelinker

12− -- * Safe operations

12+ -- * Operations

13 , emptyEnv

14 , cloneEnv

15 , forkEnv

16 , sizeEnv

17− , getEnv

18 , checkSizeEnv

17 , checkSizeEnv

20− -- * Extending and shrinking

19+ -- ** Extending and shrinking

21 , unsafeConsEnv

20 , unsafeConsEnv

22 , unsafeTailEnv

21 , unsafeTailEnv

24− -- * Data retrieval and update

23+ -- ** Data retrieval and update

25− , unsafePutEnv

24+ , getEnv

26− , unsafeModifyEnv

25+ , putEnv

27− , unsafeStateEnv

26+ , stateEnv

27+ , modifyEnv

28 ) where

30import Control.Monad

@@ -322,12 +322,6 @@ sizeEnv (Env (Forks _ baseIx lref _) _ _) = do

322 pure $ baseIx + n

323{-# NOINLINE sizeEnv #-}

324

325−-- | Extract a specific data type from the environment.

326−getEnv :: forall e es handler. e :> es => Env es -> IO (handler e)

327−getEnv env = do

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

329− fromAny <$> readSmallArray es i

330−

331-- | Check that the size of the environment is the same as the expected value.

325-- | Check that the size of the environment is the same as the expected value.

332checkSizeEnv :: Int -> Env es -> IO ()

326checkSizeEnv :: Int -> Env es -> IO ()

333checkSizeEnv k (Env NoFork ref _) = do

327checkSizeEnv k (Env NoFork ref _) = do

@@ -345,6 +339,9 @@ checkSizeEnv k (Env (Forks _ baseIx lref _) _ _) = do

345-- Extending and shrinking

339-- Extending and shrinking

346

340

347-- | Extend the environment with a new data type (in place).

341-- | Extend the environment with a new data type (in place).

342+--

343+-- /Note:/ this function is __unsafe__ because it renders the input 'Env'

344+-- unusable, but it's not checked anywhere.

348unsafeConsEnv :: handler e -> Relinker handler e -> Env es -> IO (Env (e : es))

345unsafeConsEnv :: handler e -> Relinker handler e -> Env es -> IO (Env (e : es))

349unsafeConsEnv e f (Env fork gref gen) = case fork of

346unsafeConsEnv e f (Env fork gref gen) = case fork of

350 NoFork -> do

347 NoFork -> do

@@ -380,6 +377,9 @@ unsafeConsEnv e f (Env fork gref gen) = case fork of

380

377

381-- | Shrink the environment by one data type (in place). Makes sure the size of

378-- | Shrink the environment by one data type (in place). Makes sure the size of

382-- the environment is as expected.

379-- the environment is as expected.

380+--

381+-- /Note:/ this function is __unsafe__ because it renders the input 'Env'

382+-- unusable, but it's not checked anywhere.

383unsafeTailEnv :: Int -> Env (e : es) -> IO (Env es)

384unsafeTailEnv len (Env fork gref gen) = case fork of

385 NoFork -> do

@@ -403,39 +403,45 @@ unsafeTailEnv len (Env fork gref gen) = case fork of

403----------------------------------------

404-- Data retrieval and update

405

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

406+-- | Extract a specific data type from the environment.

407−unsafePutEnv

408− :: forall e es handler. e :> es

407+getEnv :: forall e es handler. e :> es => Env es -> IO (handler e)

409− => Env es

408+getEnv env = do

410− -> handler e

411− -> IO ()

412−unsafePutEnv env e = do

413 (i, es) <- getLocation @e env

409 (i, es) <- getLocation @e env

414− e `seq` writeSmallArray es i (toAny e)

410+ fromAny <$> readSmallArray es i

415

411

416−-- | Modify the data type in the environment (in place).

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

417−unsafeModifyEnv

413+putEnv

418 :: forall e es handler. e :> es

414 :: forall e es handler. e :> es

419 => Env es

415 => Env es

420− -> (handler e -> handler e)

416+ -> handler e

421 -> IO ()

417 -> IO ()

422−unsafeModifyEnv env f = do

418+putEnv env e = do

423 (i, es) <- getLocation @e env

419 (i, es) <- getLocation @e env

424− e <- f . fromAny <$> readSmallArray es i

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

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

426

421

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

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

428−unsafeStateEnv

423+stateEnv

429 :: forall e es handler a. e :> es

424 :: forall e es handler a. e :> es

430 => Env es

425 => Env es

431 -> (handler e -> (a, handler e))

426 -> (handler e -> (a, handler e))

432 -> IO a

427 -> IO a

433−unsafeStateEnv env f = do

428+stateEnv env f = do

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

429 (i, es) <- getLocation @e env

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

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

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

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

437 pure a

432 pure a

438

433

434+-- | Modify the data type in the environment (in place).

435+modifyEnv

436+ :: forall e es handler. e :> es

437+ => Env es

438+ -> (handler e -> handler e)

439+ -> IO ()

440+modifyEnv env f = do

441+ (i, es) <- getLocation @e env

442+ e <- f . fromAny <$> readSmallArray es i

443+ e `seq` writeSmallArray es i (toAny e)

444+

439----------------------------------------

445----------------------------------------

440-- Internal helpers

446-- Internal helpers

441

447

effectful-core/src/Effectful/Internal/Monad.hs+5−5

@@ -432,19 +432,19 @@ getEffect :: e :> es => Eff es (handler e)

432getEffect = unsafeEff $ \es -> getEnv es

433

434putEffect :: e :> es => handler e -> Eff es ()

435−putEffect e = unsafeEff $ \es -> unsafePutEnv es e

435+putEffect e = unsafeEff $ \es -> putEnv es e

436

437stateEffect :: e :> es => (handler e -> (a, handler e)) -> Eff es a

438−stateEffect f = unsafeEff $ \es -> unsafeStateEnv es f

438+stateEffect f = unsafeEff $ \es -> stateEnv es f

439

440stateEffectM :: e :> es => (handler e -> Eff es (a, handler e)) -> Eff es a

441stateEffectM f = unsafeEff $ \es -> mask $ \release -> do

442 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es

443− unsafePutEnv es e

443+ putEnv es e

444 pure a

445

446localEffect :: e :> es => (handler e -> handler e) -> Eff es a -> Eff es a

447localEffect f m = unsafeEff $ \es -> do

448− bracket (unsafeStateEnv es $ \e -> (e, f e))

448+ bracket (stateEnv es $ \e -> (e, f e))

449− (\e -> unsafePutEnv es e)

449+ (\e -> putEnv es e)

450 (\_ -> unEff m es)

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

@@ -34,13 +34,13 @@ tell w = stateEffect $ \(IdE (Writer w0)) -> ((), IdE (Writer (w0 <> w)))

35listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)

36listen m = unsafeEff $ \es -> mask $ \restore -> do

37− w0 <- unsafeStateEnv es $ \(IdE (Writer w)) -> (w, IdE (Writer mempty))

37+ w0 <- stateEnv es $ \(IdE (Writer w)) -> (w, IdE (Writer mempty))

38 a <- restore (unEff m es) `onException` merge es w0

39 (a, ) <$> merge es w0

40 where

41 merge es w0 =

42 -- If an exception is thrown, restore w0 and keep parts of w1.

43− unsafeStateEnv es $ \(IdE (Writer w1)) -> (w1, IdE (Writer (w0 <> w1)))

43+ stateEnv es $ \(IdE (Writer w1)) -> (w1, IdE (Writer (w0 <> w1)))

45listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)

46listens f m = do

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

@@ -43,14 +43,14 @@ listen m = unsafeEff $ \es -> do

43 uninterruptibleMask $ \restore -> do

44 v1 <- newMVar mempty

45 -- Replace thread local MVar with a fresh one for isolated listening.

46− v0 <- unsafeStateEnv es $ \(IdE (Writer v)) -> (v, IdE (Writer v1))

46+ v0 <- stateEnv es $ \(IdE (Writer v)) -> (v, IdE (Writer v1))

47 a <- restore (unEff m es) `onException` merge es v0 v1

48 (a, ) <$> merge es v0 v1

49 where

50 -- Merge results accumulated in the local MVar with the mainline. If an

51 -- exception was received while listening, merge results recorded so far.

52 merge es v0 v1 = do

53− unsafePutEnv es $ IdE (Writer v0)

53+ putEnv es $ IdE (Writer v0)

54 w1 <- readMVar v1

55 modifyMVar_ v0 $ \w0 -> let w = w0 <> w1 in w `seq` pure w

56 pure w1