├── .github ├── PULL_REQUEST_TEMPLATE.md └── workflows │ └── ci.yml ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── bower.json ├── package.json ├── src └── Control │ └── Monad │ └── Rec │ └── Class.purs └── test └── Test └── Main.purs /.github/PULL_REQUEST_TEMPLATE.md: -------------------------------------------------------------------------------- 1 | **Description of the change** 2 | 3 | Clearly and concisely describe the purpose of the pull request. If this PR relates to an existing issue or change proposal, please link to it. Include any other background context that would help reviewers understand the motivation for this PR. 4 | 5 | --- 6 | 7 | **Checklist:** 8 | 9 | - [ ] Added the change to the changelog's "Unreleased" section with a reference to this PR (e.g. "- Made a change (#0000)") 10 | - [ ] Linked any existing issues or proposals that this pull request should close 11 | - [ ] Updated or added relevant documentation 12 | - [ ] Added a test for the contribution (if applicable) 13 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: 4 | push: 5 | branches: [master] 6 | pull_request: 7 | branches: [master] 8 | 9 | jobs: 10 | build: 11 | runs-on: ubuntu-latest 12 | steps: 13 | - uses: actions/checkout@v2 14 | 15 | - uses: purescript-contrib/setup-purescript@main 16 | with: 17 | purescript: "unstable" 18 | 19 | - uses: actions/setup-node@v2 20 | with: 21 | node-version: "14.x" 22 | 23 | - name: Install dependencies 24 | run: | 25 | npm install -g bower 26 | npm install 27 | bower install --production 28 | 29 | - name: Build source 30 | run: npm run-script build 31 | 32 | - name: Run tests 33 | run: | 34 | bower install 35 | npm run-script test --if-present 36 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /.* 2 | !/.gitignore 3 | !/.github/ 4 | /bower_components/ 5 | /node_modules/ 6 | /output/ 7 | package-lock.json 8 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | Notable changes to this project are documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). 4 | 5 | ## [Unreleased] 6 | 7 | Breaking changes: 8 | 9 | New features: 10 | 11 | Bugfixes: 12 | 13 | Other improvements: 14 | 15 | ## [v6.1.0](https://github.com/purescript/purescript-tailrec/releases/tag/v6.1.0) - 2022-05-16 16 | 17 | New features: 18 | - Added `tailRec2`, `tailRec3`, `loop2`, `loop3` convenience functions (#40 by @rhendric) 19 | 20 | ## [v6.0.0](https://github.com/purescript/purescript-tailrec/releases/tag/v6.0.0) - 2022-04-27 21 | 22 | Breaking changes: 23 | - Update project and deps to PureScript v0.15.0 (#38 by @JordanMartinez) 24 | 25 | New features: 26 | 27 | Bugfixes: 28 | 29 | Other improvements: 30 | 31 | ## [v5.0.1](https://github.com/purescript/purescript-tailrec/releases/tag/v5.0.1) - 2021-04-27 32 | 33 | Other improvements: 34 | - Fix warnings revealed by v0.14.1 PS release (#37 by @JordanMartinez) 35 | 36 | ## [v5.0.0](https://github.com/purescript/purescript-tailrec/releases/tag/v5.0.0) - 2021-02-26 37 | 38 | Breaking changes: 39 | - Added support for PureScript 0.14 and dropped support for all previous versions (#32) 40 | 41 | Other improvements: 42 | - Migrated CI to GitHub Actions and updated installation instructions to use Spago (#33) 43 | - Added a changelog and pull request template (#34, #35) 44 | 45 | ## [v4.1.1](https://github.com/purescript/purescript-tailrec/releases/tag/v4.1.1) - 2020-03-12 46 | 47 | - Fixed outdated type signatures in readme and doc-comments (@thautwarm, #29) 48 | - Fixed CI (@hdgarrood, #30) 49 | 50 | ## [v4.1.0](https://github.com/purescript/purescript-tailrec/releases/tag/v4.1.0) - 2019-08-27 51 | 52 | - Added `whileJust` and `untilJust` (@safareli) 53 | 54 | ## [v4.0.0](https://github.com/purescript/purescript-tailrec/releases/tag/v4.0.0) - 2018-05-23 55 | 56 | - Updated for PureScript 0.12 57 | 58 | ## [v3.3.0](https://github.com/purescript/purescript-tailrec/releases/tag/v3.3.0) - 2017-06-04 59 | 60 | - Added `MonadRec` for `Maybe` (@safareli) 61 | 62 | ## [v3.2.0](https://github.com/purescript/purescript-tailrec/releases/tag/v3.2.0) - 2017-05-27 63 | 64 | - Implemented `MonadRec` for `Function` (@safareli) 65 | 66 | ## [v3.1.0](https://github.com/purescript/purescript-tailrec/releases/tag/v3.1.0) - 2017-04-20 67 | 68 | - Removed a space leak in `tailRecEff` (@matthewleon) 69 | 70 | ## [v3.0.0](https://github.com/purescript/purescript-tailrec/releases/tag/v3.0.0) - 2017-03-26 71 | 72 | - Updated for PureScript 0.11 73 | 74 | ## [v2.0.2](https://github.com/purescript/purescript-tailrec/releases/tag/v2.0.2) - 2017-02-14 75 | 76 | - Avoid `Discard` constraints in upcoming 0.11 release 77 | 78 | ## [v2.0.1](https://github.com/purescript/purescript-tailrec/releases/tag/v2.0.1) - 2016-11-14 79 | 80 | - Fixed shadowed name warning 81 | 82 | ## [v2.0.0](https://github.com/purescript/purescript-tailrec/releases/tag/v2.0.0) - 2016-10-05 83 | 84 | - Updated dependencies (@nwolverson) 85 | - A `Step` type is now used rather than `Either` to manage the looping behaviour (originally by @jacereda) 86 | 87 | ## [v1.0.0](https://github.com/purescript/purescript-tailrec/releases/tag/v1.0.0) - 2016-06-01 88 | 89 | This release is intended for the PureScript 0.9.1 compiler and newer. 90 | 91 | **Note**: The v1.0.0 tag is not meant to indicate the library is “finished”, the core libraries are all being bumped to this for the 0.9 compiler release so as to use semver more correctly. 92 | 93 | - Added `MonadRec` instance for `Either` (@jdegoes) 94 | 95 | ## [v0.3.1](https://github.com/purescript/purescript-tailrec/releases/tag/v0.3.1) - 2015-08-13 96 | 97 | - Fixed warnings 98 | 99 | ## [v0.3.0](https://github.com/purescript/purescript-tailrec/releases/tag/v0.3.0) - 2015-06-30 100 | 101 | - Initial 0.7 compiler release. This release works with versions 0.7.\* of the PureScript compiler. It will not work with older versions. If you are using an older version, you should require an older, compatible version of this library. 102 | 103 | ## [v0.2.2](https://github.com/purescript/purescript-tailrec/releases/tag/v0.2.2) - 2015-03-20 104 | 105 | - Updated docs 106 | 107 | ## [v0.2.0](https://github.com/purescript/purescript-tailrec/releases/tag/v0.2.0) - 2015-03-03 108 | 109 | - Updated dependencies 110 | 111 | ## [v0.2.1](https://github.com/purescript/purescript-tailrec/releases/tag/v0.2.1) - 2015-03-03 112 | 113 | - Removed FFI dependency in `tailRecEff`. 114 | 115 | ## [v0.1.2](https://github.com/purescript/purescript-tailrec/releases/tag/v0.1.2) - 2015-02-26 116 | 117 | - Added `forever`. 118 | 119 | ## [v0.1.1](https://github.com/purescript/purescript-tailrec/releases/tag/v0.1.1) - 2015-02-15 120 | 121 | - Added `tailRecM2` and `tailRecM3`. 122 | 123 | ## [v0.1.0](https://github.com/purescript/purescript-tailrec/releases/tag/v0.1.0) - 2015-01-19 124 | 125 | - Initial release 126 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2018 PureScript 2 | 3 | Redistribution and use in source and binary forms, with or without modification, 4 | are permitted provided that the following conditions are met: 5 | 6 | 1. Redistributions of source code must retain the above copyright notice, this 7 | list of conditions and the following disclaimer. 8 | 9 | 2. Redistributions in binary form must reproduce the above copyright notice, 10 | this list of conditions and the following disclaimer in the documentation and/or 11 | other materials provided with the distribution. 12 | 13 | 3. Neither the name of the copyright holder nor the names of its contributors 14 | may be used to endorse or promote products derived from this software without 15 | specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 19 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 20 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR 21 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 22 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 23 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 24 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # purescript-tailrec 2 | 3 | [![Latest release](http://img.shields.io/github/release/purescript/purescript-tailrec.svg)](https://github.com/purescript/purescript-tailrec/releases) 4 | [![Build status](https://github.com/purescript/purescript-tailrec/workflows/CI/badge.svg?branch=master)](https://github.com/purescript/purescript-tailrec/actions?query=workflow%3ACI+branch%3Amaster) 5 | [![Pursuit](https://pursuit.purescript.org/packages/purescript-tailrec/badge)](https://pursuit.purescript.org/packages/purescript-tailrec) 6 | 7 | A type class which captures stack-safe monadic tail recursion. 8 | 9 | ## Installation 10 | 11 | ``` 12 | spago install tailrec 13 | ``` 14 | 15 | ## Usage 16 | 17 | The PureScript compiler performs tail-call elimination for self-recursive functions, so that a function like 18 | 19 | ```purescript 20 | pow :: Int -> Int -> Int 21 | pow n p = go { accum: 1, power: p } 22 | where 23 | go { accum: acc, power: 0 } = acc 24 | go { accum: acc, power: p } = go { accum: acc * n, power: p - 1 } 25 | ``` 26 | 27 | gets compiled into an efficient `while` loop. 28 | 29 | However, we do not get the same benefit when using monadic recursion: 30 | 31 | ```purescript 32 | powWriter :: Int -> Int -> Writer Product Unit 33 | powWriter n = go 34 | where 35 | go 0 = return unit 36 | go m = do 37 | tell n 38 | go (m - 1) 39 | ``` 40 | 41 | However, we can refactor the original function to isolate the recursive function call: 42 | 43 | ```purescript 44 | pow :: Int -> Int -> Int 45 | pow n p = tailRec go { accum: 1, power: p } 46 | where 47 | go :: _ -> Step _ Int 48 | go { accum: acc, power: 0 } = Done acc 49 | go { accum: acc, power: p } = Loop { accum: acc * n, power: p - 1 } 50 | ``` 51 | 52 | where the `tailRec` function is defined in the `Control.Monad.Rec.Class` module, with type: 53 | 54 | ```purescript 55 | tailRec :: forall a b. (a -> Step a b) -> a -> b 56 | ``` 57 | 58 | In the body of the loop, instead of calling the `go` function recursively, we return a value using the `Loop` constructor. To break from the loop, we use the `Done` constructor. 59 | 60 | This pattern can be generalized to several monad transformers from the `purescript-transformers` library using the following type class: 61 | 62 | ```purescript 63 | class Monad m <= MonadRec m where 64 | tailRecM :: forall a b. (a -> m (Step a b)) -> a -> m b 65 | ``` 66 | 67 | ## Documentation 68 | 69 | Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-tailrec). 70 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-tailrec", 3 | "homepage": "https://github.com/purescript/purescript-tailrec", 4 | "authors": [ 5 | "Phil Freeman " 6 | ], 7 | "license": "BSD-3-Clause", 8 | "repository": { 9 | "type": "git", 10 | "url": "https://github.com/purescript/purescript-tailrec.git" 11 | }, 12 | "ignore": [ 13 | "**/.*", 14 | "bower_components", 15 | "node_modules", 16 | "output", 17 | "test", 18 | "bower.json", 19 | "package.json" 20 | ], 21 | "dependencies": { 22 | "purescript-bifunctors": "^6.0.0", 23 | "purescript-effect": "^4.0.0", 24 | "purescript-either": "^6.0.0", 25 | "purescript-identity": "^6.0.0", 26 | "purescript-maybe": "^6.0.0", 27 | "purescript-partial": "^4.0.0", 28 | "purescript-prelude": "^6.0.0", 29 | "purescript-refs": "^6.0.0" 30 | }, 31 | "devDependencies": { 32 | "purescript-assert": "^6.0.0", 33 | "purescript-console": "^6.0.0" 34 | } 35 | } 36 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "private": true, 3 | "scripts": { 4 | "clean": "rimraf output && rimraf .pulp-cache", 5 | "build": "pulp build -- --censor-lib --strict", 6 | "test": "pulp test" 7 | }, 8 | "devDependencies": { 9 | "pulp": "16.0.0-0", 10 | "purescript-psa": "^0.8.2", 11 | "rimraf": "^3.0.2" 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /src/Control/Monad/Rec/Class.purs: -------------------------------------------------------------------------------- 1 | module Control.Monad.Rec.Class 2 | ( Step(..) 3 | , class MonadRec 4 | , tailRec 5 | , tailRec2 6 | , tailRec3 7 | , tailRecM 8 | , tailRecM2 9 | , tailRecM3 10 | , forever 11 | , whileJust 12 | , untilJust 13 | , loop2 14 | , loop3 15 | ) where 16 | 17 | import Prelude 18 | 19 | import Data.Bifunctor (class Bifunctor) 20 | import Data.Either (Either(..)) 21 | import Data.Identity (Identity(..)) 22 | import Data.Maybe (Maybe(..)) 23 | import Effect (Effect, untilE) 24 | import Effect.Ref as Ref 25 | import Partial.Unsafe (unsafePartial) 26 | 27 | -- | The result of a computation: either `Loop` containing the updated 28 | -- | accumulator, or `Done` containing the final result of the computation. 29 | data Step a b = Loop a | Done b 30 | 31 | derive instance functorStep :: Functor (Step a) 32 | 33 | instance bifunctorStep :: Bifunctor Step where 34 | bimap f _ (Loop a) = Loop (f a) 35 | bimap _ g (Done b) = Done (g b) 36 | 37 | -- | This type class captures those monads which support tail recursion in 38 | -- | constant stack space. 39 | -- | 40 | -- | The `tailRecM` function takes a step function, and applies that step 41 | -- | function recursively until a pure value of type `b` is found. 42 | -- | 43 | -- | Instances are provided for standard monad transformers. 44 | -- | 45 | -- | For example: 46 | -- | 47 | -- | ```purescript 48 | -- | loopWriter :: Int -> WriterT (Additive Int) Effect Unit 49 | -- | loopWriter n = tailRecM go n 50 | -- | where 51 | -- | go 0 = do 52 | -- | traceM "Done!" 53 | -- | pure (Done unit) 54 | -- | go i = do 55 | -- | tell $ Additive i 56 | -- | pure (Loop (i - 1)) 57 | -- | ``` 58 | class Monad m <= MonadRec m where 59 | tailRecM :: forall a b. (a -> m (Step a b)) -> a -> m b 60 | 61 | -- | Create a tail-recursive function of two arguments which uses constant stack space. 62 | -- | 63 | -- | The `loop2` helper function provides a curried alternative to the `Loop` 64 | -- | constructor for this function. 65 | tailRecM2 66 | :: forall m a b c 67 | . MonadRec m 68 | => (a -> b -> m (Step { a :: a, b :: b } c)) 69 | -> a 70 | -> b 71 | -> m c 72 | tailRecM2 f a b = tailRecM (\o -> f o.a o.b) { a, b } 73 | 74 | -- | Create a tail-recursive function of three arguments which uses constant stack space. 75 | -- | 76 | -- | The `loop3` helper function provides a curried alternative to the `Loop` 77 | -- | constructor for this function. 78 | tailRecM3 79 | :: forall m a b c d 80 | . MonadRec m 81 | => (a -> b -> c -> m (Step { a :: a, b :: b, c :: c } d)) 82 | -> a 83 | -> b 84 | -> c 85 | -> m d 86 | tailRecM3 f a b c = tailRecM (\o -> f o.a o.b o.c) { a, b, c } 87 | 88 | -- | Create a pure tail-recursive function of one argument 89 | -- | 90 | -- | For example: 91 | -- | 92 | -- | ```purescript 93 | -- | pow :: Int -> Int -> Int 94 | -- | pow n p = tailRec go { accum: 1, power: p } 95 | -- | where 96 | -- | go :: _ -> Step _ Int 97 | -- | go { accum: acc, power: 0 } = Done acc 98 | -- | go { accum: acc, power: p } = Loop { accum: acc * n, power: p - 1 } 99 | -- | ``` 100 | tailRec :: forall a b. (a -> Step a b) -> a -> b 101 | tailRec f = go <<< f 102 | where 103 | go (Loop a) = go (f a) 104 | go (Done b) = b 105 | 106 | -- | Create a pure tail-recursive function of two arguments 107 | -- | 108 | -- | The `loop2` helper function provides a curried alternative to the `Loop` 109 | -- | constructor for this function. 110 | tailRec2 :: forall a b c. (a -> b -> Step { a :: a, b :: b } c) -> a -> b -> c 111 | tailRec2 f a b = tailRec (\o -> f o.a o.b) { a, b } 112 | 113 | -- | Create a pure tail-recursive function of three arguments 114 | -- | 115 | -- | The `loop3` helper function provides a curried alternative to the `Loop` 116 | -- | constructor for this function. 117 | tailRec3 :: forall a b c d. (a -> b -> c -> Step { a :: a, b :: b, c :: c } d) -> a -> b -> c -> d 118 | tailRec3 f a b c = tailRec (\o -> f o.a o.b o.c) { a, b, c } 119 | 120 | instance monadRecIdentity :: MonadRec Identity where 121 | tailRecM f = Identity <<< tailRec (runIdentity <<< f) 122 | where runIdentity (Identity x) = x 123 | 124 | instance monadRecEffect :: MonadRec Effect where 125 | tailRecM f a = do 126 | r <- Ref.new =<< f a 127 | untilE do 128 | Ref.read r >>= case _ of 129 | Loop a' -> do 130 | e <- f a' 131 | _ <- Ref.write e r 132 | pure false 133 | Done _ -> pure true 134 | fromDone <$> Ref.read r 135 | where 136 | fromDone :: forall a b. Step a b -> b 137 | fromDone = unsafePartial \(Done b) -> b 138 | 139 | instance monadRecFunction :: MonadRec ((->) e) where 140 | tailRecM f a0 e = tailRec (\a -> f a e) a0 141 | 142 | instance monadRecEither :: MonadRec (Either e) where 143 | tailRecM f a0 = 144 | let 145 | g (Left e) = Done (Left e) 146 | g (Right (Loop a)) = Loop (f a) 147 | g (Right (Done b)) = Done (Right b) 148 | in tailRec g (f a0) 149 | 150 | instance monadRecMaybe :: MonadRec Maybe where 151 | tailRecM f a0 = 152 | let 153 | g Nothing = Done Nothing 154 | g (Just (Loop a)) = Loop (f a) 155 | g (Just (Done b)) = Done (Just b) 156 | in tailRec g (f a0) 157 | 158 | -- | `forever` runs an action indefinitely, using the `MonadRec` instance to 159 | -- | ensure constant stack usage. 160 | -- | 161 | -- | For example: 162 | -- | 163 | -- | ```purescript 164 | -- | main = forever $ trace "Hello, World!" 165 | -- | ``` 166 | forever :: forall m a b. MonadRec m => m a -> m b 167 | forever ma = tailRecM (\u -> Loop u <$ ma) unit 168 | 169 | -- | While supplied computation evaluates to `Just _`, it will be 170 | -- | executed repeatedly and results will be combined using monoid instance. 171 | whileJust :: forall a m. Monoid a => MonadRec m => m (Maybe a) -> m a 172 | whileJust m = mempty # tailRecM \v -> m <#> case _ of 173 | Nothing -> Done v 174 | Just x -> Loop $ v <> x 175 | 176 | -- | Supplied computation will be executed repeatedly until it evaluates 177 | -- | to `Just value` and then that `value` will be returned. 178 | untilJust :: forall a m. MonadRec m => m (Maybe a) -> m a 179 | untilJust m = unit # tailRecM \_ -> m <#> case _ of 180 | Nothing -> Loop unit 181 | Just x -> Done x 182 | 183 | -- | A curried version of the `Loop` constructor, provided as a convenience for 184 | -- | use with `tailRec2` and `tailRecM2`. 185 | loop2 :: forall a b c. a -> b -> Step { a :: a, b :: b } c 186 | loop2 a b = Loop { a, b } 187 | 188 | -- | A curried version of the `Loop` constructor, provided as a convenience for 189 | -- | use with `tailRec3` and `tailRecM3`. 190 | loop3 :: forall a b c d. a -> b -> c -> Step { a :: a, b :: b, c :: c } d 191 | loop3 a b c = Loop { a, b, c } 192 | -------------------------------------------------------------------------------- /test/Test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Rec.Class (Step(..), tailRec, tailRec2, tailRecM, tailRecM2, untilJust, whileJust, loop2) 6 | import Data.Either (Either(..)) 7 | import Data.Maybe (Maybe(..)) 8 | import Effect (Effect) 9 | import Effect.Console (log) 10 | import Effect.Ref as Ref 11 | import Test.Assert (assertEqual') 12 | 13 | -- | Compute the nth triangle number 14 | triangle :: Int -> Effect Int 15 | triangle = tailRecM2 f 0 16 | where 17 | f acc 0 = pure (Done acc) 18 | f acc n = do 19 | log $ "Accumulator: " <> show acc 20 | pure (Loop { a: acc + n, b: n - 1 }) 21 | 22 | trianglePure :: Int -> Int 23 | trianglePure = tailRec2 f 0 24 | where 25 | f acc 0 = Done acc 26 | f acc n = loop2 (acc + n) (n - 1) 27 | 28 | loop :: Int -> Effect Unit 29 | loop n = tailRecM go n 30 | where 31 | go 0 = do 32 | log "Done!" 33 | pure (Done unit) 34 | go n' = pure (Loop (n' - 1)) 35 | 36 | loopFunction :: Int -> ({result :: Int, step :: Int} -> Int) 37 | loopFunction = tailRecM go 38 | where 39 | go 0 = Done <$> \e -> e.result 40 | go n = Loop <$> \e -> n - e.step 41 | 42 | mutual :: Int -> Boolean 43 | mutual = tailRec go <<< Left 44 | where 45 | go (Left n) = even n 46 | go (Right n) = odd n 47 | 48 | even 0 = Done true 49 | even n = Loop (Right (n - 1)) 50 | 51 | odd 0 = Done false 52 | odd n = Loop (Left (n - 1)) 53 | 54 | main :: Effect Unit 55 | main = do 56 | test "triangle" 55 do 57 | triangle 10 58 | 59 | test "trianglePure" 55 do 60 | pure $ trianglePure 10 61 | 62 | test "mutual" false do 63 | pure $ mutual 1000001 64 | 65 | test "loop" unit do 66 | loop 1000000 67 | 68 | test "loopFunction" 100 do 69 | pure $ loopFunction 10000000 ({result:100, step:1}) 70 | 71 | test "whileJust" {acc: [1,2,3,4,5,6,7,8,9], res: 10} do 72 | ref <- Ref.new 0 73 | acc <- whileJust do 74 | st <- Ref.modify (_ + 1) ref 75 | pure $ if st < 10 then Just [st] else Nothing 76 | res <- Ref.read ref 77 | pure {res, acc} 78 | 79 | test "untilJust" 128 do 80 | ref <- Ref.new 1 81 | untilJust do 82 | st <- Ref.modify (_ * 2) ref 83 | pure $ if st > 89 then Just st else Nothing 84 | 85 | where 86 | test :: forall a. Show a => Eq a => String -> a -> Effect a -> Effect Unit 87 | test name expected compute = do 88 | log $ "START: " <> name 89 | actual <- compute 90 | assertEqual' "loopRes" {actual, expected} 91 | --------------------------------------------------------------------------------