Merge pull request #182 from njlr/fable-persistent-vector

Enable PersistentVector in Fable

.config/dotnet-tools.json

@@ -19,6 +19,12 @@
       "commands": [
         "fsdocs"
       ]
+    },
+    "fable": {
+      "version": "3.4.4",
+      "commands": [
+        "fable"
+      ]
     }
   }
 }

.gitignore

@@ -190,3 +190,6 @@ RELEASE_NOTES.md.orig
 .ionide
 .fsdocs/
 *.blob
+
+*.fs.js
+fable_modules

src/FSharpx.Collections/PersistentVector.fs

@@ -1,11 +1,11 @@
 /// vector implementation ported from https://github.com/clojure/clojure/blob/master/src/jvm/clojure/lang/Vector.java
 namespace FSharpx.Collections
 
-#if !FABLE_COMPILER
 
 open FSharpx.Collections
 open System.Threading
 
+#if !FABLE_COMPILER
 type Node(thread,array:obj[]) =
     let thread = thread
     new() = Node(ref null,Array.create Literals.blockSize null)
@@ -14,6 +14,13 @@ type Node(thread,array:obj[]) =
         member this.Array = array
         member this.Thread = thread
         member this.SetThread t = thread := t
+#else
+type Node(array:obj[]) =
+    new() = Node(Array.create Literals.blockSize null)
+    with
+        static member InCurrentThread() = Node(Array.create Literals.blockSize null)
+        member this.Array = array
+#endif
 
 type internal TransientVector<'T> (count,shift:int,root:Node,tail:obj[]) =
     let mutable count = count
@@ -24,14 +31,22 @@ type internal TransientVector<'T> (count,shift:int,root:Node,tail:obj[]) =
     new() = TransientVector<'T>(0,Literals.blockSizeShift,Node.InCurrentThread(),Array.create Literals.blockSize null)
 
     member internal this.EnsureEditable(node:Node) =
+#if !FABLE_COMPILER
         if node.Thread = root.Thread then node else
         Node(root.Thread,Array.copy node.Array)
+#else
+        node
+#endif
 
     member internal this.NewPath(level,node:Node) =
         if level = 0 then node else
         let ret = Array.create Literals.blockSize null
         ret.[0] <- this.NewPath(level - Literals.blockSizeShift,node) :> obj
+#if !FABLE_COMPILER
         Node(node.Thread,ret)
+#else
+        Node(ret)
+#endif
 
     member internal this.PushTail(level,parent:Node,tailnode) =
         //if parent is leaf, insert node,
@@ -75,15 +90,23 @@ type internal TransientVector<'T> (count,shift:int,root:Node,tail:obj[]) =
             tail.[count &&& Literals.blockIndexMask] <- x :> obj
         else
             //full tail, push into tree
+            #if !FABLE_COMPILER
             let tailNode = Node(root.Thread,tail)
+            #else
+            let tailNode = Node(tail)
+            #endif
             let newShift = shift
             let newTail = Array.create Literals.blockSize null
             newTail.[0] <- x :> obj
 
             //overflow root?
             let newRoot =
                 if (count >>> Literals.blockSizeShift) > (1 <<< shift) then
+                    #if !FABLE_COMPILER
                     let newRoot = Node(root.Thread,Array.create Literals.blockSize null)
+                    #else
+                    let newRoot = Node(Array.create Literals.blockSize null)
+                    #endif
                     newRoot.Array.[0] <- root :> obj
                     newRoot.Array.[1] <- this.NewPath(shift,tailNode) :> obj
                     shift <- shift + Literals.blockSizeShift
@@ -114,16 +137,22 @@ type internal TransientVector<'T> (count,shift:int,root:Node,tail:obj[]) =
 
     member this.persistent() : PersistentVector<'T> =
         this.EnsureEditable()
+        #if !FABLE_COMPILER
         root.SetThread null
+        #endif
         let l = count - this.TailOff()
         let trimmedTail = Array.init l (fun i -> tail.[i])
         PersistentVector(count, shift, root, trimmedTail)
 
     member internal this.EnsureEditable() =
+        #if !FABLE_COMPILER
         if !root.Thread = Thread.CurrentThread then () else
         if !root.Thread <> null then
             failwith "Transient used by non-owner thread"
         failwith "Transient used after persistent! call"
