├── .eslintrc.json ├── .github ├── PULL_REQUEST_TEMPLATE.md └── workflows │ └── ci.yml ├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── bower.json ├── package.json ├── src └── Control │ └── Monad │ ├── ST.purs │ └── ST │ ├── Class.purs │ ├── Global.purs │ ├── Internal.js │ ├── Internal.purs │ ├── Ref.purs │ ├── Uncurried.js │ └── Uncurried.purs └── test └── Main.purs /.eslintrc.json: -------------------------------------------------------------------------------- 1 | { 2 | "parserOptions": { 3 | "ecmaVersion": 6, 4 | "sourceType": "module" 5 | }, 6 | "extends": "eslint:recommended", 7 | "rules": { 8 | "strict": [2, "global"], 9 | "block-scoped-var": 2, 10 | "consistent-return": 2, 11 | "eqeqeq": [2, "smart"], 12 | "guard-for-in": 2, 13 | "no-caller": 2, 14 | "no-extend-native": 2, 15 | "no-loop-func": 2, 16 | "no-new": 2, 17 | "no-param-reassign": 2, 18 | "no-return-assign": 2, 19 | "no-unused-expressions": 2, 20 | "no-use-before-define": 2, 21 | "radix": [2, "always"], 22 | "indent": [2, 2], 23 | "quotes": [2, "double"], 24 | "semi": [2, "always"] 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /.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 | !/.eslintrc.json 4 | !/.github/ 5 | /bower_components/ 6 | /node_modules/ 7 | /output/ 8 | package-lock.json 9 | -------------------------------------------------------------------------------- /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.2.0](https://github.com/purescript/purescript-st/releases/tag/v6.2.0) - 2022-09-30 16 | 17 | New features: 18 | - Add Semigroup and Monoid instances (#51 by @PureFunctor) 19 | 20 | ## [v6.1.0](https://github.com/purescript/purescript-st/releases/tag/v6.1.0) - 2022-09-26 21 | 22 | New features: 23 | - Adds uncurried ST functions with similar signatures and purposes as effect uncurried functions (#52 by @mikesol) 24 | 25 | ## [v6.0.0](https://github.com/purescript/purescript-st/releases/tag/v6.0.0) - 2022-04-27 26 | 27 | Breaking changes: 28 | - Migrate FFI to ES modules (#47 by @kl0tl and @JordanMartinez) 29 | 30 | New features: 31 | 32 | Bugfixes: 33 | 34 | Other improvements: 35 | 36 | ## [v5.0.1](https://github.com/purescript/purescript-st/releases/tag/v5.0.1) - 2021-04-27 37 | 38 | Other improvements: 39 | - Fix warnings revealed by v0.14.1 PS release (#43 by @JordanMartinez) 40 | 41 | ## [v5.0.0](https://github.com/purescript/purescript-st/releases/tag/v5.0.0) - 2021-02-26 42 | 43 | Breaking changes: 44 | - Added support for PureScript 0.14 and dropped support for all previous versions (#37) 45 | 46 | New features: 47 | - Add roles declarations to allow safe coercions (#37) 48 | 49 | Bugfixes: 50 | 51 | Other improvements: 52 | - Removed primes from foreign module exports (#29) 53 | - Migrated CI to GitHub Actions and updated installation instructions to use Spago (#38) 54 | - Added a changelog and pull request template (#40, #41) 55 | 56 | ## [v4.1.1](https://github.com/purescript/purescript-st/releases/tag/v4.1.1) - 2020-03-04 57 | 58 | - Re-release with `v` tag prefix for package-sets 59 | 60 | ## [4.1.0](https://github.com/purescript/purescript-st/releases/tag/4.1.0) - 2020-02-23 61 | 62 | - Added `Global` region that allows `ST` computations to run in a global context or be converted to `Effect` 63 | - Added `MonadST` class 64 | 65 | ## [v4.0.1](https://github.com/purescript/purescript-st/releases/tag/v4.0.1) - 2019-11-02 66 | 67 | - Fix a typo in the documentation for `ST.run` (@jy14898) 68 | - Fix some unused import warnings (@Ebmtranceboy) 69 | 70 | ## [v4.0.0](https://github.com/purescript/purescript-st/releases/tag/v4.0.0) - 2018-05-23 71 | 72 | - Updated for PureScript 0.12 73 | - `ST` is now a type of its own rather than integrating with effects 74 | - The names in `STRef` have been shortened for less repetition with qualified imports 75 | - The argument order of functions has changed so the `STRef` is always in the last position 76 | 77 | ## [v3.0.0](https://github.com/purescript/purescript-st/releases/tag/v3.0.0) - 2017-03-26 78 | 79 | - Updated for PureScript 0.11 80 | 81 | ## [v2.0.0](https://github.com/purescript/purescript-st/releases/tag/v2.0.0) - 2016-10-02 82 | 83 | - Updated dependencies 84 | 85 | ## [v1.0.0](https://github.com/purescript/purescript-st/releases/tag/v1.0.0) - 2016-06-01 86 | 87 | This release is intended for the PureScript 0.9.1 compiler and newer. 88 | 89 | **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. 90 | 91 | ## [v0.1.1](https://github.com/purescript/purescript-st/releases/tag/v0.1.1) - 2015-09-12 92 | 93 | - Simplify the type of `pureST`. 94 | 95 | ## [v0.1.0](https://github.com/purescript/purescript-st/releases/tag/v0.1.0) - 2015-06-30 96 | 97 | Initial 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. 98 | -------------------------------------------------------------------------------- /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-st 2 | 3 | [![Latest release](http://img.shields.io/github/release/purescript/purescript-st.svg)](https://github.com/purescript/purescript-st/releases) 4 | [![Build status](https://github.com/purescript/purescript-st/workflows/CI/badge.svg?branch=master)](https://github.com/purescript/purescript-st/actions?query=workflow%3ACI+branch%3Amaster) 5 | [![Pursuit](https://pursuit.purescript.org/packages/purescript-st/badge)](https://pursuit.purescript.org/packages/purescript-st) 6 | 7 | The ST effect, for safe local mutation. 8 | 9 | ## Installation 10 | 11 | ``` 12 | spago install st 13 | ``` 14 | 15 | ## Documentation 16 | 17 | Module documentation is [published on Pursuit](http://pursuit.purescript.org/packages/purescript-st). 18 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-st", 3 | "homepage": "https://github.com/purescript/purescript-st", 4 | "description": "The ST effect, for safe local mutation", 5 | "license": "BSD-3-Clause", 6 | "repository": { 7 | "type": "git", 8 | "url": "https://github.com/purescript/purescript-st.git" 9 | }, 10 | "ignore": [ 11 | "**/.*", 12 | "bower_components", 13 | "node_modules", 14 | "output", 15 | "test", 16 | "bower.json", 17 | "package.json" 18 | ], 19 | "dependencies": { 20 | "purescript-partial": "^4.0.0", 21 | "purescript-prelude": "^6.0.0", 22 | "purescript-tailrec": "^6.0.0", 23 | "purescript-unsafe-coerce": "^6.0.0" 24 | }, 25 | "devDependencies": { 26 | "purescript-console": "^6.0.0" 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "private": true, 3 | "scripts": { 4 | "clean": "rimraf output && rimraf .pulp-cache", 5 | "build": "eslint src && pulp build -- --censor-lib --strict", 6 | "test": "pulp test" 7 | }, 8 | "devDependencies": { 9 | "eslint": "^7.15.0", 10 | "pulp": "16.0.0-0", 11 | "purescript-psa": "^0.8.2", 12 | "rimraf": "^3.0.2" 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /src/Control/Monad/ST.purs: -------------------------------------------------------------------------------- 1 | module Control.Monad.ST (module Internal) where 2 | 3 | import Control.Monad.ST.Internal (ST, Region, run, while, for, foreach) as Internal 4 | -------------------------------------------------------------------------------- /src/Control/Monad/ST/Class.purs: -------------------------------------------------------------------------------- 1 | module Control.Monad.ST.Class where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.ST (ST) 6 | import Control.Monad.ST.Global (Global) 7 | import Control.Monad.ST.Global as Global 8 | import Effect (Effect) 9 | 10 | class Monad m <= MonadST s m | m -> s where 11 | liftST :: ST s ~> m 12 | 13 | instance monadSTEffect :: MonadST Global Effect where 14 | liftST = Global.toEffect 15 | 16 | instance monadSTST :: MonadST s (ST s) where 17 | liftST = identity 18 | -------------------------------------------------------------------------------- /src/Control/Monad/ST/Global.purs: -------------------------------------------------------------------------------- 1 | module Control.Monad.ST.Global 2 | ( Global 3 | , toEffect 4 | ) where 5 | 6 | import Prelude 7 | 8 | import Control.Monad.ST (ST, Region) 9 | import Effect (Effect) 10 | import Unsafe.Coerce (unsafeCoerce) 11 | 12 | -- | This region allows `ST` computations to be converted into `Effect` 13 | -- | computations so they can be run in a global context. 14 | foreign import data Global :: Region 15 | 16 | -- | Converts an `ST` computation into an `Effect` computation. 17 | toEffect :: ST Global ~> Effect 18 | toEffect = unsafeCoerce 19 | -------------------------------------------------------------------------------- /src/Control/Monad/ST/Internal.js: -------------------------------------------------------------------------------- 1 | export const map_ = function (f) { 2 | return function (a) { 3 | return function () { 4 | return f(a()); 5 | }; 6 | }; 7 | }; 8 | 9 | export const pure_ = function (a) { 10 | return function () { 11 | return a; 12 | }; 13 | }; 14 | 15 | export const bind_ = function (a) { 16 | return function (f) { 17 | return function () { 18 | return f(a())(); 19 | }; 20 | }; 21 | }; 22 | 23 | export const run = function (f) { 24 | return f(); 25 | }; 26 | 27 | function whileST(f) { 28 | return function (a) { 29 | return function () { 30 | while (f()) { 31 | a(); 32 | } 33 | }; 34 | }; 35 | } 36 | export { whileST as while }; 37 | 38 | function forST(lo) { 39 | return function (hi) { 40 | return function (f) { 41 | return function () { 42 | for (var i = lo; i < hi; i++) { 43 | f(i)(); 44 | } 45 | }; 46 | }; 47 | }; 48 | } 49 | export { forST as for }; 50 | 51 | export const foreach = function (as) { 52 | return function (f) { 53 | return function () { 54 | for (var i = 0, l = as.length; i < l; i++) { 55 | f(as[i])(); 56 | } 57 | }; 58 | }; 59 | }; 60 | 61 | function newSTRef(val) { 62 | return function () { 63 | return { value: val }; 64 | }; 65 | } 66 | export { newSTRef as new }; 67 | 68 | export const read = function (ref) { 69 | return function () { 70 | return ref.value; 71 | }; 72 | }; 73 | 74 | export const modifyImpl = function (f) { 75 | return function (ref) { 76 | return function () { 77 | var t = f(ref.value); 78 | ref.value = t.state; 79 | return t.value; 80 | }; 81 | }; 82 | }; 83 | 84 | export const write = function (a) { 85 | return function (ref) { 86 | return function () { 87 | return ref.value = a; // eslint-disable-line no-return-assign 88 | }; 89 | }; 90 | }; 91 | -------------------------------------------------------------------------------- /src/Control/Monad/ST/Internal.purs: -------------------------------------------------------------------------------- 1 | module Control.Monad.ST.Internal 2 | ( Region 3 | , ST 4 | , run 5 | , while 6 | , for 7 | , foreach 8 | , STRef 9 | , new 10 | , read 11 | , modify' 12 | , modify 13 | , write 14 | ) where 15 | 16 | import Prelude 17 | 18 | import Control.Apply (lift2) 19 | import Control.Monad.Rec.Class (class MonadRec, Step(..)) 20 | import Partial.Unsafe (unsafePartial) 21 | 22 | -- | `ST` is concerned with _restricted_ mutation. Mutation is restricted to a 23 | -- | _region_ of mutable references. This kind is inhabited by phantom types 24 | -- | which represent regions in the type system. 25 | foreign import data Region :: Type 26 | 27 | -- | The `ST` type constructor allows _local mutation_, i.e. mutation which 28 | -- | does not "escape" into the surrounding computation. 29 | -- | 30 | -- | An `ST` computation is parameterized by a phantom type which is used to 31 | -- | restrict the set of reference cells it is allowed to access. 32 | -- | 33 | -- | The `run` function can be used to run a computation in the `ST` monad. 34 | foreign import data ST :: Region -> Type -> Type 35 | 36 | type role ST nominal representational 37 | 38 | foreign import map_ :: forall r a b. (a -> b) -> ST r a -> ST r b 39 | 40 | foreign import pure_ :: forall r a. a -> ST r a 41 | 42 | foreign import bind_ :: forall r a b. ST r a -> (a -> ST r b) -> ST r b 43 | 44 | instance functorST :: Functor (ST r) where 45 | map = map_ 46 | 47 | instance applyST :: Apply (ST r) where 48 | apply = ap 49 | 50 | instance applicativeST :: Applicative (ST r) where 51 | pure = pure_ 52 | 53 | instance bindST :: Bind (ST r) where 54 | bind = bind_ 55 | 56 | instance monadST :: Monad (ST r) 57 | 58 | instance monadRecST :: MonadRec (ST r) where 59 | tailRecM f a = do 60 | r <- new =<< f a 61 | while (isLooping <$> read r) do 62 | read r >>= case _ of 63 | Loop a' -> do 64 | e <- f a' 65 | void (write e r) 66 | Done _ -> pure unit 67 | fromDone <$> read r 68 | where 69 | fromDone :: forall a b. Step a b -> b 70 | fromDone = unsafePartial \(Done b) -> b 71 | 72 | isLooping = case _ of 73 | Loop _ -> true 74 | _ -> false 75 | 76 | instance semigroupST :: Semigroup a => Semigroup (ST r a) where 77 | append = lift2 append 78 | 79 | instance monoidST :: Monoid a => Monoid (ST r a) where 80 | mempty = pure mempty 81 | 82 | -- | Run an `ST` computation. 83 | -- | 84 | -- | Note: the type of `run` uses a rank-2 type to constrain the phantom 85 | -- | type `r`, such that the computation must not leak any mutable references 86 | -- | to the surrounding computation. It may cause problems to apply this 87 | -- | function using the `$` operator. The recommended approach is to use 88 | -- | parentheses instead. 89 | foreign import run :: forall a. (forall r. ST r a) -> a 90 | 91 | -- | Loop while a condition is `true`. 92 | -- | 93 | -- | `while b m` is ST computation which runs the ST computation `b`. If its 94 | -- | result is `true`, it runs the ST computation `m` and loops. If not, the 95 | -- | computation ends. 96 | foreign import while :: forall r a. ST r Boolean -> ST r a -> ST r Unit 97 | 98 | -- | Loop over a consecutive collection of numbers 99 | -- | 100 | -- | `ST.for lo hi f` runs the computation returned by the function `f` for each 101 | -- | of the inputs between `lo` (inclusive) and `hi` (exclusive). 102 | foreign import for :: forall r a. Int -> Int -> (Int -> ST r a) -> ST r Unit 103 | 104 | -- | Loop over an array of values. 105 | -- | 106 | -- | `ST.foreach xs f` runs the computation returned by the function `f` for each 107 | -- | of the inputs `xs`. 108 | foreign import foreach :: forall r a. Array a -> (a -> ST r Unit) -> ST r Unit 109 | 110 | -- | The type `STRef r a` represents a mutable reference holding a value of 111 | -- | type `a`, which can be used with the `ST r` effect. 112 | foreign import data STRef :: Region -> Type -> Type 113 | 114 | type role STRef nominal representational 115 | 116 | -- | Create a new mutable reference. 117 | foreign import new :: forall a r. a -> ST r (STRef r a) 118 | 119 | -- | Read the current value of a mutable reference. 120 | foreign import read :: forall a r. STRef r a -> ST r a 121 | 122 | -- | Update the value of a mutable reference by applying a function 123 | -- | to the current value, computing a new state value for the reference and 124 | -- | a return value. 125 | modify' :: forall r a b. (a -> { state :: a, value :: b }) -> STRef r a -> ST r b 126 | modify' = modifyImpl 127 | 128 | foreign import modifyImpl :: forall r a b. (a -> { state :: a, value :: b }) -> STRef r a -> ST r b 129 | 130 | -- | Modify the value of a mutable reference by applying a function to the 131 | -- | current value. The modified value is returned. 132 | modify :: forall r a. (a -> a) -> STRef r a -> ST r a 133 | modify f = modify' \s -> let s' = f s in { state: s', value: s' } 134 | 135 | -- | Set the value of a mutable reference. 136 | foreign import write :: forall a r. a -> STRef r a -> ST r a 137 | -------------------------------------------------------------------------------- /src/Control/Monad/ST/Ref.purs: -------------------------------------------------------------------------------- 1 | module Control.Monad.ST.Ref (module Internal) where 2 | 3 | import Control.Monad.ST.Internal (STRef, new, read, modify, modify', write) as Internal 4 | -------------------------------------------------------------------------------- /src/Control/Monad/ST/Uncurried.js: -------------------------------------------------------------------------------- 1 | export const mkSTFn1 = function mkSTFn1(fn) { 2 | return function(x) { 3 | return fn(x)(); 4 | }; 5 | }; 6 | 7 | export const mkSTFn2 = function mkSTFn2(fn) { 8 | return function(a, b) { 9 | return fn(a)(b)(); 10 | }; 11 | }; 12 | 13 | export const mkSTFn3 = function mkSTFn3(fn) { 14 | return function(a, b, c) { 15 | return fn(a)(b)(c)(); 16 | }; 17 | }; 18 | 19 | export const mkSTFn4 = function mkSTFn4(fn) { 20 | return function(a, b, c, d) { 21 | return fn(a)(b)(c)(d)(); 22 | }; 23 | }; 24 | 25 | export const mkSTFn5 = function mkSTFn5(fn) { 26 | return function(a, b, c, d, e) { 27 | return fn(a)(b)(c)(d)(e)(); 28 | }; 29 | }; 30 | 31 | export const mkSTFn6 = function mkSTFn6(fn) { 32 | return function(a, b, c, d, e, f) { 33 | return fn(a)(b)(c)(d)(e)(f)(); 34 | }; 35 | }; 36 | 37 | export const mkSTFn7 = function mkSTFn7(fn) { 38 | return function(a, b, c, d, e, f, g) { 39 | return fn(a)(b)(c)(d)(e)(f)(g)(); 40 | }; 41 | }; 42 | 43 | export const mkSTFn8 = function mkSTFn8(fn) { 44 | return function(a, b, c, d, e, f, g, h) { 45 | return fn(a)(b)(c)(d)(e)(f)(g)(h)(); 46 | }; 47 | }; 48 | 49 | export const mkSTFn9 = function mkSTFn9(fn) { 50 | return function(a, b, c, d, e, f, g, h, i) { 51 | return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(); 52 | }; 53 | }; 54 | 55 | export const mkSTFn10 = function mkSTFn10(fn) { 56 | return function(a, b, c, d, e, f, g, h, i, j) { 57 | return fn(a)(b)(c)(d)(e)(f)(g)(h)(i)(j)(); 58 | }; 59 | }; 60 | 61 | export const runSTFn1 = function runSTFn1(fn) { 62 | return function(a) { 63 | return function() { 64 | return fn(a); 65 | }; 66 | }; 67 | }; 68 | 69 | export const runSTFn2 = function runSTFn2(fn) { 70 | return function(a) { 71 | return function(b) { 72 | return function() { 73 | return fn(a, b); 74 | }; 75 | }; 76 | }; 77 | }; 78 | 79 | export const runSTFn3 = function runSTFn3(fn) { 80 | return function(a) { 81 | return function(b) { 82 | return function(c) { 83 | return function() { 84 | return fn(a, b, c); 85 | }; 86 | }; 87 | }; 88 | }; 89 | }; 90 | 91 | export const runSTFn4 = function runSTFn4(fn) { 92 | return function(a) { 93 | return function(b) { 94 | return function(c) { 95 | return function(d) { 96 | return function() { 97 | return fn(a, b, c, d); 98 | }; 99 | }; 100 | }; 101 | }; 102 | }; 103 | }; 104 | 105 | export const runSTFn5 = function runSTFn5(fn) { 106 | return function(a) { 107 | return function(b) { 108 | return function(c) { 109 | return function(d) { 110 | return function(e) { 111 | return function() { 112 | return fn(a, b, c, d, e); 113 | }; 114 | }; 115 | }; 116 | }; 117 | }; 118 | }; 119 | }; 120 | 121 | export const runSTFn6 = function runSTFn6(fn) { 122 | return function(a) { 123 | return function(b) { 124 | return function(c) { 125 | return function(d) { 126 | return function(e) { 127 | return function(f) { 128 | return function() { 129 | return fn(a, b, c, d, e, f); 130 | }; 131 | }; 132 | }; 133 | }; 134 | }; 135 | }; 136 | }; 137 | }; 138 | 139 | export const runSTFn7 = function runSTFn7(fn) { 140 | return function(a) { 141 | return function(b) { 142 | return function(c) { 143 | return function(d) { 144 | return function(e) { 145 | return function(f) { 146 | return function(g) { 147 | return function() { 148 | return fn(a, b, c, d, e, f, g); 149 | }; 150 | }; 151 | }; 152 | }; 153 | }; 154 | }; 155 | }; 156 | }; 157 | }; 158 | 159 | export const runSTFn8 = function runSTFn8(fn) { 160 | return function(a) { 161 | return function(b) { 162 | return function(c) { 163 | return function(d) { 164 | return function(e) { 165 | return function(f) { 166 | return function(g) { 167 | return function(h) { 168 | return function() { 169 | return fn(a, b, c, d, e, f, g, h); 170 | }; 171 | }; 172 | }; 173 | }; 174 | }; 175 | }; 176 | }; 177 | }; 178 | }; 179 | }; 180 | 181 | export const runSTFn9 = function runSTFn9(fn) { 182 | return function(a) { 183 | return function(b) { 184 | return function(c) { 185 | return function(d) { 186 | return function(e) { 187 | return function(f) { 188 | return function(g) { 189 | return function(h) { 190 | return function(i) { 191 | return function() { 192 | return fn(a, b, c, d, e, f, g, h, i); 193 | }; 194 | }; 195 | }; 196 | }; 197 | }; 198 | }; 199 | }; 200 | }; 201 | }; 202 | }; 203 | }; 204 | 205 | export const runSTFn10 = function runSTFn10(fn) { 206 | return function(a) { 207 | return function(b) { 208 | return function(c) { 209 | return function(d) { 210 | return function(e) { 211 | return function(f) { 212 | return function(g) { 213 | return function(h) { 214 | return function(i) { 215 | return function(j) { 216 | return function() { 217 | return fn(a, b, c, d, e, f, g, h, i, j); 218 | }; 219 | }; 220 | }; 221 | }; 222 | }; 223 | }; 224 | }; 225 | }; 226 | }; 227 | }; 228 | }; 229 | }; -------------------------------------------------------------------------------- /src/Control/Monad/ST/Uncurried.purs: -------------------------------------------------------------------------------- 1 | -- | This module defines types for STf uncurried functions, as well as 2 | -- | functions for converting back and forth between them. 3 | -- | 4 | -- | The general naming scheme for functions and types in this module is as 5 | -- | follows: 6 | -- | 7 | -- | * `STFn{N}` means, an uncurried function which accepts N arguments and 8 | -- | performs some STs. The first N arguments are the actual function's 9 | -- | argument. The last type argument is the return type. 10 | -- | * `runSTFn{N}` takes an `STFn` of N arguments, and converts it into 11 | -- | the normal PureScript form: a curried function which returns an ST 12 | -- | action. 13 | -- | * `mkSTFn{N}` is the inverse of `runSTFn{N}`. It can be useful for 14 | -- | callbacks. 15 | -- | 16 | 17 | module Control.Monad.ST.Uncurried where 18 | 19 | import Control.Monad.ST.Internal (ST, Region) 20 | 21 | foreign import data STFn1 :: Type -> Region -> Type -> Type 22 | 23 | type role STFn1 representational nominal representational 24 | 25 | foreign import data STFn2 :: Type -> Type -> Region -> Type -> Type 26 | 27 | type role STFn2 representational representational nominal representational 28 | 29 | foreign import data STFn3 :: Type -> Type -> Type -> Region -> Type -> Type 30 | 31 | type role STFn3 representational representational representational nominal representational 32 | 33 | foreign import data STFn4 :: Type -> Type -> Type -> Type -> Region -> Type -> Type 34 | 35 | type role STFn4 representational representational representational representational nominal representational 36 | 37 | foreign import data STFn5 :: Type -> Type -> Type -> Type -> Type -> Region -> Type -> Type 38 | 39 | type role STFn5 representational representational representational representational representational nominal representational 40 | 41 | foreign import data STFn6 :: Type -> Type -> Type -> Type -> Type -> Type -> Region -> Type -> Type 42 | 43 | type role STFn6 representational representational representational representational representational representational nominal representational 44 | 45 | foreign import data STFn7 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Region -> Type -> Type 46 | 47 | type role STFn7 representational representational representational representational representational representational representational nominal representational 48 | 49 | foreign import data STFn8 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Region -> Type -> Type 50 | 51 | type role STFn8 representational representational representational representational representational representational representational representational nominal representational 52 | 53 | foreign import data STFn9 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Region -> Type -> Type 54 | 55 | type role STFn9 representational representational representational representational representational representational representational representational representational nominal representational 56 | 57 | foreign import data STFn10 :: Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Type -> Region -> Type -> Type 58 | 59 | type role STFn10 representational representational representational representational representational representational representational representational representational representational nominal representational 60 | 61 | foreign import mkSTFn1 :: forall a t r. 62 | (a -> ST t r) -> STFn1 a t r 63 | foreign import mkSTFn2 :: forall a b t r. 64 | (a -> b -> ST t r) -> STFn2 a b t r 65 | foreign import mkSTFn3 :: forall a b c t r. 66 | (a -> b -> c -> ST t r) -> STFn3 a b c t r 67 | foreign import mkSTFn4 :: forall a b c d t r. 68 | (a -> b -> c -> d -> ST t r) -> STFn4 a b c d t r 69 | foreign import mkSTFn5 :: forall a b c d e t r. 70 | (a -> b -> c -> d -> e -> ST t r) -> STFn5 a b c d e t r 71 | foreign import mkSTFn6 :: forall a b c d e f t r. 72 | (a -> b -> c -> d -> e -> f -> ST t r) -> STFn6 a b c d e f t r 73 | foreign import mkSTFn7 :: forall a b c d e f g t r. 74 | (a -> b -> c -> d -> e -> f -> g -> ST t r) -> STFn7 a b c d e f g t r 75 | foreign import mkSTFn8 :: forall a b c d e f g h t r. 76 | (a -> b -> c -> d -> e -> f -> g -> h -> ST t r) -> STFn8 a b c d e f g h t r 77 | foreign import mkSTFn9 :: forall a b c d e f g h i t r. 78 | (a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r) -> STFn9 a b c d e f g h i t r 79 | foreign import mkSTFn10 :: forall a b c d e f g h i j t r. 80 | (a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r) -> STFn10 a b c d e f g h i j t r 81 | 82 | foreign import runSTFn1 :: forall a t r. 83 | STFn1 a t r -> a -> ST t r 84 | foreign import runSTFn2 :: forall a b t r. 85 | STFn2 a b t r -> a -> b -> ST t r 86 | foreign import runSTFn3 :: forall a b c t r. 87 | STFn3 a b c t r -> a -> b -> c -> ST t r 88 | foreign import runSTFn4 :: forall a b c d t r. 89 | STFn4 a b c d t r -> a -> b -> c -> d -> ST t r 90 | foreign import runSTFn5 :: forall a b c d e t r. 91 | STFn5 a b c d e t r -> a -> b -> c -> d -> e -> ST t r 92 | foreign import runSTFn6 :: forall a b c d e f t r. 93 | STFn6 a b c d e f t r -> a -> b -> c -> d -> e -> f -> ST t r 94 | foreign import runSTFn7 :: forall a b c d e f g t r. 95 | STFn7 a b c d e f g t r -> a -> b -> c -> d -> e -> f -> g -> ST t r 96 | foreign import runSTFn8 :: forall a b c d e f g h t r. 97 | STFn8 a b c d e f g h t r -> a -> b -> c -> d -> e -> f -> g -> h -> ST t r 98 | foreign import runSTFn9 :: forall a b c d e f g h i t r. 99 | STFn9 a b c d e f g h i t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> ST t r 100 | foreign import runSTFn10 :: forall a b c d e f g h i j t r. 101 | STFn10 a b c d e f g h i j t r -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> ST t r 102 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Effect (Effect) 6 | import Effect.Console (logShow) 7 | import Control.Monad.ST as ST 8 | import Control.Monad.ST.Ref as STRef 9 | 10 | sumOfSquares :: Int 11 | sumOfSquares = ST.run do 12 | total <- STRef.new 0 13 | let loop 0 = STRef.read total 14 | loop n = do 15 | _ <- STRef.modify (_ + (n * n)) total 16 | loop (n - 1) 17 | loop 100 18 | 19 | main :: Effect Unit 20 | main = do 21 | logShow sumOfSquares 22 | --------------------------------------------------------------------------------