Skip to content

Commit 2a4929a

Browse files
committed
Use an FFI implementation for Array unfold
1 parent ad16507 commit 2a4929a

File tree

8 files changed

+91
-23
lines changed

8 files changed

+91
-23
lines changed

.gitignore

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
/.*
22
!/.gitignore
3+
!/.jscsrc
4+
!/.jshintrc
35
!/.travis.yml
46
/bower_components/
57
/node_modules/

.jscsrc

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
{
2+
"preset": "grunt",
3+
"disallowSpacesInFunctionExpression": null,
4+
"requireSpacesInFunctionExpression": {
5+
"beforeOpeningRoundBrace": true,
6+
"beforeOpeningCurlyBrace": true
7+
},
8+
"disallowSpacesInAnonymousFunctionExpression": null,
9+
"requireSpacesInAnonymousFunctionExpression": {
10+
"beforeOpeningRoundBrace": true,
11+
"beforeOpeningCurlyBrace": true
12+
},
13+
"disallowSpacesInsideObjectBrackets": null,
14+
"requireSpacesInsideObjectBrackets": "all",
15+
"validateQuoteMarks": "\"",
16+
"requireCurlyBraces": null
17+
}

.jshintrc

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
{
2+
"bitwise": true,
3+
"eqeqeq": true,
4+
"forin": true,
5+
"freeze": true,
6+
"funcscope": true,
7+
"futurehostile": true,
8+
"strict": "global",
9+
"latedef": true,
10+
"maxparams": 1,
11+
"noarg": true,
12+
"nocomma": true,
13+
"nonew": true,
14+
"notypeof": true,
15+
"singleGroups": true,
16+
"undef": true,
17+
"unused": true,
18+
"eqnull": true,
19+
"predef": ["exports"]
20+
}

.travis.yml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ install:
1313
- npm install
1414
- bower install
1515
script:
16-
- npm test
16+
- npm run test
1717
after_success:
1818
- >-
1919
test $TRAVIS_TAG &&

bower.json

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@
1717
"package.json"
1818
],
1919
"dependencies": {
20-
"purescript-arrays": "^1.0.0-rc.1",
20+
"purescript-partial": "^1.1.0",
2121
"purescript-tuples": "^1.0.0-rc.1"
2222
},
2323
"devDependencies": {

package.json

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,10 +2,12 @@
22
"private": true,
33
"scripts": {
44
"clean": "rimraf output && rimraf .pulp-cache",
5-
"build": "pulp build",
6-
"test": "pulp test"
5+
"build": "jshint src && jscs src && pulp build",
6+
"test": "jshint src && jscs src && pulp test"
77
},
88
"devDependencies": {
9+
"jscs": "^2.8.0",
10+
"jshint": "^2.9.1",
911
"pulp": "^8.1.0",
1012
"rimraf": "^2.5.0"
1113
}

src/Data/Unfoldable.js

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
"use strict";
2+
3+
// module Data.Unfoldable
4+
5+
exports.unfoldrArrayImpl = function (isNothing) {
6+
return function (fromJust) {
7+
return function (fst) {
8+
return function (snd) {
9+
return function (f) {
10+
return function (b) {
11+
var result = [];
12+
while (true) {
13+
var maybe = f(b);
14+
if (isNothing(maybe)) return result;
15+
var tuple = fromJust(maybe);
16+
result.push(fst(tuple));
17+
b = snd(tuple);
18+
}
19+
};
20+
};
21+
};
22+
};
23+
};
24+
};

src/Data/Unfoldable.purs

Lines changed: 22 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -4,17 +4,21 @@
44
-- | This allows us to unify various operations on arrays, lists,
55
-- | sequences, etc.
66

7-
module Data.Unfoldable where
7+
module Data.Unfoldable
8+
( class Unfoldable, unfoldr
9+
, replicate
10+
, replicateA
11+
, none
12+
, singleton
13+
) where
814

915
import Prelude
1016

11-
import Control.Monad.Eff (untilE, runPure)
12-
import Control.Monad.ST (writeSTRef, readSTRef, newSTRef)
13-
14-
import Data.Array.ST (pushSTArray, emptySTArray, runSTArray)
15-
import Data.Maybe (Maybe(..))
17+
import Data.Maybe (Maybe(..), isNothing, fromJust)
1618
import Data.Traversable (class Traversable, sequence)
17-
import Data.Tuple (Tuple(..))
19+
import Data.Tuple (Tuple(..), fst, snd)
20+
21+
import Partial.Unsafe (unsafePartial)
1822

1923
-- | This class identifies data structures which can be _unfolded_,
2024
-- | generalizing `unfoldr` on arrays.
@@ -28,18 +32,17 @@ class Unfoldable t where
2832
unfoldr :: forall a b. (b -> Maybe (Tuple a b)) -> b -> t a
2933

3034
instance unfoldableArray :: Unfoldable Array where
31-
unfoldr f b = runPure (runSTArray (do
32-
arr <- emptySTArray
33-
seed <- newSTRef b
34-
untilE $ do
35-
b1 <- readSTRef seed
36-
case f b1 of
37-
Nothing -> pure true
38-
Just (Tuple a b2) -> do
39-
pushSTArray arr a
40-
writeSTRef seed b2
41-
pure false
42-
pure arr))
35+
unfoldr = unfoldrArrayImpl isNothing (unsafePartial fromJust) fst snd
36+
37+
foreign import unfoldrArrayImpl
38+
:: forall a b
39+
. (forall x. Maybe x -> Boolean)
40+
-> (forall x. Maybe x -> x)
41+
-> (forall x y. Tuple x y -> x)
42+
-> (forall x y. Tuple x y -> y)
43+
-> (b -> Maybe (Tuple a b))
44+
-> b
45+
-> Array a
4346

4447
-- | Replicate a value some natural number of times.
4548
-- | For example:

0 commit comments

Comments
 (0)