+        #else
+        ()
+        #endif
 
     member internal this.TailOff() =
         if count < Literals.blockSize then 0 else
@@ -174,7 +203,11 @@ and PersistentVector<'T> (count,shift:int,root:Node,tail:obj[])  =
 
     member internal this.NewPath(level,node:Node) =
         if level = 0 then node else
+        #if !FABLE_COMPILER
         let ret = Node(root.Thread,Array.create Literals.blockSize null)
+        #else
+        let ret = Node(Array.create Literals.blockSize null)
+        #endif
         ret.Array.[0] <- this.NewPath(level - Literals.blockSizeShift,node) :> obj
         ret
 
@@ -184,7 +217,11 @@ and PersistentVector<'T> (count,shift:int,root:Node,tail:obj[])  =
         // else alloc new path
         //return  nodeToInsert placed in copy of parent
         let subidx = ((count - 1) >>> level) &&& Literals.blockIndexMask
+        #if !FABLE_COMPILER
         let ret = Node(parent.Thread,Array.copy parent.Array)
+        #else
+        let ret = Node(Array.copy parent.Array)
+        #endif
 
         let nodeToInsert =
             if level = Literals.blockSizeShift then tailnode else
@@ -212,7 +249,11 @@ and PersistentVector<'T> (count,shift:int,root:Node,tail:obj[])  =
         else raise (System.IndexOutOfRangeException())
 
     member internal this.doAssoc(level,node:Node,i,x) =
+        #if !FABLE_COMPILER
         let ret = Node(root.Thread,Array.copy node.Array)
+        #else
+        let ret = Node(Array.copy node.Array)
+        #endif
         if level = 0 then
             ret.Array.[i &&& Literals.blockIndexMask] <- x :> obj
         else
@@ -225,13 +266,21 @@ and PersistentVector<'T> (count,shift:int,root:Node,tail:obj[])  =
         if level > Literals.blockSizeShift then
             let newchild = this.PopTail(level - Literals.blockSizeShift, node.Array.[subidx] :?> Node)
             if newchild = Unchecked.defaultof<Node> && subidx = 0 then Unchecked.defaultof<Node> else
+            #if !FABLE_COMPILER
             let ret = Node(root.Thread, Array.copy node.Array);
+            #else
+            let ret = Node(Array.copy node.Array);
+            #endif
             ret.Array.[subidx] <- newchild  :> obj
             ret
 
         elif subidx = 0 then Unchecked.defaultof<Node> else
 
+        #if !FABLE_COMPILER
         let ret = new Node(root.Thread, Array.copy node.Array)
+        #else
+        let ret = new Node(Array.copy node.Array)
+        #endif
         ret.Array.[subidx] <- null
         ret
 
@@ -256,7 +305,11 @@ and PersistentVector<'T> (count,shift:int,root:Node,tail:obj[])  =
             PersistentVector<'T>(count + 1,shift,root,newTail)
         else
             //full tail, push into tree
+            #if !FABLE_COMPILER
             let tailNode = Node(root.Thread,tail)
+            #else
+            let tailNode = Node(tail)
+            #endif
             let newShift = shift
 
             //overflow root?
@@ -274,7 +327,11 @@ and PersistentVector<'T> (count,shift:int,root:Node,tail:obj[])  =
         if count = 1 then PersistentVector<'T>.Empty() else
 
         if count - tailOff > 1 then
-            let mutable newroot = Node(ref Thread.CurrentThread, root.Array.Clone() :?> obj[])
+            #if !FABLE_COMPILER
+            let mutable newroot = Node(ref Thread.CurrentThread, Array.copy root.Array)
+            #else
+            let mutable newroot = Node(Array.copy root.Array)
+            #endif
             let mutable ret = TransientVector(count - 1, shift, newroot, tail.[0..(tail.Length-1)])
             ret.persistent()
         else
