Merge pull request #7 from purescript/ffi-unfold

Use an FFI implementation for Array unfold

Author: garyb

.gitignore

@@ -1,5 +1,7 @@
 /.*
 !/.gitignore
+!/.jscsrc
+!/.jshintrc
 !/.travis.yml
 /bower_components/
 /node_modules/

.jscsrc

@@ -0,0 +1,17 @@
+{
+  "preset": "grunt",
+  "disallowSpacesInFunctionExpression": null,
+  "requireSpacesInFunctionExpression": {
+    "beforeOpeningRoundBrace": true,
+    "beforeOpeningCurlyBrace": true
+  },
+  "disallowSpacesInAnonymousFunctionExpression": null,
+  "requireSpacesInAnonymousFunctionExpression": {
+    "beforeOpeningRoundBrace": true,
+    "beforeOpeningCurlyBrace": true
+  },
+  "disallowSpacesInsideObjectBrackets": null,
+  "requireSpacesInsideObjectBrackets": "all",
+  "validateQuoteMarks": "\"",
+  "requireCurlyBraces": null
+}

.jshintrc

@@ -0,0 +1,20 @@
+{
+  "bitwise": true,
+  "eqeqeq": true,
+  "forin": true,
+  "freeze": true,
+  "funcscope": true,
+  "futurehostile": true,
+  "strict": "global",
+  "latedef": true,
+  "maxparams": 1,
+  "noarg": true,
+  "nocomma": true,
+  "nonew": true,
+  "notypeof": true,
+  "singleGroups": true,
+  "undef": true,
+  "unused": true,
+  "eqnull": true,
+  "predef": ["exports"]
+}

.travis.yml

@@ -13,7 +13,7 @@ install:
   - npm install
   - bower install
 script:
-  - npm test
+  - npm run test
 after_success:
 - >-
   test $TRAVIS_TAG &&

bower.json

@@ -17,7 +17,7 @@
     "package.json"
   ],
   "dependencies": {
-    "purescript-arrays": "^1.0.0-rc.1",
+    "purescript-partial": "^1.1.0",
     "purescript-tuples": "^1.0.0-rc.1"
   },
   "devDependencies": {

package.json

@@ -2,10 +2,12 @@
   "private": true,
   "scripts": {
     "clean": "rimraf output && rimraf .pulp-cache",
-    "build": "pulp build",
-    "test": "pulp test"
+    "build": "jshint src && jscs src && pulp build",
+    "test": "jshint src && jscs src && pulp test"
   },
   "devDependencies": {
+    "jscs": "^2.8.0",
+    "jshint": "^2.9.1",
     "pulp": "^8.1.0",
     "rimraf": "^2.5.0"
   }

src/Data/Unfoldable.js

@@ -0,0 +1,24 @@
+"use strict";
+
+// module Data.Unfoldable
+
+exports.unfoldrArrayImpl = function (isNothing) {
+  return function (fromJust) {
+    return function (fst) {
+      return function (snd) {
+        return function (f) {
+          return function (b) {
+            var result = [];
+            while (true) {
+              var maybe = f(b);
+              if (isNothing(maybe)) return result;
+              var tuple = fromJust(maybe);
+              result.push(fst(tuple));
+              b = snd(tuple);
+            }
+          };
+        };
+      };
+    };
+  };
+};

src/Data/Unfoldable.purs

@@ -4,17 +4,21 @@
 -- | This allows us to unify various operations on arrays, lists,
 -- | sequences, etc.
 
-module Data.Unfoldable where
+module Data.Unfoldable
+  ( class Unfoldable, unfoldr
+  , replicate
+  , replicateA
+  , none
+  , singleton
+  ) where
 
 import Prelude
 
-import Control.Monad.Eff (untilE, runPure)
-import Control.Monad.ST (writeSTRef, readSTRef, newSTRef)
-
-import Data.Array.ST (pushSTArray, emptySTArray, runSTArray)
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), isNothing, fromJust)
 import Data.Traversable (class Traversable, sequence)
-import Data.Tuple (Tuple(..))
+import Data.Tuple (Tuple(..), fst, snd)
+
+import Partial.Unsafe (unsafePartial)
 
 -- | This class identifies data structures which can be _unfolded_,
 -- | generalizing `unfoldr` on arrays.
@@ -28,18 +32,17 @@ class Unfoldable t where
   unfoldr :: forall a b. (b -> Maybe (Tuple a b)) -> b -> t a
 
 instance unfoldableArray :: Unfoldable Array where
-  unfoldr f b = runPure (runSTArray (do
-    arr  <- emptySTArray
-    seed <- newSTRef b
-    untilE $ do
-      b1 <- readSTRef seed
-      case f b1 of
-        Nothing -> pure true
-        Just (Tuple a b2) -> do
-          pushSTArray arr a
-          writeSTRef seed b2
-          pure false
-    pure arr))
+  unfoldr = unfoldrArrayImpl isNothing (unsafePartial fromJust) fst snd
+
+foreign import unfoldrArrayImpl
+  :: forall a b
+   . (forall x. Maybe x -> Boolean)
+  -> (forall x. Maybe x -> x)
+  -> (forall x y. Tuple x y -> x)
+  -> (forall x y. Tuple x y -> y)
+  -> (b -> Maybe (Tuple a b))
+  -> b
+  -> Array a
 
 -- | Replicate a value some natural number of times.
 -- | For example: