Add purescript/slice

purescript/README.md

@@ -14,6 +14,7 @@
 | [maps](./maps)                           | Attempt at implementing maps with membership proofs                                                                  |
 | [proofs](./proofs)                       | Attempt at expressing mathematical proofs using Purescript's effect system                                           |
 | [purpleflow](./purpleflow)               | Unfinished dependently-typed programming language                                                                    |
+| [slice](./slice)                         | Basic benchmarks and a `Slice` type                                                                                  |
 | [sprint](./sprint)                       | Failled effect-system based on typelevel lists                                                                       |
 | [streams](./streams)                     | Playing with `purescript-pipes`                                                                                      |
 | [typelevel](./typelevel)                 | Typelevel naturals, vectors, sum-types, orderings and lambda-calculus evaluation and a value-level bounded-type GADT |

purescript/slice/.gitignore

@@ -0,0 +1,11 @@
+/bower_components/
+/node_modules/
+/.pulp-cache/
+/output/
+/generated-docs/
+/.psc-package/
+/.psc*
+/.purs*
+/.psa*
+/.spago
+/tmp

purescript/slice/package.json

@@ -0,0 +1,6 @@
+{
+  "name": "purescript-experiments",
+  "dependencies": {
+    "benchmark": "^2.1.4"
+  }
+}

purescript/slice/packages.dhall

@@ -0,0 +1,18 @@
+let upstream =
+      https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20210118/packages.dhall sha256:a59c5c93a68d5d066f3815a89f398bcf00e130a51cb185b2da29b20e2d8ae115
+
+let additions =
+      { zipperarray =
+        { dependencies =
+          [ "arrays", "maybe", "prelude", "naturals", "strictlypositiveint" ]
+        , repo = "https://github.com/jamieyung/purescript-zipperarray/"
+        , version = "master"
+        }
+      , strictlypositiveint =
+        { dependencies = [ "prelude" ]
+        , repo = "https://github.com/jamieyung/purescript-strictlypositiveint"
+        , version = "master"
+        }
+      }
+
+in  additions ⫽ upstream

purescript/slice/pnpm-lock.yaml

@@ -0,0 +1,21 @@
+dependencies:
+  benchmark: 2.1.4
+lockfileVersion: 5.1
+packages:
+  /benchmark/2.1.4:
+    dependencies:
+      lodash: 4.17.21
+      platform: 1.3.6
+    dev: false
+    resolution:
+      integrity: sha1-CfPeMckWQl1JjMLuVloOvzwqVik=
+  /lodash/4.17.21:
+    dev: false
+    resolution:
+      integrity: sha512-v2kDEe57lecTulaDIuNTPy3Ry4gLGJ6Z1O3vE1krgXZNrsQ+LFTGHVxVjcXPs17LhbZVGedAJv8XZ1tvj5FvSg==
+  /platform/1.3.6:
+    dev: false
+    resolution:
+      integrity: sha512-fnWVljUchTro6RiCFvCXBbNhJc2NijN7oIQxbwsyL0buWJPG85v81ehlHI9fXrJsMNgTofEoWIQeClKpgxFLrg==
+specifiers:
+  benchmark: ^2.1.4

purescript/slice/spago.dhall

@@ -0,0 +1,10 @@
+{-
+Welcome to a Spago project!
+You can edit this file as you like.
+-}
+{ name = "my-project"
+, dependencies =
+  [ "benchotron", "console", "effect", "psci-support", "st", "zipperarray" ]
+, packages = ./packages.dhall
+, sources = [ "src/**/*.purs", "test/**/*.purs" ]
+}

purescript/slice/src/Benchmarks.js

@@ -0,0 +1,23 @@
+exports.arraySum = function (v) {
+  if (v.length) {
+    const [head, ...tail] = v;
+    return (head + exports.arraySum(tail)) | 0;
+  }
+
+  return 0;
+};
+
+exports.arrayFib = (function () {
+  var go = function (a) {
+    return function (b) {
+      return function (v) {
+        if (v === 0) {
+          return [];
+        }
+        var c = (a + b) | 0;
+        return [c, ...go(c)(a)((v - 1) | 0)];
+      };
+    };
+  };
+  return go(1)(1);
+})();

purescript/slice/src/Benchmarks.purs