@@ -464,5 +521,3 @@ module PersistentVector =
     let inline windowSeq windowLength (items : 'T seq) =
         if windowLength < 1 then invalidArg "windowLength" "length is less than 1"
         else (Seq.fold (windowFun windowLength) (empty.Conj empty<'T>) items)
-
-#endif

src/FSharpx.Collections/PersistentVector.fsi

@@ -1,5 +1,5 @@
-#if !FABLE_COMPILER
-namespace FSharpx.Collections
+namespace FSharpx.Collections
+
 /// PersistentVector is an ordered linear structure implementing the inverse of the List signature,
 /// (last, initial, conj) in place of (head, tail, cons). Length is O(1). Indexed lookup or update
 /// (returning a new immutable instance of Vector) of any element is O(log32n), which is close enough
@@ -151,4 +151,3 @@ module PersistentVector =
 
     /// O(n). Returns a vector of vectors of given length from the seq. Result may be a jagged vector.
     val inline windowSeq : int  -> seq<'T> -> PersistentVector<PersistentVector<'T>>
-#endif

tests/fable/FSharpx.Collections.Tests/FSharpx.Collections.Tests.fsproj

@@ -9,8 +9,8 @@
     <Compile Include="NonEmptyList.test.fs" />
     <Compile Include="Deque.test.fs" />
     <Compile Include="LazyList.test.fs" />
+    <Compile Include="PersistentVector.test.fs" />
     <None Include="paket.references" />
-    <None Include="splitter.config.js" />
   </ItemGroup>
   <ItemGroup>
     <ProjectReference Include="..\..\..\src\FSharpx.Collections\FSharpx.Collections.fsproj" />

tests/fable/FSharpx.Collections.Tests/PersistentVector.test.fs

@@ -0,0 +1,48 @@
+module PersistentVectorTests
+
+open Fable.Jester
+open Fable.FastCheck
+open Fable.FastCheck.Jest
+open FSharpx.Collections
+
+Jest.test("PersistentVector.empty works as expected", fun () ->
+  let v = PersistentVector.empty
+
+  Jest.expect(PersistentVector.isEmpty v).toEqual(true)
+  Jest.expect(PersistentVector.length v).toEqual(0)
+)
+
+Jest.test("PersistentVector.conj works as expected", fun () ->
+  let v =
+    PersistentVector.empty
+    |> PersistentVector.conj "a"
+
+  Jest.expect(PersistentVector.nth 0 v).toEqual("a")
+
+  let v =
+    v
+    |> PersistentVector.conj "b"
+    |> PersistentVector.conj "c"
+
+  Jest.expect(PersistentVector.nth 0 v).toEqual("a")
+  Jest.expect(PersistentVector.nth 1 v).toEqual("b")
+  Jest.expect(PersistentVector.nth 2 v).toEqual("c")
+)
+
+Jest.test("PersistentVector implements seq as expected", fun () ->
+  let v =
+    PersistentVector.empty
+    |> PersistentVector.conj 1
+    |> PersistentVector.conj 4
+    |> PersistentVector.conj 25
+
+  Jest.expect(Seq.toList v = [ 1; 4; 25 ]).toBe(true)
+)
+
+Jest.test("PersistentVector.map works as expected", fun () ->
+  let v =
+    PersistentVector.ofSeq [ 1..4 ]
+    |> PersistentVector.map (fun x -> x * 2)
+
+  Jest.expect(Seq.toList v = [ 2; 4; 6; 8 ]).toBe(true)
+)

tests/fable/babel.config.js

@@ -0,0 +1,8 @@
+module.exports = {
+  presets: [
+    [ '@babel/preset-env', { targets: { node: 'current' } } ]
+  ],
+  plugins: [
+    "@babel/plugin-transform-runtime",
+  ],
+};

tests/fable/package.json

@@ -1,22 +1,24 @@
 {
   "name": "fsharpx-collections",
-  "version": "0.0.0",
+  "version": "0.1.0",
   "license": "MIT",
   "author": "fsprojects",
   "scripts": {
-    "pretest": "fable-splitter -c FSharpx.Collections.Tests/splitter.config.js",
+    "pretest": "dotnet fable ./FSharpx.Collections.Tests --sourceMaps --outDir ./dist",
     "test": "jest"
   },
   "dependencies": {},
-  "private": "true",
+  "private": true,
   "jest": {
     "roots": [
-      "./dist/tests"
+      "./dist"
     ]
   },
   "devDependencies": {
-    "fable-compiler": "^2.13.0",
-    "fable-splitter": "^2.2.1",
-    "jest": "^26.6.3"
+    "@babel/core": "^7.15.8",
+    "@babel/plugin-transform-runtime": "^7.15.8",
+    "@babel/preset-env": "^7.15.8",
+    "babel-jest": "^27.3.1",
+    "jest": "^27.2"
   }
 }