refactor: kronecker, tests, sparse.map

Author: artemiipatov

src/GraphBLAS-sharp.Backend/Matrix/CSR/Kronecker.fs

@@ -1,8 +1,8 @@
 namespace GraphBLAS.FSharp.Backend.Matrix.CSR
 
-open FSharp.Quotations.Evaluator
 open FSharpx.Collections
 open Microsoft.FSharp.Quotations
+open FSharp.Quotations.Evaluator.QuotationEvaluationExtensions
 open Brahma.FSharp
 open GraphBLAS.FSharp.Backend.Quotes
 open GraphBLAS.FSharp.Backend.Common
@@ -74,7 +74,7 @@ module internal Kronecker =
         let createClArray =
             ClArray.zeroCreate clContext workGroupSize
 
-        let opOnHost = QuotationEvaluator.Evaluate op
+        let opOnHost = op.Evaluate()
 
         fun (queue: MailboxProcessor<_>) (matrixZero: COO<'c> option) (matrixLeft: CSR<'a>) (matrixRight: CSR<'b>) ->
 
@@ -410,9 +410,8 @@ module internal Kronecker =
             let startIndex =
                 insertNonZero queue rowsEdges matrixRight matrixLeft.Values leftColumns resultMatrix
 
-            match matrixZero with
-            | Some m -> insertZero queue startIndex zeroCounts m resultMatrix
-            | _ -> ()
+            matrixZero
+            |> Option.iter (fun m -> insertZero queue startIndex zeroCounts m resultMatrix)
 
             resultMatrix
 
@@ -442,14 +441,16 @@ module internal Kronecker =
                 getSize queue matrixZero matrixLeft matrixRight
 
             if size = 0 then
+                matrixZero
+                |> Option.iter (fun m -> m.Dispose queue)
+
                 None
             else
                 let result =
                     mapAll queue allocationMode size matrixZero matrixLeft matrixRight
 
-                match matrixZero with
-                | Some m -> m.Dispose queue
-                | _ -> ()
+                matrixZero
+                |> Option.iter (fun m -> m.Dispose queue)
 
                 bitonic queue result.Rows result.Columns result.Values
 

src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs

@@ -9,6 +9,7 @@ open GraphBLAS.FSharp.Backend.Objects
 open GraphBLAS.FSharp.Backend.Objects.ClCell
 open GraphBLAS.FSharp.Backend.Objects.ClMatrix
 open GraphBLAS.FSharp.Backend.Objects.ClContext
+open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions
 
 module internal Map =
     let preparePositions<'a, 'b> op (clContext: ClContext) workGroupSize =
@@ -101,10 +102,10 @@ module internal Map =
             let resultRows, resultColumns, resultValues, _ =
                 setPositions queue allocationMode rows columns values bitmap
 
-            queue.Post(Msg.CreateFreeMsg<_>(bitmap))
-            queue.Post(Msg.CreateFreeMsg<_>(values))
-            queue.Post(Msg.CreateFreeMsg<_>(rows))
-            queue.Post(Msg.CreateFreeMsg<_>(columns))
+            bitmap.Free queue
+            values.Free queue
+            rows.Free queue
+            columns.Free queue
 
             { Context = clContext
               RowCount = matrix.RowCount

src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs

@@ -79,13 +79,14 @@ module internal Common =
         fun (processor: MailboxProcessor<_>) allocationMode (vectors: Sparse<'a> seq) ->
 
             let vectorIndices, _ =
-                (0, vectors)
-                ||> Seq.mapFold
-                        (fun offset vector ->
-                            let newIndices =
-                                mapIndices processor allocationMode offset vector.Indices
-
-                            newIndices, offset + vector.Size)
+                vectors
+                |> Seq.mapFold
+                    (fun offset vector ->
+                        let newIndices =
+                            mapIndices processor allocationMode offset vector.Indices
+
+                        newIndices, offset + vector.Size)
+                    0
 
             let vectorValues =
                 vectors |> Seq.map (fun vector -> vector.Values)

src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs

@@ -1,6 +1,6 @@
 namespace GraphBLAS.FSharp.Backend.Vector.Sparse
 
-open FSharp.Quotations.Evaluator
+open FSharp.Quotations.Evaluator.QuotationEvaluationExtensions
 open Microsoft.FSharp.Quotations
 open Brahma.FSharp
 open GraphBLAS.FSharp.Backend
@@ -10,6 +10,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClVector
 open GraphBLAS.FSharp.Backend.Common.ClArray
 open GraphBLAS.FSharp.Backend.Objects.ClCell
 open GraphBLAS.FSharp.Backend.Objects.ClContext
+open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions
 
 module Map =
     module WithValueOption =
@@ -79,7 +80,7 @@ module Map =
             let map =
                 preparePositions op clContext workGroupSize
 
-            let opOnHost = op |> QuotationEvaluator.Evaluate
+            let opOnHost = op.Evaluate()
 
             let setPositions =
                 Common.setPositionsOption<'c> clContext workGroupSize
@@ -100,29 +101,22 @@ module Map =
                     let result =
                         setPositions queue allocationMode values indices bitmap
 
-                    queue.Post(Msg.CreateFreeMsg<_>(indices))
-                    queue.Post(Msg.CreateFreeMsg<_>(values))
-                    queue.Post(Msg.CreateFreeMsg<_>(bitmap))
+                    indices.Free queue
+                    values.Free queue
+                    bitmap.Free queue
 
                     result
-                    |> Option.bind
+                    |> Option.map
                         (fun (resultValues, resultIndices) ->
                             { Context = clContext
                               Size = size
                               Indices = resultIndices
-                              Values = resultValues }
-                            |> Some)
+                              Values = resultValues })
                 | None ->
                     opOnHost value None
-                    |> Option.bind
+                    |> Option.map
                         (fun resultValue ->
-                            let resultValues =
-                                create queue allocationMode size resultValue
-
-                            let resultIndices = init queue allocationMode size
-
                             { Context = clContext
                               Size = size
-                              Indices = resultIndices
-                              Values = resultValues }
-                            |> Some)
+                              Indices = init queue allocationMode size
+                              Values = create queue allocationMode size resultValue })

tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs

@@ -2,7 +2,6 @@
 
 open Expecto
 open Expecto.Logging
-open Brahma.FSharp
 open GraphBLAS.FSharp.Tests
 open GraphBLAS.FSharp.Tests.Context
 open GraphBLAS.FSharp.Tests.TestCases
@@ -22,7 +21,10 @@ let logger = Log.create "kronecker.Tests"
 
 let workGroupSize = Utils.defaultWorkGroupSize
 
-let makeTest context processor zero isEqual op kroneckerFun (leftMatrix: 'a [,], rightMatrix: 'a [,]) =
+let makeTest testContext zero isEqual op kroneckerFun (leftMatrix: 'a [,], rightMatrix: 'a [,]) =
+    let context = testContext.ClContext
+    let processor = testContext.Queue
+
     let m1 =
         Utils.createMatrixFromArray2D CSR leftMatrix (isEqual zero)
 
@@ -49,7 +51,7 @@ let makeTest context processor zero isEqual op kroneckerFun (leftMatrix: 'a [,],
             kroneckerFun processor ClContext.HostInterop m1 m2
 
         let actual =
-            Option.bind (fun (m: ClMatrix<'a>) -> m.ToHost processor |> Some) result
+            Option.map (fun (m: ClMatrix<'a>) -> m.ToHost processor) result
 
         m1.Dispose processor
         m2.Dispose processor
@@ -62,34 +64,29 @@ let makeTest context processor zero isEqual op kroneckerFun (leftMatrix: 'a [,],
         "Matrices should be equal"
         |> Expect.equal actual expectedOption
 
-let createGeneralTest (context: ClContext) (processor: MailboxProcessor<Msg>) (zero: 'a) isEqual op opQ testName =
-
-    let kronecker =
-        Matrix.kronecker opQ context workGroupSize
-
-    makeTest context processor zero isEqual op kronecker
+let createGeneralTest testContext (zero: 'a) isEqual op opQ testName =
+    Matrix.kronecker opQ testContext.ClContext workGroupSize
+    |> makeTest testContext zero isEqual op
     |> testPropertyWithConfig config $"test on %A{typeof<'a>} %s{testName}"
 
 let generalTests (testContext: TestContext) =
-    [ let context = testContext.ClContext
-      let queue = testContext.Queue
-      queue.Error.Add(fun e -> failwithf "%A" e)
+    [ testContext.Queue.Error.Add(fun e -> failwithf "%A" e)
 
-      createGeneralTest context queue false (=) (&&) ArithmeticOperations.boolMulOption "mul"
-      createGeneralTest context queue false (=) (||) ArithmeticOperations.boolSumOption "sum"
+      createGeneralTest testContext false (=) (&&) ArithmeticOperations.boolMulOption "mul"
+      createGeneralTest testContext false (=) (||) ArithmeticOperations.boolSumOption "sum"
 
-      createGeneralTest context queue 0 (=) (*) ArithmeticOperations.intMulOption "mul"
-      createGeneralTest context queue 0 (=) (+) ArithmeticOperations.intSumOption "sum"
+      createGeneralTest testContext 0 (=) (*) ArithmeticOperations.intMulOption "mul"
+      createGeneralTest testContext 0 (=) (+) ArithmeticOperations.intSumOption "sum"
 
-      createGeneralTest context queue 0uy (=) (*) ArithmeticOperations.byteMulOption "mul"
-      createGeneralTest context queue 0uy (=) (+) ArithmeticOperations.byteSumOption "sum"
+      createGeneralTest testContext 0uy (=) (*) ArithmeticOperations.byteMulOption "mul"
+      createGeneralTest testContext 0uy (=) (+) ArithmeticOperations.byteSumOption "sum"
 
-      createGeneralTest context queue 0.0f Utils.float32IsEqual (*) ArithmeticOperations.float32MulOption "mul"
-      createGeneralTest context queue 0.0f Utils.float32IsEqual (+) ArithmeticOperations.float32SumOption "sum"
+      createGeneralTest testContext 0.0f Utils.float32IsEqual (*) ArithmeticOperations.float32MulOption "mul"
+      createGeneralTest testContext 0.0f Utils.float32IsEqual (+) ArithmeticOperations.float32SumOption "sum"
 
-      if Utils.isFloat64Available context.ClDevice then
-          createGeneralTest context queue 0.0 Utils.floatIsEqual (*) ArithmeticOperations.floatMulOption "mul"
-          createGeneralTest context queue 0.0 Utils.floatIsEqual (+) ArithmeticOperations.floatSumOption "sum" ]
+      if Utils.isFloat64Available testContext.ClContext.ClDevice then
+          createGeneralTest testContext 0.0 Utils.floatIsEqual (*) ArithmeticOperations.floatMulOption "mul"
+          createGeneralTest testContext 0.0 Utils.floatIsEqual (+) ArithmeticOperations.floatSumOption "sum" ]
 
 let tests =
     gpuTests "Backend.Matrix.kronecker tests" generalTests

tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj

@@ -53,7 +53,7 @@
         <Compile Include="Backend/Matrix/Merge.fs" />
         <Compile Include="Backend/Matrix/ExpandRows.fs" />
         <Compile Include="Backend/Matrix/SubRows.fs" />
-        <Compile Include="Backend\Matrix\Kronecker.fs" />
+        <Compile Include="Backend/Matrix/Kronecker.fs" />
         <Compile Include="Backend/Vector/AssignByMask.fs" />
         <Compile Include="Backend/Vector/Convert.fs" />
         <Compile Include="Backend/Vector/Copy.fs" />