├── test ├── Bench.js ├── Examples.js ├── Bench.purs ├── Examples.purs └── Main.purs ├── .gitignore ├── .tidyrc.json ├── package.json ├── .github └── workflows │ └── ci.yml ├── src ├── Run │ ├── Internal.purs │ ├── Choose.purs │ ├── Reader.purs │ ├── Writer.purs │ ├── State.purs │ └── Except.purs └── Run.purs ├── LICENSE ├── bower.json └── README.md /test/Bench.js: -------------------------------------------------------------------------------- 1 | export function gc() { 2 | return global.gc(); 3 | } 4 | -------------------------------------------------------------------------------- /test/Examples.js: -------------------------------------------------------------------------------- 1 | "use strict"; 2 | 3 | export function setTimeout(ms) { 4 | return function (eff) { 5 | return function () { 6 | setTimeout(eff, ms); 7 | }; 8 | }; 9 | } 10 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /bower_components/ 2 | /node_modules/ 3 | /.pulp-cache/ 4 | /output/ 5 | /.psc* 6 | /.purs* 7 | /src/.webpack.js 8 | npm-debug.log 9 | .psa-stash 10 | .vscode 11 | package-lock.json 12 | -------------------------------------------------------------------------------- /.tidyrc.json: -------------------------------------------------------------------------------- 1 | { 2 | "importWrap": "source", 3 | "indent": 2, 4 | "operatorsFile": null, 5 | "ribbon": 1, 6 | "typeArrowPlacement": "first", 7 | "unicode": "never", 8 | "width": null 9 | } 10 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "private": true, 3 | "scripts": { 4 | "build": "pulp build -- --censor-lib --strict", 5 | "test": "pulp test", 6 | "format": "purs-tidy format-in-place src test", 7 | "check": "purs-tidy check src test", 8 | "ide": "purs ide server" 9 | }, 10 | "devDependencies": { 11 | "pulp": "^16.0.0", 12 | "purescript": "^0.15.0", 13 | "purescript-psa": "^0.8.2", 14 | "purs-tidy": "^0.8.0" 15 | } 16 | } 17 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [master] 6 | pull_request: 7 | 8 | jobs: 9 | build: 10 | runs-on: ubuntu-latest 11 | 12 | steps: 13 | - uses: actions/checkout@v2 14 | 15 | - name: Install dependencies 16 | run: | 17 | npm install 18 | npm install -g bower 19 | bower install --production 20 | 21 | - name: Build and test 22 | run: | 23 | npm run -s build 24 | bower install 25 | npm run -s test 26 | npm run -s check 27 | -------------------------------------------------------------------------------- /src/Run/Internal.purs: -------------------------------------------------------------------------------- 1 | module Run.Internal 2 | ( Choose(..) 3 | , CHOOSE 4 | , _choose 5 | , toRows 6 | , fromRows 7 | ) where 8 | 9 | import Prelude 10 | 11 | import Type.Equality (class TypeEquals) 12 | import Type.Proxy (Proxy(..)) 13 | import Unsafe.Coerce (unsafeCoerce) 14 | 15 | data Choose a 16 | = Empty 17 | | Alt (Boolean -> a) 18 | 19 | derive instance functorChoose :: Functor Choose 20 | 21 | type CHOOSE r = (choose :: Choose | r) 22 | 23 | _choose :: Proxy "choose" 24 | _choose = Proxy 25 | 26 | toRows 27 | :: forall f r1 r2 a 28 | . TypeEquals (Proxy r1) (Proxy r2) 29 | => f r1 a 30 | -> f r2 a 31 | toRows = unsafeCoerce 32 | 33 | fromRows 34 | :: forall f r1 r2 a 35 | . TypeEquals (Proxy r1) (Proxy r2) 36 | => f r2 a 37 | -> f r1 a 38 | fromRows = unsafeCoerce 39 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016 Nathan Faubion 2 | 3 | Permission is hereby granted, free of charge, to any person 4 | obtaining a copy of this software and associated documentation 5 | files (the "Software"), to deal in the Software without 6 | restriction, including without limitation the rights to use, 7 | copy, modify, merge, publish, distribute, sublicense, and/or sell 8 | copies of the Software, and to permit persons to whom the 9 | Software is furnished to do so, subject to the following 10 | conditions: 11 | 12 | The above copyright notice and this permission notice shall be 13 | included in all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 16 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES 17 | OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 18 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 19 | HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 20 | WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 21 | FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. 23 | -------------------------------------------------------------------------------- /src/Run/Choose.purs: -------------------------------------------------------------------------------- 1 | module Run.Choose 2 | ( liftChoose 3 | , cempty 4 | , calt 5 | , runChoose 6 | , module Run.Internal 7 | ) where 8 | 9 | import Prelude 10 | 11 | import Control.Alternative (class Alternative, alt, empty) 12 | import Data.Either (Either(..)) 13 | import Run (Run) 14 | import Run as Run 15 | import Run.Internal (Choose(..), CHOOSE, _choose) 16 | import Type.Row (type (+)) 17 | 18 | liftChoose :: forall r a. Choose a -> Run (CHOOSE + r) a 19 | liftChoose = Run.lift _choose 20 | 21 | cempty :: forall r a. Run (CHOOSE + r) a 22 | cempty = empty 23 | 24 | calt :: forall r a. Run (CHOOSE + r) a -> Run (CHOOSE + r) a -> Run (CHOOSE + r) a 25 | calt = alt 26 | 27 | runChoose :: forall f a r. Alternative f => Run (CHOOSE + r) a -> Run r (f a) 28 | runChoose = loop 29 | where 30 | handle = Run.on _choose Left Right 31 | loop r = case Run.peel r of 32 | Left a -> case handle a of 33 | Left a' -> case a' of 34 | Empty -> pure empty 35 | Alt k -> do 36 | x <- loop (k true) 37 | y <- loop (k false) 38 | pure (alt x y) 39 | Right a' -> 40 | Run.send a' >>= loop 41 | Right a -> 42 | pure (pure a) 43 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-run", 3 | "homepage": "https://github.com/natefaubion/purescript-run", 4 | "authors": [ 5 | "Nathan Faubion " 6 | ], 7 | "description": "An extensible-effects implementation for PureScript", 8 | "license": "MIT", 9 | "keywords": [ 10 | "purescript", 11 | "extensible", 12 | "effects" 13 | ], 14 | "repository": { 15 | "type": "git", 16 | "url": "https://github.com/natefaubion/purescript-run.git" 17 | }, 18 | "ignore": [ 19 | "**/.*", 20 | "node_modules", 21 | "bower_components", 22 | "output", 23 | "test" 24 | ], 25 | "dependencies": { 26 | "purescript-aff": "^7.0.0", 27 | "purescript-either": "^6.0.0", 28 | "purescript-free": "^7.0.0", 29 | "purescript-maybe": "^6.0.0", 30 | "purescript-newtype": "^5.0.0", 31 | "purescript-prelude": "^6.0.0", 32 | "purescript-tailrec": "^6.0.0", 33 | "purescript-tuples": "^7.0.0", 34 | "purescript-type-equality": "^4.0.0", 35 | "purescript-unsafe-coerce": "^6.0.0", 36 | "purescript-variant": "^8.0.0", 37 | "purescript-profunctor": "^6.0.0", 38 | "purescript-effect": "^4.0.0", 39 | "purescript-typelevel-prelude": "^7.0.0" 40 | }, 41 | "devDependencies": { 42 | "purescript-control": "^6.0.0", 43 | "purescript-minibench": "^4.0.0", 44 | "purescript-identity": "^6.0.0", 45 | "purescript-console": "^6.0.0" 46 | } 47 | } 48 | -------------------------------------------------------------------------------- /src/Run/Reader.purs: -------------------------------------------------------------------------------- 1 | module Run.Reader 2 | ( Reader(..) 3 | , READER 4 | , _reader 5 | , liftReader 6 | , liftReaderAt 7 | , ask 8 | , asks 9 | , askAt 10 | , asksAt 11 | , local 12 | , localAt 13 | , runReader 14 | , runReaderAt 15 | ) where 16 | 17 | import Prelude 18 | 19 | import Data.Either (Either(..)) 20 | import Data.Symbol (class IsSymbol) 21 | import Prim.Row as Row 22 | import Run (Run) 23 | import Run as Run 24 | import Type.Proxy (Proxy(..)) 25 | import Type.Row (type (+)) 26 | 27 | newtype Reader e a = Reader (e -> a) 28 | 29 | derive newtype instance functorReader :: Functor (Reader e) 30 | 31 | type READER e r = (reader :: Reader e | r) 32 | 33 | _reader :: Proxy "reader" 34 | _reader = Proxy 35 | 36 | liftReader :: forall e a r. Reader e a -> Run (READER e + r) a 37 | liftReader = liftReaderAt _reader 38 | 39 | liftReaderAt 40 | :: forall t e a r s 41 | . IsSymbol s 42 | => Row.Cons s (Reader e) t r 43 | => Proxy s 44 | -> Reader e a 45 | -> Run r a 46 | liftReaderAt = Run.lift 47 | 48 | ask :: forall e r. Run (READER e + r) e 49 | ask = askAt _reader 50 | 51 | askAt 52 | :: forall t e r s 53 | . IsSymbol s 54 | => Row.Cons s (Reader e) t r 55 | => Proxy s 56 | -> Run r e 57 | askAt sym = asksAt sym identity 58 | 59 | asks :: forall e r a. (e -> a) -> Run (READER e + r) a 60 | asks = asksAt _reader 61 | 62 | asksAt 63 | :: forall t e r s a 64 | . IsSymbol s 65 | => Row.Cons s (Reader e) t r 66 | => Proxy s 67 | -> (e -> a) 68 | -> Run r a 69 | asksAt sym f = liftReaderAt sym (Reader f) 70 | 71 | local :: forall e a r. (e -> e) -> Run (READER e + r) a -> Run (READER e + r) a 72 | local = localAt _reader 73 | 74 | localAt 75 | :: forall t e a r s 76 | . IsSymbol s 77 | => Row.Cons s (Reader e) t r 78 | => Proxy s 79 | -> (e -> e) 80 | -> Run r a 81 | -> Run r a 82 | localAt sym = \f r -> map f (askAt sym) >>= flip runLocal r 83 | where 84 | handle = Run.on sym Left Right 85 | runLocal = loop 86 | where 87 | loop e r = case Run.peel r of 88 | Left a -> case handle a of 89 | Left (Reader k) -> 90 | loop e (k e) 91 | Right _ -> 92 | Run.send a >>= runLocal e 93 | Right a -> 94 | pure a 95 | 96 | runReader :: forall e a r. e -> Run (READER e + r) a -> Run r a 97 | runReader = runReaderAt _reader 98 | 99 | runReaderAt 100 | :: forall t e a r s 101 | . IsSymbol s 102 | => Row.Cons s (Reader e) t r 103 | => Proxy s 104 | -> e 105 | -> Run r a 106 | -> Run t a 107 | runReaderAt sym = loop 108 | where 109 | handle = Run.on sym Left Right 110 | loop e r = case Run.peel r of 111 | Left a -> case handle a of 112 | Left (Reader k) -> 113 | loop e (k e) 114 | Right a' -> 115 | Run.send a' >>= runReaderAt sym e 116 | Right a -> 117 | pure a 118 | -------------------------------------------------------------------------------- /src/Run/Writer.purs: -------------------------------------------------------------------------------- 1 | module Run.Writer 2 | ( Writer(..) 3 | , WRITER 4 | , _writer 5 | , liftWriter 6 | , liftWriterAt 7 | , tell 8 | , tellAt 9 | , censor 10 | , censorAt 11 | , foldWriter 12 | , foldWriterAt 13 | , runWriter 14 | , runWriterAt 15 | ) where 16 | 17 | import Prelude 18 | 19 | import Data.Either (Either(..)) 20 | import Data.Symbol (class IsSymbol) 21 | import Data.Tuple (Tuple(..)) 22 | import Prim.Row as Row 23 | import Run (Run) 24 | import Run as Run 25 | import Type.Proxy (Proxy(..)) 26 | import Type.Row (type (+)) 27 | 28 | data Writer w a = Writer w a 29 | 30 | derive instance functorWriter :: Functor (Writer w) 31 | 32 | type WRITER w r = (writer :: Writer w | r) 33 | 34 | _writer :: Proxy "writer" 35 | _writer = Proxy 36 | 37 | liftWriter :: forall w a r. Writer w a -> Run (WRITER w + r) a 38 | liftWriter = liftWriterAt _writer 39 | 40 | liftWriterAt 41 | :: forall w a r t s 42 | . IsSymbol s 43 | => Row.Cons s (Writer w) t r 44 | => Proxy s 45 | -> Writer w a 46 | -> Run r a 47 | liftWriterAt = Run.lift 48 | 49 | tell :: forall w r. w -> Run (writer :: Writer w | r) Unit 50 | tell = tellAt _writer 51 | 52 | tellAt 53 | :: forall w r t s 54 | . IsSymbol s 55 | => Row.Cons s (Writer w) t r 56 | => Proxy s 57 | -> w 58 | -> Run r Unit 59 | tellAt sym w = liftWriterAt sym (Writer w unit) 60 | 61 | censor :: forall w a r. (w -> w) -> Run (writer :: Writer w | r) a -> Run (writer :: Writer w | r) a 62 | censor = censorAt _writer 63 | 64 | censorAt 65 | :: forall w a r t s 66 | . IsSymbol s 67 | => Row.Cons s (Writer w) t r 68 | => Proxy s 69 | -> (w -> w) 70 | -> Run r a 71 | -> Run r a 72 | censorAt sym = loop 73 | where 74 | handle = Run.on sym Left Right 75 | loop f r = case Run.peel r of 76 | Left a -> case handle a of 77 | Left (Writer w n) -> do 78 | tellAt sym (f w) 79 | loop f n 80 | Right _ -> 81 | Run.send a >>= loop f 82 | Right a -> 83 | pure a 84 | 85 | foldWriter :: forall w b a r. (b -> w -> b) -> b -> Run (WRITER w + r) a -> Run r (Tuple b a) 86 | foldWriter = foldWriterAt _writer 87 | 88 | foldWriterAt 89 | :: forall w b a r t s 90 | . IsSymbol s 91 | => Row.Cons s (Writer w) t r 92 | => Proxy s 93 | -> (b -> w -> b) 94 | -> b 95 | -> Run r a 96 | -> Run t (Tuple b a) 97 | foldWriterAt sym = loop 98 | where 99 | handle = Run.on sym Left Right 100 | loop k w r = case Run.peel r of 101 | Left a -> case handle a of 102 | Left (Writer w' n) -> 103 | loop k (k w w') n 104 | Right a' -> 105 | Run.send a' >>= foldWriterAt sym k w 106 | Right a -> 107 | pure (Tuple w a) 108 | 109 | runWriter :: forall w a r. Monoid w => Run (WRITER w + r) a -> Run r (Tuple w a) 110 | runWriter = runWriterAt _writer 111 | 112 | runWriterAt 113 | :: forall w a r t s 114 | . IsSymbol s 115 | => Monoid w 116 | => Row.Cons s (Writer w) t r 117 | => Proxy s 118 | -> Run r a 119 | -> Run t (Tuple w a) 120 | runWriterAt sym = foldWriterAt sym (<>) mempty 121 | -------------------------------------------------------------------------------- /src/Run/State.purs: -------------------------------------------------------------------------------- 1 | module Run.State 2 | ( State(..) 3 | , STATE 4 | , _state 5 | , liftState 6 | , liftStateAt 7 | , modify 8 | , modifyAt 9 | , put 10 | , putAt 11 | , get 12 | , getAt 13 | , gets 14 | , getsAt 15 | , runState 16 | , runStateAt 17 | , evalState 18 | , evalStateAt 19 | , execState 20 | , execStateAt 21 | ) where 22 | 23 | import Prelude 24 | 25 | import Data.Either (Either(..)) 26 | import Data.Symbol (class IsSymbol) 27 | import Data.Tuple (Tuple(..), fst, snd) 28 | import Prim.Row as Row 29 | import Run (Run) 30 | import Run as Run 31 | import Type.Proxy (Proxy(..)) 32 | import Type.Row (type (+)) 33 | 34 | data State s a = State (s -> s) (s -> a) 35 | 36 | derive instance functorState :: Functor (State s) 37 | 38 | type STATE s r = (state :: State s | r) 39 | 40 | _state :: Proxy "state" 41 | _state = Proxy 42 | 43 | liftState :: forall s a r. State s a -> Run (STATE s + r) a 44 | liftState = liftStateAt _state 45 | 46 | liftStateAt 47 | :: forall q sym s a r 48 | . IsSymbol sym 49 | => Row.Cons sym (State s) q r 50 | => Proxy sym 51 | -> State s a 52 | -> Run r a 53 | liftStateAt = Run.lift 54 | 55 | modify :: forall s r. (s -> s) -> Run (STATE s + r) Unit 56 | modify = modifyAt _state 57 | 58 | modifyAt 59 | :: forall q sym s r 60 | . IsSymbol sym 61 | => Row.Cons sym (State s) q r 62 | => Proxy sym 63 | -> (s -> s) 64 | -> Run r Unit 65 | modifyAt sym f = liftStateAt sym $ State f (const unit) 66 | 67 | put :: forall s r. s -> Run (STATE s + r) Unit 68 | put = putAt _state 69 | 70 | putAt 71 | :: forall q sym s r 72 | . IsSymbol sym 73 | => Row.Cons sym (State s) q r 74 | => Proxy sym 75 | -> s 76 | -> Run r Unit 77 | putAt sym = modifyAt sym <<< const 78 | 79 | get :: forall s r. Run (STATE s + r) s 80 | get = getAt _state 81 | 82 | getAt 83 | :: forall q sym s r 84 | . IsSymbol sym 85 | => Row.Cons sym (State s) q r 86 | => Proxy sym 87 | -> Run r s 88 | getAt sym = liftStateAt sym $ State identity identity 89 | 90 | gets :: forall s t r. (s -> t) -> Run (STATE s + r) t 91 | gets = getsAt _state 92 | 93 | getsAt 94 | :: forall q sym s t r 95 | . IsSymbol sym 96 | => Row.Cons sym (State s) q r 97 | => Proxy sym 98 | -> (s -> t) 99 | -> Run r t 100 | getsAt sym = flip map (getAt sym) 101 | 102 | runState :: forall s r a. s -> Run (STATE s + r) a -> Run r (Tuple s a) 103 | runState = runStateAt _state 104 | 105 | runStateAt 106 | :: forall q sym s r a 107 | . IsSymbol sym 108 | => Row.Cons sym (State s) q r 109 | => Proxy sym 110 | -> s 111 | -> Run r a 112 | -> Run q (Tuple s a) 113 | runStateAt sym = loop 114 | where 115 | handle = Run.on sym Left Right 116 | loop s r = case Run.peel r of 117 | Left a -> case handle a of 118 | Left (State t k) -> 119 | let 120 | s' = t s 121 | in 122 | loop s' (k s') 123 | Right a' -> 124 | Run.send a' >>= runStateAt sym s 125 | Right a -> 126 | pure (Tuple s a) 127 | 128 | evalState :: forall s r a. s -> Run (STATE s + r) a -> Run r a 129 | evalState = evalStateAt _state 130 | 131 | evalStateAt 132 | :: forall q sym s r a 133 | . IsSymbol sym 134 | => Row.Cons sym (State s) q r 135 | => Proxy sym 136 | -> s 137 | -> Run r a 138 | -> Run q a 139 | evalStateAt sym s = map snd <<< runStateAt sym s 140 | 141 | execState :: forall s r a. s -> Run (STATE s + r) a -> Run r s 142 | execState = execStateAt _state 143 | 144 | execStateAt 145 | :: forall q sym s r a 146 | . IsSymbol sym 147 | => Row.Cons sym (State s) q r 148 | => Proxy sym 149 | -> s 150 | -> Run r a 151 | -> Run q s 152 | execStateAt sym s = map fst <<< runStateAt sym s 153 | -------------------------------------------------------------------------------- /test/Bench.purs: -------------------------------------------------------------------------------- 1 | module Test.Bench where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Error.Class as EC 6 | import Control.Monad.Except (ExceptT, runExceptT) 7 | import Control.Monad.State (StateT, runStateT) 8 | import Control.Monad.State.Class as SC 9 | import Control.Monad.Trampoline (Trampoline, runTrampoline) 10 | import Control.Monad.Writer (WriterT, runWriterT) 11 | import Control.Monad.Writer.Class as WC 12 | import Data.Identity (Identity(..)) 13 | import Data.Newtype (un) 14 | import Effect (Effect) 15 | import Effect.Console (log) 16 | import Performance.Minibench (benchWith) 17 | import Run (Run, extract) 18 | import Run.Except (EXCEPT) 19 | import Run.Except as RE 20 | import Run.State (STATE) 21 | import Run.State as RS 22 | import Run.Writer (WRITER) 23 | import Run.Writer as RW 24 | import Type.Row (type (+)) 25 | 26 | type TestT = ExceptT String (WriterT String (StateT Int Trampoline)) 27 | 28 | type TestT' = ExceptT String (WriterT String (StateT Int Identity)) 29 | 30 | type TestR = Run (STATE Int + WRITER String + EXCEPT String + ()) 31 | 32 | test_mono :: TestT Int 33 | test_mono = do 34 | x <- SC.get 35 | if x <= 0 then pure 0 36 | else test_inner 37 | where 38 | test_inner = do 39 | SC.modify_ (_ - 2) 40 | EC.catchError test_error WC.tell 41 | test_mono 42 | 43 | test_error = do 44 | SC.modify_ (_ + 1) 45 | x <- SC.get 46 | EC.throwError (show x) 47 | 48 | test_mono' :: TestT' Int 49 | test_mono' = do 50 | x <- SC.get 51 | if x <= 0 then pure 0 52 | else test_inner 53 | where 54 | test_inner = do 55 | SC.modify_ (_ - 2) 56 | EC.catchError test_error WC.tell 57 | test_mono' 58 | 59 | test_error = do 60 | SC.modify_ (_ + 1) 61 | x <- SC.get 62 | EC.throwError (show x) 63 | 64 | test_mtl 65 | :: forall m 66 | . SC.MonadState Int m 67 | => WC.MonadWriter String m 68 | => EC.MonadError String m 69 | => m Int 70 | test_mtl = do 71 | x <- SC.get 72 | if x <= 0 then pure 0 73 | else test_inner 74 | where 75 | test_inner = do 76 | SC.modify_ (_ - 2) 77 | EC.catchError test_error WC.tell 78 | test_mtl 79 | 80 | test_error = do 81 | SC.modify_ (_ + 1) 82 | x <- SC.get 83 | EC.throwError (show x) 84 | 85 | test_run :: TestR Int 86 | test_run = do 87 | x <- RS.get 88 | if x <= 0 then pure 0 89 | else test_inner 90 | where 91 | test_inner = do 92 | RS.modify (_ - 2) 93 | test_error # RE.catch RW.tell 94 | test_run 95 | 96 | test_error = do 97 | RS.modify (_ + 1) 98 | x <- RS.get 99 | RE.throw (show x) 100 | 101 | main :: Effect Unit 102 | main = do 103 | log "Transformers (monomorphic/trampoline)" 104 | benchWith 100 \_ -> 105 | test_mono 106 | # runExceptT 107 | # runWriterT 108 | # flip runStateT 1000 109 | # runTrampoline 110 | 111 | gc 112 | log "Transformers (monomorphic/identity)" 113 | benchWith 100 \_ -> 114 | test_mono' 115 | # runExceptT 116 | # runWriterT 117 | # flip runStateT 1000 118 | # un Identity 119 | 120 | gc 121 | log "Transformers (mtl/trampoline)" 122 | benchWith 100 \_ -> 123 | test_mtl 124 | # runExceptT 125 | # runWriterT 126 | # flip runStateT 1000 127 | # runTrampoline 128 | 129 | gc 130 | log "Transformers (mtl/identity)" 131 | benchWith 100 \_ -> 132 | test_mtl 133 | # runExceptT 134 | # runWriterT 135 | # flip runStateT 1000 136 | # un Identity 137 | 138 | gc 139 | log "Run (free)" 140 | benchWith 100 \_ -> 141 | test_run 142 | # RE.runExcept 143 | # RW.runWriter 144 | # RS.runState 1000 145 | # extract 146 | 147 | foreign import gc :: Effect Unit 148 | -------------------------------------------------------------------------------- /test/Examples.purs: -------------------------------------------------------------------------------- 1 | module Test.Examples where 2 | 3 | import Prelude 4 | 5 | import Data.Tuple (Tuple(..)) 6 | import Effect (Effect) 7 | import Effect.Console as Console 8 | import Run (EFFECT, Run, Step(..), interpret, liftEffect, match, on, runAccumPure, runBaseEffect, runCont, send) 9 | import Run as Run 10 | import Type.Proxy (Proxy(..)) 11 | import Type.Row (type (+)) 12 | 13 | data TalkF a 14 | = Speak String a 15 | | Listen (String -> a) 16 | 17 | derive instance functorTalkF :: Functor TalkF 18 | 19 | type TALK r = (talk :: TalkF | r) 20 | 21 | _talk = Proxy :: Proxy "talk" 22 | 23 | speak :: forall r. String -> Run (TALK + r) Unit 24 | speak str = Run.lift _talk (Speak str unit) 25 | 26 | listen :: forall r. Run (TALK + r) String 27 | listen = Run.lift _talk (Listen identity) 28 | 29 | handleTalk :: forall r. TalkF ~> Run (EFFECT + r) 30 | handleTalk = case _ of 31 | Speak str next -> do 32 | liftEffect $ Console.log str 33 | pure next 34 | Listen reply -> do 35 | pure (reply "I am Groot") 36 | 37 | runTalk 38 | :: forall r 39 | . Run (EFFECT + TALK + r) 40 | ~> Run (EFFECT + r) 41 | runTalk = interpret (on _talk handleTalk send) 42 | 43 | --- 44 | 45 | type IsThereMore = Boolean 46 | type Bill = Int 47 | 48 | data Food = Pizza | Chizburger 49 | 50 | data DinnerF a 51 | = Eat Food (IsThereMore -> a) 52 | | CheckPlease (Bill -> a) 53 | 54 | derive instance functorDinnerF :: Functor DinnerF 55 | 56 | type DINNER r = (dinner :: DinnerF | r) 57 | 58 | _dinner = Proxy :: Proxy "dinner" 59 | 60 | eat :: forall r. Food -> Run (DINNER + r) IsThereMore 61 | eat food = Run.lift _dinner (Eat food identity) 62 | 63 | checkPlease :: forall r. Run (DINNER + r) Bill 64 | checkPlease = Run.lift _dinner (CheckPlease identity) 65 | 66 | type Tally = { stock :: Int, bill :: Bill } 67 | 68 | handleDinner :: forall a. Tally -> DinnerF a -> Tuple Tally a 69 | handleDinner tally = case _ of 70 | Eat _ reply 71 | | tally.stock > 0 -> 72 | let 73 | tally' = { stock: tally.stock - 1, bill: tally.bill + 1 } 74 | in 75 | Tuple tally' (reply true) 76 | | otherwise -> 77 | Tuple tally (reply false) 78 | CheckPlease reply -> 79 | Tuple tally (reply tally.bill) 80 | 81 | runDinnerPure :: forall r a. Tally -> Run (DINNER + r) a -> Run r (Tuple Bill a) 82 | runDinnerPure = runAccumPure 83 | (\tally -> on _dinner (Loop <<< handleDinner tally) Done) 84 | (\tally a -> Tuple tally.bill a) 85 | 86 | --- 87 | 88 | type LovelyEvening r = (TALK + DINNER + r) 89 | 90 | dinnerTime :: forall r. Run (LovelyEvening r) Unit 91 | dinnerTime = do 92 | speak "I'm famished!" 93 | isThereMore <- eat Pizza 94 | if isThereMore then dinnerTime 95 | else do 96 | bill <- checkPlease 97 | speak "Outrageous!" 98 | 99 | program2 :: forall r. Run (EFFECT + DINNER + r) Unit 100 | program2 = dinnerTime # runTalk 101 | 102 | program3 :: forall r. Run (EFFECT + r) (Tuple Bill Unit) 103 | program3 = program2 # runDinnerPure { stock: 10, bill: 0 } 104 | 105 | main :: Effect (Tuple Bill Unit) 106 | main = runBaseEffect program3 107 | 108 | --- 109 | 110 | foreign import setTimeout :: Int -> Effect Unit -> Effect Unit 111 | 112 | --- 113 | 114 | data LogF a = Log String a 115 | 116 | derive instance functorLogF :: Functor LogF 117 | 118 | type LOG r = (log :: LogF | r) 119 | 120 | _log = Proxy :: Proxy "log" 121 | 122 | log :: forall r. String -> Run (LOG + r) Unit 123 | log str = Run.lift _log (Log str unit) 124 | 125 | --- 126 | 127 | data SleepF a = Sleep Int a 128 | 129 | derive instance functorSleepF :: Functor SleepF 130 | 131 | type SLEEP r = (sleep :: SleepF | r) 132 | 133 | _sleep = Proxy :: Proxy "sleep" 134 | 135 | sleep :: forall r. Int -> Run (SLEEP + r) Unit 136 | sleep ms = Run.lift _sleep (Sleep ms unit) 137 | 138 | --- 139 | 140 | programSleep :: forall r. Run (SLEEP + LOG + r) Unit 141 | programSleep = do 142 | log "I guess I'll wait..." 143 | sleep 3000 144 | log "I can't wait any longer!" 145 | 146 | mainSleep :: Effect Unit 147 | mainSleep = programSleep # runCont go done 148 | where 149 | go = match 150 | { log: \(Log str cb) -> Console.log str *> cb 151 | , sleep: \(Sleep ms cb) -> setTimeout ms cb 152 | } 153 | 154 | done _ = do 155 | Console.log "Done!" 156 | -------------------------------------------------------------------------------- /src/Run/Except.purs: -------------------------------------------------------------------------------- 1 | module Run.Except 2 | ( Except(..) 3 | , EXCEPT 4 | , FAIL 5 | , _except 6 | , liftExcept 7 | , liftExceptAt 8 | , runExcept 9 | , runExceptAt 10 | , runFail 11 | , runFailAt 12 | , throw 13 | , throwAt 14 | , fail 15 | , failAt 16 | , rethrow 17 | , rethrowAt 18 | , note 19 | , noteAt 20 | , fromJust 21 | , fromJustAt 22 | , catch 23 | , catchAt 24 | ) where 25 | 26 | import Prelude 27 | 28 | import Data.Either (Either(..), either) 29 | import Data.Maybe (Maybe(..), maybe') 30 | import Data.Symbol (class IsSymbol) 31 | import Prim.Row as Row 32 | import Run (Run) 33 | import Run as Run 34 | import Type.Proxy (Proxy(..)) 35 | import Type.Row (type (+)) 36 | 37 | newtype Except :: forall k. Type -> k -> Type 38 | newtype Except e a = Except e 39 | 40 | derive instance functorExcept :: Functor (Except e) 41 | 42 | type EXCEPT :: forall k. Type -> Row (k -> Type) -> Row (k -> Type) 43 | type EXCEPT e r = (except :: Except e | r) 44 | 45 | type Fail :: forall k. k -> Type 46 | type Fail = Except Unit 47 | 48 | type FAIL :: forall k. Row (k -> Type) -> Row (k -> Type) 49 | type FAIL r = EXCEPT Unit r 50 | 51 | _except :: Proxy "except" 52 | _except = Proxy 53 | 54 | liftExcept :: forall e a r. Except e a -> Run (EXCEPT e + r) a 55 | liftExcept = liftExceptAt _except 56 | 57 | liftExceptAt 58 | :: forall t e a r s 59 | . IsSymbol s 60 | => Row.Cons s (Except e) t r 61 | => Proxy s 62 | -> Except e a 63 | -> Run r a 64 | liftExceptAt = Run.lift 65 | 66 | throw :: forall e a r. e -> Run (EXCEPT e + r) a 67 | throw = throwAt _except 68 | 69 | throwAt 70 | :: forall t e a r s 71 | . IsSymbol s 72 | => Row.Cons s (Except e) t r 73 | => Proxy s 74 | -> e 75 | -> Run r a 76 | throwAt sym = liftExceptAt sym <<< Except 77 | 78 | fail :: forall a r. Run (FAIL + r) a 79 | fail = failAt _except 80 | 81 | failAt 82 | :: forall t a r s 83 | . IsSymbol s 84 | => Row.Cons s Fail t r 85 | => Proxy s 86 | -> Run r a 87 | failAt sym = throwAt sym unit 88 | 89 | rethrow :: forall e a r. Either e a -> Run (EXCEPT e + r) a 90 | rethrow = rethrowAt _except 91 | 92 | rethrowAt 93 | :: forall t e a r s 94 | . IsSymbol s 95 | => Row.Cons s (Except e) t r 96 | => Proxy s 97 | -> Either e a 98 | -> Run r a 99 | rethrowAt sym = either (throwAt sym) pure 100 | 101 | note :: forall e a r. e -> Maybe a -> Run (EXCEPT e + r) a 102 | note = noteAt _except 103 | 104 | noteAt 105 | :: forall t e a r s 106 | . IsSymbol s 107 | => Row.Cons s (Except e) t r 108 | => Proxy s 109 | -> e 110 | -> Maybe a 111 | -> Run r a 112 | noteAt sym e = maybe' (\_ -> throwAt sym e) pure 113 | 114 | fromJust :: forall a r. Maybe a -> Run (FAIL + r) a 115 | fromJust = fromJustAt _except 116 | 117 | fromJustAt 118 | :: forall t a r s 119 | . IsSymbol s 120 | => Row.Cons s Fail t r 121 | => Proxy s 122 | -> Maybe a 123 | -> Run r a 124 | fromJustAt sym = noteAt sym unit 125 | 126 | catch :: forall e a r. (e -> Run r a) -> Run (EXCEPT e + r) a -> Run r a 127 | catch = catchAt _except 128 | 129 | catchAt 130 | :: forall t e a r s 131 | . IsSymbol s 132 | => Row.Cons s (Except e) t r 133 | => Proxy s 134 | -> (e -> Run t a) 135 | -> Run r a 136 | -> Run t a 137 | catchAt sym = loop 138 | where 139 | handle = Run.on sym Left Right 140 | loop k r = case Run.peel r of 141 | Left a -> case handle a of 142 | Left (Except e) -> 143 | k e 144 | Right a' -> 145 | Run.send a' >>= loop k 146 | Right a -> 147 | pure a 148 | 149 | runExcept :: forall e a r. Run (EXCEPT e + r) a -> Run r (Either e a) 150 | runExcept = runExceptAt _except 151 | 152 | runExceptAt 153 | :: forall t e a r s 154 | . IsSymbol s 155 | => Row.Cons s (Except e) t r 156 | => Proxy s 157 | -> Run r a 158 | -> Run t (Either e a) 159 | runExceptAt sym = loop 160 | where 161 | handle = Run.on sym Left Right 162 | loop r = case Run.peel r of 163 | Left a -> case handle a of 164 | Left (Except e) -> 165 | pure (Left e) 166 | Right a' -> 167 | Run.send a' >>= loop 168 | Right a -> 169 | pure (Right a) 170 | 171 | runFail :: forall a r. Run (FAIL + r) a -> Run r (Maybe a) 172 | runFail = runFailAt _except 173 | 174 | runFailAt 175 | :: forall t a r s 176 | . IsSymbol s 177 | => Row.Cons s Fail t r 178 | => Proxy s 179 | -> Run r a 180 | -> Run t (Maybe a) 181 | runFailAt sym = map (either (const Nothing) Just) <<< runExceptAt sym 182 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Rec.Class (tailRecM, Step(..)) 6 | import Data.Array as Array 7 | import Data.Foldable (for_, oneOfMap) 8 | import Data.Monoid.Additive (Additive(..)) 9 | import Effect (Effect) 10 | import Effect.Console (logShow, log) 11 | import Run (EFFECT, Run, lift, liftEffect, on, extract, runBaseEffect, run, send) 12 | import Run.Choose (CHOOSE, runChoose) 13 | import Run.Except (EXCEPT, _except, catch, runExcept, runExceptAt, throw, throwAt) 14 | import Run.Reader (READER, ask, runReader) 15 | import Run.State (STATE, _state, get, gets, modify, put, putAt, runState, runStateAt) 16 | import Run.Writer (WRITER, runWriter, tell) 17 | import Test.Examples as Examples 18 | import Type.Proxy (Proxy(..)) 19 | import Type.Row (type (+)) 20 | 21 | data Talk a 22 | = Speak String a 23 | | Listen (String -> a) 24 | 25 | derive instance functorTalk :: Functor Talk 26 | 27 | type TALK r = (talk :: Talk | r) 28 | 29 | _talk :: Proxy "talk" 30 | _talk = Proxy 31 | 32 | speak :: forall r. String -> Run (TALK + r) Unit 33 | speak a = lift _talk $ Speak a unit 34 | 35 | listen :: forall r. Run (TALK + r) String 36 | listen = lift _talk $ Listen identity 37 | 38 | --- 39 | 40 | program :: forall r. String -> Run (EXCEPT String + STATE String + r) Int 41 | program a = do 42 | put "Hello" 43 | if a == "12" then put "World" $> 12 44 | else throw "Not 12" 45 | 46 | program2 :: forall r. Run (STATE Int + EFFECT + r) Int 47 | program2 = do 48 | for_ (Array.range 1 100000) \n -> do 49 | modify (_ + 1) 50 | liftEffect $ log "Done" 51 | get 52 | 53 | program3 :: forall r. Run (TALK + r) Unit 54 | program3 = do 55 | speak "Hello, there." 56 | speak "What is your name?" 57 | name <- listen 58 | speak $ "Nice to meet you, " <> name <> "!" 59 | 60 | program4 :: forall r. String -> Run (EXCEPT String + STATE String + r) Int 61 | program4 a = do 62 | putAt _state "Hello" 63 | if a == "12" then putAt _state "World" $> 12 64 | else throwAt _except "Not 12" 65 | 66 | type MyEffects = 67 | ( STATE Int 68 | + EXCEPT String 69 | + EFFECT 70 | + () 71 | ) 72 | 73 | yesProgram :: Run MyEffects Unit 74 | yesProgram = do 75 | whenM (gets (_ < 0)) do 76 | throw "Number is less than 0" 77 | whileM_ (gets (_ > 0)) do 78 | liftEffect $ log "Yes" 79 | modify (_ - 1) 80 | where 81 | whileM_ 82 | :: forall a 83 | . Run MyEffects Boolean 84 | -> Run MyEffects a 85 | -> Run MyEffects Unit 86 | whileM_ mb ma = flip tailRecM unit \a -> 87 | mb >>= if _ then ma $> Loop unit else pure $ Done unit 88 | 89 | chooseProgram :: forall r. Run (CHOOSE + EFFECT + r) Int 90 | chooseProgram = do 91 | n <- oneOfMap pure [ 1, 2, 3, 4, 5 ] 92 | liftEffect $ log $ show n 93 | pure (n + 1) 94 | 95 | tcoLoop :: forall r. Int -> (Int -> Run r Unit) -> Run r Unit 96 | tcoLoop n k = go n 97 | where 98 | go n' 99 | | n' == 0 = pure unit 100 | | otherwise = do 101 | k n' 102 | go (n' - 1) 103 | 104 | stateTCO :: forall r. Run (STATE Int + r) Unit 105 | stateTCO = tcoLoop 100000 put 106 | 107 | writerTCO :: forall r. Run (WRITER (Additive Int) + r) Unit 108 | writerTCO = tcoLoop 100000 \_ -> tell (Additive 1) 109 | 110 | readerTCO :: forall r. Run (READER Unit + r) Unit 111 | readerTCO = tcoLoop 100000 (const ask) 112 | 113 | main :: Effect Unit 114 | main = do 115 | program "42" # runState "" # runExcept # extract # logShow 116 | program "42" # runExcept # runState "" # extract # logShow 117 | program "12" # runState "" # runExcept # extract # logShow 118 | 119 | res1 <- program2 # runState 0 # runBaseEffect 120 | logShow res1 121 | 122 | let 123 | runSpeak = send # on _talk case _ of 124 | Speak str a -> liftEffect (log str) $> a 125 | Listen reply -> pure $ reply "Gerald" 126 | 127 | program3 128 | # run runSpeak 129 | # runBaseEffect 130 | 131 | program4 "42" # runStateAt _state "" # runExceptAt _except # extract # logShow 132 | program4 "42" # runExceptAt _except # runStateAt _state "" # extract # logShow 133 | program4 "12" # runStateAt _state "" # runExceptAt _except # extract # logShow 134 | 135 | yesProgram 136 | # catch (liftEffect <<< log) 137 | # runState 10 138 | # runBaseEffect 139 | # void 140 | 141 | as <- chooseProgram 142 | # runChoose 143 | # runBaseEffect 144 | logShow (as :: Array Int) 145 | 146 | let 147 | tco1 = stateTCO # runState 0 148 | tco2 = writerTCO # runWriter 149 | tco3 = readerTCO # runReader unit 150 | 151 | Examples.main >>= logShow 152 | Examples.mainSleep 153 | -------------------------------------------------------------------------------- /src/Run.purs: -------------------------------------------------------------------------------- 1 | module Run 2 | ( Run(..) 3 | , lift 4 | , send 5 | , extract 6 | , interpret 7 | , interpretRec 8 | , run 9 | , runRec 10 | , runCont 11 | , runPure 12 | , runAccum 13 | , runAccumRec 14 | , runAccumCont 15 | , runAccumPure 16 | , peel 17 | , resume 18 | , expand 19 | , EFFECT 20 | , AFF 21 | , liftEffect 22 | , liftAff 23 | , runBaseEffect 24 | , runBaseAff 25 | , runBaseAff' 26 | , module Data.Functor.Variant 27 | , module Exports 28 | ) where 29 | 30 | import Prelude 31 | 32 | import Control.Alt (class Alt) 33 | import Control.Alternative (class Alternative) 34 | import Control.Monad.Free (Free, liftF, runFree, runFreeM, resume') 35 | import Control.Monad.Rec.Class (Step(..)) as Exports 36 | import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM) 37 | import Control.Plus (class Plus) 38 | import Data.Either (Either(..)) 39 | import Data.Functor.Variant (VariantF, case_, default, inj, match, on, onMatch) 40 | import Data.Newtype (class Newtype, unwrap) 41 | import Data.Symbol (class IsSymbol) 42 | import Data.Tuple (Tuple(..), curry, uncurry) 43 | import Effect (Effect) 44 | import Effect.Aff (Aff) 45 | import Effect.Aff.Class (class MonadAff) 46 | import Effect.Class (class MonadEffect) 47 | import Effect.Class as Effect 48 | import Partial.Unsafe (unsafeCrashWith) 49 | import Prim.Row as Row 50 | import Run.Internal (Choose(..), CHOOSE, _choose, fromRows, toRows) 51 | import Type.Equality (class TypeEquals) 52 | import Type.Proxy (Proxy(..)) 53 | import Type.Row (type (+)) 54 | import Unsafe.Coerce (unsafeCoerce) 55 | 56 | -- | An extensible effect Monad, indexed by a set of effect functors. Effects 57 | -- | are eliminated by interpretation into a pure value or into some base 58 | -- | effect Monad. 59 | -- | 60 | -- | An example using `State` and `Except`: 61 | -- | 62 | -- | ```purescript 63 | -- | type MyEffects = 64 | -- | ( STATE Int 65 | -- | + EXCEPT String 66 | -- | + EFFECT 67 | -- | + () 68 | -- | ) 69 | -- | 70 | -- | yesProgram :: Run MyEffects Unit 71 | -- | yesProgram = do 72 | -- | whenM (gets (_ < 0)) do 73 | -- | throw "Number is less than 0" 74 | -- | whileM_ (gets (_ > 0)) do 75 | -- | liftEffect $ log "Yes" 76 | -- | modify (_ - 1) 77 | -- | where 78 | -- | whileM_ 79 | -- | :: forall a 80 | -- | . Run MyEffects Boolean 81 | -- | -> Run MyEffects a 82 | -- | -> Run MyEffects Unit 83 | -- | whileM_ mb ma = flip tailRecM unit \a -> 84 | -- | mb >>= if _ then ma $> Loop unit else pure $ Done unit 85 | -- | 86 | -- | main = 87 | -- | yesProgram 88 | -- | # catch (liftEffect <<< log) 89 | -- | # runState 10 90 | -- | # runBaseEffect 91 | -- | # void 92 | -- | ```` 93 | newtype Run r a = Run (Free (VariantF r) a) 94 | 95 | derive instance newtypeRun :: Newtype (Run r a) _ 96 | derive newtype instance functorRun :: Functor (Run r) 97 | derive newtype instance applyRun :: Apply (Run r) 98 | derive newtype instance applicativeRun :: Applicative (Run r) 99 | derive newtype instance bindRun :: Bind (Run r) 100 | derive newtype instance monadRun :: Monad (Run r) 101 | 102 | -- | This instance is provided for compatibility, but is otherwise 103 | -- | unnecessary. You can use monadic recursion with `Run`, deferring the 104 | -- | `MonadRec` constraint till it is interpretted. 105 | instance monadRecRun :: MonadRec (Run r) where 106 | tailRecM f = loop 107 | where 108 | loop a = do 109 | b <- f a 110 | case b of 111 | Done r -> pure r 112 | Loop n -> loop n 113 | 114 | -- | Lifts an effect functor into the `Run` Monad according to the provided 115 | -- | `Proxy` slot. 116 | lift 117 | :: forall sym r1 r2 f a 118 | . Row.Cons sym f r1 r2 119 | => IsSymbol sym 120 | => Functor f 121 | => Proxy sym 122 | -> f a 123 | -> Run r2 a 124 | lift p = Run <<< liftF <<< inj p 125 | 126 | -- | Reflects the next instruction or the final value if there are no more 127 | -- | instructions. 128 | peel 129 | :: forall a r 130 | . Run r a 131 | -> Either (VariantF r (Run r a)) a 132 | peel = resume Left Right 133 | 134 | -- | Eliminator for the `Run` data type. 135 | resume 136 | :: forall a b r 137 | . (VariantF r (Run r a) -> b) 138 | -> (a -> b) 139 | -> Run r a 140 | -> b 141 | resume k1 k2 = resume' (\x f -> k1 (Run <<< f <$> x)) k2 <<< unwrap 142 | 143 | -- | Enqueues an instruction in the `Run` Monad. 144 | send 145 | :: forall a r 146 | . VariantF r a 147 | -> Run r a 148 | send = Run <<< liftF 149 | 150 | -- | Casts some set of effects to a wider set of effects via a left-biased 151 | -- | union. For example, you could take a closed effect and unify it with 152 | -- | a superset of effects because we know the additional effects never 153 | -- | occur. 154 | -- | 155 | -- | ```purescript 156 | -- | type LessRows = (foo :: Foo) 157 | -- | type MoreRows = (foo :: Foo, bar :: Bar, baz :: Baz) 158 | -- | 159 | -- | foo :: Run LessRows Unit 160 | -- | foo = foo 161 | -- | 162 | -- | foo' :: Run MoreRows Unit 163 | -- | foo' = expand foo 164 | -- | ``` 165 | expand 166 | :: forall r1 r2 rx a 167 | . Row.Union r1 rx r2 168 | => Run r1 a 169 | -> Run r2 a 170 | expand = unsafeCoerce 171 | 172 | -- | Extracts the value from a purely interpreted program. 173 | extract :: forall a. Run () a -> a 174 | extract = unwrap >>> runFree \_ -> unsafeCrashWith "Run: the impossible happened" 175 | 176 | -- | Extracts the value from a program via some Monad `m`. This assumes 177 | -- | stack safety under Monadic recursion. 178 | interpret 179 | :: forall m a r 180 | . Monad m 181 | => (VariantF r ~> m) 182 | -> Run r a 183 | -> m a 184 | interpret = run 185 | 186 | -- | Identical to `interpret` but with a less restrictive type signature, 187 | -- | letting you intercept the rest of the program. 188 | run 189 | :: forall m a r 190 | . Monad m 191 | => (VariantF r (Run r a) -> m (Run r a)) 192 | -> Run r a 193 | -> m a 194 | run k = loop 195 | where 196 | loop :: Run r a -> m a 197 | loop = resume (\a -> loop =<< k a) pure 198 | 199 | -- | Extracts the value from a program via some MonadRec `m`, preserving 200 | -- | stack safety. 201 | interpretRec 202 | :: forall m a r 203 | . MonadRec m 204 | => (VariantF r ~> m) 205 | -> Run r a 206 | -> m a 207 | interpretRec = runRec 208 | 209 | -- | Identical to `interpretRec` but with a less restrictive type 210 | -- | signature, letting you intercept the rest of the program. 211 | runRec 212 | :: forall m a r 213 | . MonadRec m 214 | => (VariantF r (Run r a) -> m (Run r a)) 215 | -> Run r a 216 | -> m a 217 | runRec k = runFreeM (coerceM k) <<< unwrap 218 | where 219 | -- Just so we can avoid the overhead of mapping the Run constructor 220 | coerceM :: (VariantF r (Run r a) -> m (Run r a)) -> VariantF r (Free (VariantF r) a) -> m (Free (VariantF r) a) 221 | coerceM = unsafeCoerce 222 | 223 | -- | Extracts the value from a program via some `m` using continuation passing. 224 | runCont 225 | :: forall m a b r 226 | . (VariantF r (m b) -> m b) 227 | -> (a -> m b) 228 | -> Run r a 229 | -> m b 230 | runCont k1 k2 = loop 231 | where 232 | loop :: Run r a -> m b 233 | loop = resume (\b -> k1 (loop <$> b)) k2 234 | 235 | -- | Extracts the value from a program via some Monad `m` with an internal 236 | -- | accumulator. This assumes stack safety under Monadic recursion. 237 | runAccum 238 | :: forall m r s a 239 | . Monad m 240 | => (s -> VariantF r (Run r a) -> m (Tuple s (Run r a))) 241 | -> s 242 | -> Run r a 243 | -> m a 244 | runAccum k = loop 245 | where 246 | loop :: s -> Run r a -> m a 247 | loop s = resume (\b -> uncurry loop =<< k s b) pure 248 | 249 | -- | Extracts the value from a program via some MonadRec `m` with an internal 250 | -- | accumulator. 251 | runAccumRec 252 | :: forall m r s a 253 | . MonadRec m 254 | => (s -> VariantF r (Run r a) -> m (Tuple s (Run r a))) 255 | -> s 256 | -> Run r a 257 | -> m a 258 | runAccumRec k = curry (tailRecM (uncurry loop)) 259 | where 260 | loop :: s -> Run r a -> m (Step (Tuple s (Run r a)) a) 261 | loop s = resume (\b -> Loop <$> k s b) (pure <<< Done) 262 | 263 | -- | Extracts the value from a program via some `m` using continuation passing 264 | -- | with an internal accumulator. 265 | runAccumCont 266 | :: forall m r s a b 267 | . (s -> VariantF r (s -> m b) -> m b) 268 | -> (s -> a -> m b) 269 | -> s 270 | -> Run r a 271 | -> m b 272 | runAccumCont k1 k2 = loop 273 | where 274 | loop :: s -> Run r a -> m b 275 | loop s = resume (\b -> k1 s (flip loop <$> b)) (k2 s) 276 | 277 | -- | Eliminates effects purely. Uses `Step` from `Control.Monad.Rec.Class` to 278 | -- | preserve stack safety under tail recursion. 279 | runPure 280 | :: forall r1 r2 a 281 | . (VariantF r1 (Run r1 a) -> Step (Run r1 a) (VariantF r2 (Run r1 a))) 282 | -> Run r1 a 283 | -> Run r2 a 284 | runPure k = loop 285 | where 286 | loop :: Run r1 a -> Run r2 a 287 | loop r = case peel r of 288 | Left a -> case k a of 289 | Loop r' -> loop r' 290 | Done a' -> send a' >>= runPure k 291 | Right a -> 292 | pure a 293 | 294 | -- | Eliminates effects purely with an internal accumulator. Uses `Step` from 295 | -- | `Control.Monad.Rec.Class` to preserve stack safety under tail recursion. 296 | runAccumPure 297 | :: forall r1 r2 a b s 298 | . (s -> VariantF r1 (Run r1 a) -> Step (Tuple s (Run r1 a)) (VariantF r2 (Run r1 a))) 299 | -> (s -> a -> b) 300 | -> s 301 | -> Run r1 a 302 | -> Run r2 b 303 | runAccumPure k1 k2 = loop 304 | where 305 | loop :: s -> Run r1 a -> Run r2 b 306 | loop s r = case peel r of 307 | Left a -> case k1 s a of 308 | Loop (Tuple s' r') -> loop s' r' 309 | Done a' -> send a' >>= runAccumPure k1 k2 s 310 | Right a -> 311 | pure (k2 s a) 312 | 313 | -- | Type synonym for using `Effect` as an effect. 314 | type EFFECT r = (effect :: Effect | r) 315 | 316 | -- Lift an `Effect` effect into the `Run` Monad via the `effect` label. 317 | liftEffect :: forall r. Effect ~> Run (EFFECT + r) 318 | liftEffect = lift (Proxy :: Proxy "effect") 319 | 320 | -- | Runs a base `Effect` effect. 321 | runBaseEffect :: Run (EFFECT + ()) ~> Effect 322 | runBaseEffect = runRec $ match { effect: \a -> a } 323 | 324 | -- | Type synonym for using `Aff` as an effect. 325 | type AFF r = (aff :: Aff | r) 326 | 327 | -- | Lift an `Aff` effect into the `Run` Monad via the `aff` label. 328 | liftAff :: forall r. Aff ~> Run (AFF + r) 329 | liftAff = lift (Proxy :: Proxy "aff") 330 | 331 | -- | Runs a base `Aff` effect. 332 | runBaseAff :: Run (AFF + ()) ~> Aff 333 | runBaseAff = run $ match { aff: \a -> a } 334 | 335 | -- | Runs base `Aff` and `Effect` together as one effect. 336 | runBaseAff' :: Run (AFF + EFFECT + ()) ~> Aff 337 | runBaseAff' = run $ match { aff: \a -> a, effect: \a -> Effect.liftEffect a } 338 | 339 | instance runMonadEffect :: (TypeEquals (Proxy r1) (Proxy (EFFECT r2))) => MonadEffect (Run r1) where 340 | liftEffect = fromRows <<< liftEffect 341 | 342 | -- | This will insert an `EFFECT` effect because `MonadAff` entails `MonadEffect`. 343 | -- | If you don't want this, use `Run.liftAff` rather than `Control.Monad.Aff.Class.liftAff`. 344 | instance runMonadAff :: (TypeEquals (Proxy r1) (Proxy (AFF + EFFECT + r2))) => MonadAff (Run r1) where 345 | liftAff = fromRows <<< liftAff 346 | 347 | liftChoose :: forall r a. Choose a -> Run (CHOOSE + r) a 348 | liftChoose = lift _choose 349 | 350 | instance runAlt :: (TypeEquals (Proxy r1) (Proxy (CHOOSE + r2))) => Alt (Run r1) where 351 | alt a b = fromRows $ liftChoose (Alt identity) >>= if _ then toRows a else toRows b 352 | 353 | instance runPlus :: (TypeEquals (Proxy r1) (Proxy (CHOOSE + r2))) => Plus (Run r1) where 354 | empty = fromRows $ liftChoose Empty 355 | 356 | instance runAlternative :: (TypeEquals (Proxy r1) (Proxy (CHOOSE + r2))) => Alternative (Run r1) 357 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # purescript-run 2 | 3 | [![Latest release](http://img.shields.io/github/release/natefaubion/purescript-run.svg)](https://github.com/natefaubion/purescript-run/releases) 4 | [![Build status](https://github.com/natefaubion/purescript-run/workflows/CI/badge.svg?branch=master)](https://github.com/natefaubion/purescript-run/actions?query=workflow%3ACI+branch%3Amaster) 5 | 6 | An [extensible-effects](https://hackage.haskell.org/package/extensible-effects) 7 | implementation for PureScript. 8 | 9 | ## Install 10 | 11 | ``` 12 | spago install run 13 | ``` 14 | 15 | ## Documentation 16 | 17 | - Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-run). 18 | 19 | `Run` is an implementation of extensible, algebraic effects for PureScript. 20 | This means we can write composable programs using normal PureScript data 21 | types, and then provide interpreters for those data types when we actually 22 | want to run them. Our effect descriptions naturally compose with others, 23 | so we don't need to write a large encompassing data type, or explicitly 24 | lift things through transformer stacks. 25 | 26 | You should familiarize yourself with [purescript-variant](http://pursuit.purescript.org/packages/purescript-variant) 27 | before using `Run`. 28 | 29 | ### Free DSLs 30 | 31 | The `Free` data type (found in `Control.Monad.Free`) gives us a means to take 32 | any `Functor`, and get a `Monad` instance out of it. This lets us turn fairly 33 | simple data types into a composable DSL. Here's an example that defines a DSL 34 | for string input and output: 35 | 36 | ```purescript 37 | data TalkF a 38 | = Speak String a 39 | | Listen (String -> a) 40 | 41 | derive instance functorTalkF :: Functor TalkF 42 | 43 | type Talk = Free TalkF 44 | 45 | -- Boilerplate definitions for lifting our constructors 46 | -- into the Free DSL. 47 | 48 | speak :: String -> Talk Unit 49 | speak str = liftF (Speak str unit) 50 | 51 | listen :: Talk String 52 | listen = liftF (Listen identity) 53 | 54 | -- Now we can write programs using our DSL. 55 | 56 | program :: Talk Unit 57 | program = do 58 | speak $ "Hello, what is your name?" 59 | name <- listen 60 | speak $ "Nice to meet you, " <> name 61 | 62 | ``` 63 | 64 | Note that this doesn't _do_ anything yet. All we've done is define a data 65 | type, and we can write a monadic program with it, but that program still only 66 | exists as simple data. In order for it to do something, we'd need to provide 67 | an interpreter which pattern matches on the data types: 68 | 69 | ```purescript 70 | main :: Effect Unit 71 | main = foldFree go program 72 | where 73 | go :: TalkF ~> Effect 74 | go = case _ of 75 | -- Just log any speak statement 76 | Speak str next -> do 77 | Console.log str 78 | pure next 79 | -- Reply to anything with "I am Groot", but maybe 80 | -- we could also get input from a terminal. 81 | Listen reply -> do 82 | pure (reply "I am Groot") 83 | ``` 84 | 85 | ``` 86 | Hello, what is your name? 87 | Nice to meet you, I am Groot 88 | ``` 89 | 90 | Now say that we've written another orthogonal DSL: 91 | 92 | ```purescript 93 | type IsThereMore = Boolean 94 | type Bill = Int 95 | 96 | data DinnerF a 97 | = Eat Food (IsThereMore -> a) 98 | | CheckPlease (Bill -> a) 99 | 100 | type Dinner = Free DinnerF 101 | 102 | -- Insert boilerplate here 103 | ``` 104 | 105 | If we could somehow combine these two data types, we could have a lovely 106 | evening indeed. One option is to just define a new DSL which has the 107 | capabilities of both: 108 | 109 | ```purescript 110 | data LovelyEveningF a 111 | = Dining (DinnerF a) 112 | | Talking (TalkF a) 113 | 114 | type LovelyEvening = Free LovelyEveningF 115 | ``` 116 | 117 | But now every time we want to use one DSL or another, we have to explicitly 118 | lift them into `LovelyEvening` using a natural transformation (`~>`). 119 | 120 | ```purescript 121 | liftDinner :: Dinner ~> LovelyEvening 122 | liftDinner = hoistFree Dining 123 | 124 | liftTalk :: Talk ~> LovelyEvening 125 | liftTalk = hoistFree Talking 126 | 127 | dinnerTime :: LovelyEvening Unit 128 | dinnerTime = do 129 | liftTalk $ speak "I'm famished!" 130 | isThereMore <- liftDinner $ eat Pizza 131 | if isThereMore 132 | then dinnerTime 133 | else do 134 | bill <- liftDinner checkPlease 135 | liftTalk $ speak "Outrageous!" 136 | ``` 137 | 138 | We can create these sorts of sums in a general way with `Coproduct` (`Either` 139 | for `Functor`s): 140 | 141 | ```purescript 142 | liftLeft :: forall f g. Free f ~> Free (Coproduct f g) 143 | liftLeft = hoistFree left 144 | 145 | liftRight :: forall f g. Free g ~> Free (Coproduct f g) 146 | liftRight = hoistFree right 147 | 148 | type LovelyEveningF = Coproduct TalkF DinnerF 149 | type LovelyEvening = Free LovelyEveningF 150 | 151 | dinnerTime :: LovelyEvening Unit 152 | dinnerTime = do 153 | liftLeft $ speak "I'm famished!" 154 | isThereMore <- liftRight $ eat Pizza 155 | if isThereMore 156 | then dinnerTime 157 | else do 158 | bill <- liftRight checkPlease 159 | liftLeft $ speak "Outrageous!" 160 | ``` 161 | 162 | This has saved us from having to define a new composite data type, but we 163 | still have to manually lift everywhere. And what about if we want to add 164 | _more_ things to it? We'd need to use more and more `Coproduct`s, which 165 | quickly gets very tedious. What if we could instead use an extensible sum 166 | type? 167 | 168 | `Variant` lets us encode polymorphic sum types using the row machinery in 169 | PureScript. If we look at its big brother `VariantF` (found in 170 | `Data.Functor.Variant`), we see that it gives us the same capability over 171 | `Functor`s and works like an extensible `Coproduct`. 172 | 173 | ```purescript 174 | type TALK r = (talk :: TalkF | r) 175 | 176 | _talk = Proxy :: Proxy "talk" 177 | 178 | speak :: forall r. String -> Free (VariantF (TALK + r)) Unit 179 | speak str = liftF (inj _talk (Speak str unit)) 180 | 181 | listen :: forall r. Free (VariantF (TALK + r)) String 182 | listen = liftF (inj _talk (Listen identity)) 183 | 184 | --- 185 | 186 | type DINNER r = (dinner :: DinnerF | r) 187 | 188 | _dinner = Proxy :: Proxy "dinner" 189 | 190 | eat :: forall r. Food -> Free (VariantF (DINNER + r)) IsThereMore 191 | eat food = liftF (inj _dinner (Eat food identity)) 192 | 193 | checkPlease :: forall r. Free (VariantF (DINNER + r)) Bill 194 | checkPlease = liftF (inj _dinner (CheckPlease identity)) 195 | ``` 196 | 197 | Now our DSLs can be used together without any extra lifting. 198 | 199 | ```purescript 200 | type LovelyEvening r = (DINNER + TALK + r) 201 | 202 | dinnerTime :: forall r. Free (VariantF (LovelyEvening + r)) Unit 203 | dinnerTime = do 204 | speak "I'm famished!" 205 | isThereMore <- eat Pizza 206 | if isThereMore 207 | then dinnerTime 208 | else do 209 | bill <- checkPlease 210 | speak "Outrageous!" 211 | ``` 212 | 213 | This pattern is exactly the `Run` data type: 214 | 215 | ```purescript 216 | newtype Run r a = Run (Free (VariantF r) a) 217 | ``` 218 | 219 | In fact, this library is just a combinator zoo for writing interpreters. 220 | 221 | ### Writing Interpreters 222 | 223 | Lets review our simple `TalkF` effect and example, now lifted into `Run` 224 | instead of `Free`: 225 | 226 | ```purescript 227 | data TalkF a 228 | = Speak String a 229 | | Listen (String -> a) 230 | 231 | type TALK r = (talk :: TalkF | r) 232 | 233 | _talk = Proxy :: Proxy "talk" 234 | 235 | speak :: forall r. String -> Run (TALK + r) Unit 236 | speak str = Run.lift _talk (Speak str unit) 237 | 238 | listen :: forall r. Run (TALK + r) String 239 | listen = Run.lift _talk (Listen identity) 240 | 241 | program :: forall r. Run (TALK + r) Unit 242 | program = do 243 | speak $ "Hello, what is your name?" 244 | name <- listen 245 | speak $ "Nice to meet you, " <> name 246 | ``` 247 | 248 | Our original `Free` based interpreter used `foldFree`, and we can do the same 249 | thing with `Run` using `interpret` or `interpretRec`. The only difference is 250 | that `interpretRec` uses a `MonadRec` constraint to ensure stack-safety. If 251 | your base `Monad` is stack-safe then you don't need it and should just use 252 | `interpret`. 253 | 254 | Since we need to handle a `VariantF`, we need to use the combinators from 255 | `purescript-variant`, which are re-exported by `purescript-run`. 256 | 257 | ```purescript 258 | handleTalk :: TalkF ~> Effect 259 | handleTalk = case _ of 260 | Speak str next -> do 261 | Console.log str 262 | pure next 263 | Listen reply -> do 264 | pure (reply "I am Groot") 265 | 266 | main = program # interpret (case_ # on _talk handleTalk) 267 | ``` 268 | 269 | Here we've used `case_`, which is the combinator for exhaustive pattern 270 | matching. If we use `case_`, that means we have to provide a handler for 271 | every effect. In this case we only have one effect, so it does the job. 272 | 273 | Note: An alternative to `on` chaining is to use `onMatch` (or `match` for 274 | exhaustive matching) which uses record sugar. This has really nice syntax, 275 | but inference around polymorphic members inside of the record can be finicky, 276 | so you might need more annotations (or eta expansion) than if you had used 277 | `on`. 278 | 279 | Let's try adding back in our other effect for a lovely evening: 280 | 281 | ```purescript 282 | type DINNER r = (dinner :: DinnerF | r) 283 | 284 | _dinner :: Proxy :: Proxy "dinner" 285 | 286 | eat :: forall r. Food -> Run (DINNER + r) IsThereMore 287 | eat food = Run.lift _dinner (Eat food identity) 288 | 289 | checkPlease :: forall r. Run (DINNER + r) Bill 290 | checkPlease = Run.lift _dinner (CheckPlease identity) 291 | 292 | type LovelyEvening r = (TALK + DINNER + r) 293 | 294 | dinnerTime :: forall r. Run (LovelyEvening + r) Unit 295 | dinnerTime = do 296 | speak "I'm famished!" 297 | isThereMore <- eat Pizza 298 | if isThereMore 299 | then dinnerTime 300 | else do 301 | bill <- checkPlease 302 | speak "Outrageous!" 303 | ``` 304 | 305 | We could interpret both of these effects together in one go by providing 306 | multiple handlers, but oftentimes we only want to handle them in isolation. 307 | That is, we want to interpret one effect in terms of other effects at our 308 | convenience. We can't use `case_` then, because `case_` must always handle 309 | all effects. Instead we can use `send` for unmatched cases. 310 | 311 | ```purescript 312 | -- This now interprets it back into `Run` but with the `EFFECT` effect. 313 | handleTalk :: forall r. TalkF ~> Run (EFFECT + r) 314 | handleTalk = case _ of 315 | Speak str next -> do 316 | -- `liftEffect` lifts native `Effect` effects into `Run`. 317 | liftEffect $ Console.log str 318 | pure next 319 | Listen reply -> do 320 | pure (reply "I am Groot") 321 | 322 | runTalk 323 | :: forall r 324 | . Run (EFFECT + TALK + r) 325 | ~> Run (EFFECT + r) 326 | runTalk = interpret (on _talk handleTalk send) 327 | 328 | program2 :: forall r. Run (EFFECT + DINNER + r) Unit 329 | program2 = dinnerTime # runTalk 330 | ``` 331 | 332 | We've interpreted the `TALK` effect in terms of the native `Effect` type, and so 333 | it's no longer part of our set of `Run` effects. Instead, it has been 334 | replaced by `EFFECT`. `DINNER` has yet to be interpreted, and we can choose to 335 | do that at a later time. 336 | 337 | In fact, let's go ahead and do that, but we will interpret it in a completely 338 | pure manner. We will need an internal accumulator for our interpreter, which 339 | we can do with `runAccumPure`. 340 | 341 | ```purescript 342 | type Tally = { stock :: Int, bill :: Bill } 343 | 344 | -- We have internal state, which is our running tally of the bill. 345 | handleDinner :: forall a. Tally -> DinnerF a -> Tuple Tally a 346 | handleDinner tally = case _ of 347 | Eat _ reply 348 | -- If we have food, bill the customer 349 | | tally.stock > 0 -> 350 | let tally' = { stock: tally.stock - 1, bill: tally.bill + 1 } 351 | in Tuple tally' (reply true) 352 | | otherwise -> 353 | Tuple tally (reply false) 354 | -- Reply with the bill 355 | CheckPlease reply -> 356 | Tuple tally (reply tally.bill) 357 | 358 | -- We eliminate the `DINNER` effect altogether, yielding the result 359 | -- together with the final bill. 360 | runDinnerPure :: forall r a. Tally -> Run (DINNER + r) a -> Run r (Tuple Bill a) 361 | runDinnerPure = runAccumPure 362 | (\tally -> on _dinner (Loop <<< handleDinner tally) Done) 363 | (\tally a -> Tuple tally.bill a) 364 | 365 | program3 :: forall r. Run (EFFECT + r) (Tuple Bill Unit) 366 | program3 = program2 # runDinnerPure { stock: 10, bill: 0 } 367 | ``` 368 | 369 | Since both `runPure` and `runAccumPure` fully interpret their result without 370 | running through some other `Monad` or `Run` effect, we need to preserve stack 371 | safety using the `Step` data type from `Control.Monad.Rec.Class`. This is why 372 | you see the `Loop` and `Done` constructors. `Loop` is used in the case of a 373 | match, and `Done` is used in the default case. 374 | 375 | Looking at the type of `program3`, all we have left are raw `Effect` effects. 376 | Since `Effect` and `Aff` are the most likely target for effectful programs, 377 | there are a few combinators for extracting them. 378 | 379 | ```purescript 380 | program4 :: Effect (Tuple Bill Unit) 381 | program4 = runBaseEffect program3 382 | ``` 383 | 384 | Additionally there are also combinators for writing interpreters via 385 | continuation passing (`runCont`, `runAccumCont`). This is useful if you want 386 | to just use `Effect` callbacks as your base instead of something like `Aff`. 387 | 388 | ```purescript 389 | data LogF a = Log String a 390 | 391 | derive instance functorLogF :: Functor LogF 392 | 393 | type LOG r = (log :: LogF | r) 394 | 395 | _log = Proxy :: Proxy "log" 396 | 397 | log :: forall r. String -> Run (LOG + r) Unit 398 | log str = Run.lift _log (Log str unit) 399 | 400 | --- 401 | 402 | data SleepF a = Sleep Int a 403 | 404 | derive instance functorSleepF :: Functor SleepF 405 | 406 | type SLEEP r = (sleep :: SleepF | r) 407 | 408 | _sleep = Proxy :: Proxy "sleep" 409 | 410 | sleep :: forall r. Int -> Run (SLEEP + r) Unit 411 | sleep ms = Run.lift _sleep (Sleep ms unit) 412 | 413 | --- 414 | 415 | program :: forall r. Run (SLEEP + LOG + r) Unit 416 | program = do 417 | log "I guess I'll wait..." 418 | sleep 3000 419 | log "I can't wait any longer!" 420 | 421 | program2 :: Effect Unit 422 | program2 = program # runCont go done 423 | where 424 | go = match 425 | { log: \(Log str cb) -> Console.log str *> cb 426 | , sleep: \(Sleep ms cb) -> void $ setTimeout ms cb 427 | } 428 | 429 | done _ = do 430 | Console.log "Done!" 431 | ``` 432 | 433 | In this case, the functor component of our effects now has the `Effect` 434 | continuation (or callback) embedded in it, and we just invoke it to run the 435 | rest of the program. 436 | 437 | ### Stack-safety 438 | 439 | Since the most common target for PureScript is JavaScript, stack-safety can 440 | be a concern. Generally, evaluating synchronous Monadic programs is not stack 441 | safe unless your particular `Monad` of choice is designed around it. You 442 | should use `interpretRec`, `runRec`, and `runAccumRec` if you want to 443 | _guarantee_ stack safety in all cases, but this does come with some overhead. 444 | 445 | Since `Run` itself is stack-safe, it's OK to use `interpret`, `run`, and 446 | `runAccum` when interpreting an effect in terms of other `Run` effects. `Aff` 447 | is also designed to be stack safe. `Effect`, however, is not stack safe, and you 448 | should use the `*Rec` variations. It's not possible to guarantee stack-safety 449 | when using the `*Cont` interpreters. 450 | --------------------------------------------------------------------------------