@@ -0,0 +1,111 @@
+module Benchmarks where
+
+import Prelude
+
+import Benchotron.Core (Benchmark, benchFn, benchFn', mkBenchmark)
+import Control.Monad.ST.Internal as ST
+import Control.Monad.ST.Internal as STRef
+import Data.Array (foldMap, foldr, foldl, (..))
+import Data.Array.NonEmpty as NonEmptyArray
+import Data.Array.ST as STArray
+import Data.List (List(..), (:))
+import Data.List as List
+import Data.Maybe (Maybe(..))
+import Data.Monoid.Additive (Additive(..))
+import Data.ZipperArray (ZipperArray)
+import Data.ZipperArray as ZipperArray
+import Slice (Slice)
+import Slice as Slice
+import Test.QuickCheck (arbitrary)
+import Test.QuickCheck.Gen (vectorOf)
+
+listSum :: List Int -> Int
+listSum (head:tail) = head + listSum tail
+listSum _ = 0
+
+listSumTCO :: List Int -> Int
+listSumTCO = go 0
+    where
+    go s Nil = s
+    go s (head:tail) = go (s + head) tail
+
+zipperSum :: ZipperArray Int -> Int
+zipperSum arr = ZipperArray.current arr + case ZipperArray.goNext arr of
+    Nothing -> 0
+    Just next -> zipperSum next
+
+sliceSum :: Slice Int -> Int
+sliceSum arr = case Slice.uncons arr of
+    Nothing -> 0
+    Just { head, tail } -> head + sliceSum tail
+
+sliceSumTCO :: Slice Int -> Int
+sliceSumTCO = go 0
+    where 
+    go s arr = case Slice.uncons arr of
+        Nothing -> s
+        Just { head, tail } -> go (s + head) tail
+
+listFib :: Int -> List Int
+listFib = go 1 1
+    where
+    go a b 0 = Nil
+    go a b n = c:go c a (n - 1) 
+        where
+        c = a + b
+
+stArrayFib :: Int -> Array Int 
+stArrayFib to = STArray.run do
+    a <- STRef.new 1
+    b <- STRef.new 1
+    result <- STArray.empty
+    ST.for 1 to \_ -> do
+        a' <- STRef.read a
+        b' <- STRef.read b
+        let c = a' + b'
+        void 
+            $ STArray.push c result
+            <* STRef.write a' b
+            <* STRef.write c a
+    pure result
+
+foreign import arraySum :: Array Int -> Int
+foreign import arrayFib :: Int -> Array Int
+
+benchSum :: Benchmark
+benchSum = mkBenchmark
+  { slug: "sum"
+  , title: "Finding the sum of a sequence of integers"
+  , sizes: (1..10) <#> (_ * 1000)
+  , sizeInterpretation: "Number of elements in the array"
+  , inputsPerSize: 1
+  , gen: \n -> NonEmptyArray.cons' <$> arbitrary <*> vectorOf n arbitrary
+  , functions: [ 
+        -- benchFn' "array" arraySum NonEmptyArray.toArray
+               benchFn' "list" listSum List.fromFoldable 
+               , benchFn' "list (tail call optimization" listSumTCO List.fromFoldable
+               , benchFn' "zipper" zipperSum ZipperArray.fromNonEmptyArray
+               , benchFn' "array slice" sliceSum (NonEmptyArray.toArray >>> Slice.fromArray)
+               , benchFn' "array slice (tail call optimization)" sliceSumTCO (NonEmptyArray.toArray >>> Slice.fromArray)
+               , benchFn' "array foldr" (foldr (+) 0) NonEmptyArray.toArray
+               , benchFn' "array foldl" (foldl (+) 0) NonEmptyArray.toArray
+               , benchFn' "array foldMap" (foldMap Additive) NonEmptyArray.toArray
+               , benchFn' "list foldr" (foldr (+) 0) List.fromFoldable
+               , benchFn' "list foldl" (foldl (+) 0) List.fromFoldable
+               , benchFn' "list foldMap" (foldMap Additive) List.fromFoldable
+               ]
+  }
+
+benchFib :: Benchmark
+benchFib = mkBenchmark
+  { slug: "fibonacci"
+  , title: "Generating the first n fibonacci numbers as a sequence"
+  , sizes: (1..10) <#> (_ * 100)
+  , sizeInterpretation: "Number of elements"
+  , inputsPerSize: 1
+  , gen: pure
+  , functions: [ benchFn "array" arrayFib
+               , benchFn "list" listFib
+               , benchFn "stArray" stArrayFib
+               ]
+  }

purescript/slice/src/Main.purs

@@ -0,0 +1,20 @@
+module Main where
+
+import Prelude
+
+import Benchmarks (benchSum)
+import Benchotron.UI.Console (runSuite)
+import Control.Monad.ST.Internal as ST
+import Control.Monad.ST.Internal as STRef
+import Effect (Effect)
+
+factorial :: Int -> Int
+factorial to = ST.run do
+  result <- STRef.new 1
+  ST.for 2 to \index -> do
+    current <- STRef.read result
+    STRef.write (current * index) result
+  STRef.read result
+
+main :: Effect Unit
+main = runSuite [benchSum]

purescript/slice/src/Slice.purs

@@ -0,0 +1,32 @@
+module Slice where
+
+import Prelude
+
+import Data.Array as Array
+import Data.Maybe (Maybe(..))
+import Partial.Unsafe (unsafePartial)
+
+newtype Slice a 
+  = Slice 
+    { array :: Array a
+    , at :: Int
+    , length :: Int }
+
+uncons :: forall a. Slice a -> Maybe { head :: a, tail :: Slice a }
+uncons (Slice { length, at, array }) 
+    = if length == 0 
+      then Nothing
+      else Just 
+        { head: unsafePartial $ Array.unsafeIndex array at
+        , tail: Slice { length: length - 1, at: at + 1, array } }
+
+uncons' :: forall a r. Slice a -> { nil :: r, cons :: a -> Slice a -> r } -> r
+uncons' (Slice { length, at, array }) cases
+    = if length == 0
+        then cases.nil
+        else cases.cons 
+            (unsafePartial $ Array.unsafeIndex array at)
+            (Slice { length: length - 1, at: at + 1, array })
+
+fromArray :: forall a. Array a -> Slice a
+fromArray array = Slice { array, at: 0, length: Array.length array }

purescript/slice/test/Main.purs

@@ -0,0 +1,11 @@
+module Test.Main where
+
+import Prelude
+
+import Effect (Effect)
+import Effect.Class.Console (log)
+
+main :: Effect Unit
+main = do
+  log "🍝"
+  log "You should add some tests."