refactor: types in SparseVector.ElementWiseConstructor

Author: IgorErin

src/GraphBLAS-sharp.Backend/Vector/SparseVector/ElementwiseConstructor.fs

@@ -119,77 +119,81 @@ module ElementwiseConstructor =
                         firstResultValues.[i] <- firstValuesBuffer.[beginIdx + boundaryX]
                         isLeftBitMap.[i] <- 1 @>
 
-        let private opWriteBothFill (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) =
-            <@
-                fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: 'a) ->
-                     (%opAdd) (Some leftValues.[gid]) (Some rightValues.[gid + 1]) value
-            @>
-
-        let private opWriteLeftFill (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) =
-            <@
-                fun gid (leftValues: ClArray<'a>) (value: 'a) ->
-                     (%opAdd) (Some leftValues.[gid]) None value
-            @>
-
-        let private opWriteRightFill (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) =
-            <@
-                fun gid (rightValues: ClArray<'b>) (value: 'a) ->
-                     (%opAdd) None (Some rightValues.[gid + 1]) value
-            @>
-
-        let private opWriteAtLeastOneBothFill (opAdd: Expr<AtLeastOne<'a,'b> -> 'a -> 'a option>) =
-            <@
-                fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: 'a) ->
-                     (%opAdd) (Both(leftValues.[gid], rightValues.[gid + 1])) value
-            @>
-
-        let private opWriteAtLeastOneLeftFill (opAdd: Expr<AtLeastOne<'a,'b> -> 'a -> 'a option>) =
-            <@
-                fun gid (leftValues: ClArray<'a>) (value: 'a) ->
-                      (%opAdd) (Left(leftValues.[gid])) value
-            @>
-
-        let private opWriteAtLeastOneRightFill (opAdd: Expr<AtLeastOne<'a,'b> -> 'a -> 'a option>) =
-            <@
-                fun gid (rightValues: ClArray<'b>) (value: 'a) ->
-                     (%opAdd) (Right(rightValues.[gid])) value
-            @>
-
-        let private opWriteBoth (opAdd: Expr<'a option -> 'b option -> 'c option>) =
-            <@
-                fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) ->
-                     (%opAdd) (Some leftValues.[gid]) (Some rightValues.[gid + 1])
-            @>
-
-        let private opWriteLeft (opAdd: Expr<'a option -> 'b option -> 'c option>) =
-            <@
-                fun gid (leftValues: ClArray<'a>)->
-                     (%opAdd) (Some leftValues.[gid]) None
-            @>
-
-        let private opWriteRight (opAdd: Expr<'a option -> 'b option -> 'c option>) =
-            <@
-                fun gid (rightValues: ClArray<'b>) ->
-                     (%opAdd) None (Some rightValues.[gid + 1])
-            @>
-
-        let private opWriteAtLeastOneBoth (opAdd: Expr<AtLeastOne<'a,'b> -> 'c option>) =
-            <@
-                fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) ->
-                     (%opAdd) (Both(leftValues.[gid], rightValues.[gid + 1]))
-            @>
-
-        let opWriteAtLeastOneLeft (opAdd: Expr<AtLeastOne<'a,'b> -> 'c option>) =
-            <@
-                fun gid (leftValues: ClArray<'a>) ->
-                      (%opAdd) (Left(leftValues.[gid]))
-            @>
-
-        let opWriteAtLeastOneRight (opAdd: Expr<AtLeastOne<'a,'b> -> 'a option>) =
-            <@
-                fun gid (rightValues: ClArray<'b>) ->
-                     (%opAdd) (Right(rightValues.[gid]))
-            @>
+        module FillSubVectorRead =
+            let both (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) =
+                <@
+                    fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: 'a) ->
+                         (%opAdd) (Some leftValues.[gid]) (Some rightValues.[gid + 1]) value
+                @>
+
+            let left (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) =
+                <@
+                    fun gid (leftValues: ClArray<'a>) (value: 'a) ->
+                         (%opAdd) (Some leftValues.[gid]) None value
+                @>
+
+            let right (opAdd: Expr<'a option -> 'b option -> 'a -> 'a option>) =
+                <@
+                    fun gid (rightValues: ClArray<'b>) (value: 'a) ->
+                         (%opAdd) None (Some rightValues.[gid + 1]) value
+                @>
+
+        module FillSubVectorAtLeasOneRead =
+            let both (opAdd: Expr<AtLeastOne<'a,'b> -> 'a -> 'a option>) =
+                <@
+                    fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: 'a) ->
+                         (%opAdd) (Both(leftValues.[gid], rightValues.[gid + 1])) value
+                @>
+
+            let left (opAdd: Expr<AtLeastOne<'a,'b> -> 'a -> 'a option>) =
+                <@
+                    fun gid (leftValues: ClArray<'a>) (value: 'a) ->
+                          (%opAdd) (Left(leftValues.[gid])) value
+                @>
+
+            let right (opAdd: Expr<AtLeastOne<'a,'b> -> 'a -> 'a option>) =
+                <@
+                    fun gid (rightValues: ClArray<'b>) (value: 'a) ->
+                         (%opAdd) (Right(rightValues.[gid])) value
+                @>
+
+        module ElementWiseRead =
+            let both (opAdd: Expr<'a option -> 'b option -> 'c option>) =
+                <@
+                    fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) ->
+                         (%opAdd) (Some leftValues.[gid]) (Some rightValues.[gid + 1])
+                @>
+
+            let left (opAdd: Expr<'a option -> 'b option -> 'c option>) =
+                <@
+                    fun gid (leftValues: ClArray<'a>)->
+                         (%opAdd) (Some leftValues.[gid]) None
+                @>
+
+            let right (opAdd: Expr<'a option -> 'b option -> 'c option>) =
+                <@
+                    fun gid (rightValues: ClArray<'b>) ->
+                         (%opAdd) None (Some rightValues.[gid + 1])
+                @>
+
+        module ElementWiseAtLeasOneRead =
+            let both (opAdd: Expr<AtLeastOne<'a,'b> -> 'c option>) =
+                <@
+                    fun gid (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) ->
+                         (%opAdd) (Both(leftValues.[gid], rightValues.[gid + 1]))
+                @>
+
+            let left (opAdd: Expr<AtLeastOne<'a,'b> -> 'c option>) =
+                <@
+                    fun gid (leftValues: ClArray<'a>) ->
+                          (%opAdd) (Left(leftValues.[gid]))
+                @>
+
+            let right (opAdd: Expr<AtLeastOne<'a,'b> -> 'c option>) =
+                <@
+                    fun gid (rightValues: ClArray<'b>) ->
+                         (%opAdd) (Right(rightValues.[gid]))
+                @>
 
         let private both<'c> =
             <@ fun index (result: 'c option) (rawPositionsBuffer: ClArray<int>) (allValuesBuffer: ClArray<'c>) ->
@@ -217,9 +221,9 @@ module ElementwiseConstructor =
                     | None -> rawPositionsBuffer.[index] <- 0 @>
 
         let private preparePositionsGeneral
-            (bothWrite: Expr<(int -> ClArray<'a> -> ClArray<'b> -> 'c option)>)
-            leftWrite
-            rightWrite
+            bothRead
+            leftRead
+            rightRead
             =
 
             <@ fun (ndRange: Range1D) length (allIndices: ClArray<int>) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray<int>) (allValues: ClArray<'c>) (positions: ClArray<int>) ->
@@ -228,20 +232,20 @@ module ElementwiseConstructor =
 
                 if gid < length - 1
                    && allIndices.[gid] = allIndices.[gid + 1] then
-                    let (result: 'c option) = (%bothWrite) gid leftValues rightValues
+                    let (result: 'c option) = (%bothRead) gid leftValues rightValues
 
                     (%both) gid result positions allValues
                 elif (gid < length
                       && gid > 0
                       && allIndices.[gid - 1] <> allIndices.[gid])
                      || gid = 0 then
 
-                    let leftResult = (%leftWrite) gid leftValues
-                    let rightResult = (%rightWrite) gid rightValues
+                    let leftResult = (%leftRead) gid leftValues
+                    let rightResult = (%rightRead) gid rightValues
 
                     (%leftRight) gid leftResult rightResult isLeft allValues positions @>
 
-        let private prepareFillVectorGeneral bothWrite leftWrite rightWrite =
+        let private prepareFillVectorGeneral bothRead leftRead rightRead =
             <@ fun (ndRange: Range1D) length (allIndices: ClArray<int>) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (value: ClCell<'a>) (isLeft: ClArray<int>) (allValues: ClArray<'a>) (positions: ClArray<int>) ->
 
                 let gid = ndRange.GlobalID0
@@ -250,22 +254,26 @@ module ElementwiseConstructor =
 
                 if gid < length - 1
                    && allIndices.[gid] = allIndices.[gid + 1] then
-                    let (result: 'a option) = (%bothWrite) gid leftValues rightValues value
+                    let (result: 'a option) = (%bothRead) gid leftValues rightValues value
 
                     (%both) gid result positions allValues
                 elif (gid < length
                       && gid > 0
                       && allIndices.[gid - 1] <> allIndices.[gid])
                       || gid = 0 then
-                    let leftResult = (%leftWrite) gid leftValues value
-                    let rightResult = (%rightWrite) gid rightValues value
+                    let leftResult = (%leftRead) gid leftValues value
+                    let rightResult = (%rightRead) gid rightValues value
 
                     (%leftRight) gid leftResult rightResult isLeft allValues positions @>
 
-        let preparePositions opAdd = preparePositionsGeneral (opWriteBoth opAdd) (opWriteLeft opAdd) (opWriteRight opAdd)
+        let preparePositions opAdd =
+            preparePositionsGeneral (ElementWiseRead.both opAdd) (ElementWiseRead.left opAdd) (ElementWiseRead.right opAdd)
 
-        let preparePositionsAtLeastOne opAdd = preparePositionsGeneral (opWriteAtLeastOneBoth opAdd) (opWriteAtLeastOneLeft opAdd) (opWriteAtLeastOneRight opAdd)
+        let preparePositionsAtLeastOne opAdd =
+            preparePositionsGeneral (ElementWiseAtLeasOneRead.both opAdd) (ElementWiseAtLeasOneRead.left opAdd) (ElementWiseAtLeasOneRead.right opAdd)
 
-        let prepareFillVector opAdd = prepareFillVectorGeneral (opWriteBothFill opAdd) (opWriteLeftFill opAdd) (opWriteRightFill opAdd)
+        let prepareFillVector opAdd =
+            prepareFillVectorGeneral (FillSubVectorRead.both opAdd) (FillSubVectorRead.left opAdd) (FillSubVectorRead.right opAdd)
 
-        let prepareFillVectorAtLeastOne opAdd = prepareFillVectorGeneral (opWriteAtLeastOneBothFill opAdd) (opWriteAtLeastOneLeftFill opAdd) (opWriteAtLeastOneRightFill opAdd)
+        let prepareFillVectorAtLeastOne opAdd =
+            prepareFillVectorGeneral (FillSubVectorAtLeasOneRead.both opAdd) (FillSubVectorAtLeasOneRead.left opAdd) (FillSubVectorAtLeasOneRead.right opAdd)

src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs

@@ -92,7 +92,7 @@ module SparseVector =
             let length = allIndices.Length
 
             let allValues =
-                clContext.CreateClArray<'a>(
+                clContext.CreateClArray<'c>(
                     length,
                     hostAccessMode = HostAccessMode.NotAccessible,
                     deviceAccessMode = DeviceAccessMode.ReadWrite,
@@ -183,7 +183,7 @@ module SparseVector =
         let merge = merge clContext workGroupSize
 
         let prepare =
-            preparePositions clContext preparePositionsKernel workGroupSize
+            preparePositions<'a, 'b , 'c> clContext preparePositionsKernel workGroupSize
 
         let setPositions = setPositions clContext workGroupSize
 
@@ -211,10 +211,10 @@ module SparseVector =
               Indices = resultIndices
               Size = max leftVector.Size rightVector.Size }
 
-    let elementWiseAtLeasOne (clContext: ClContext) (opAdd:  Expr<(AtLeastOne<'a,'b> -> 'c option)>) (workGroupSize: int) =
+    let elementWiseAtLeasOne (clContext: ClContext) (opAdd: Expr<AtLeastOne<'a,'b> -> 'c option>) (workGroupSize: int) =
         elementWiseGeneral clContext (ElementwiseConstructor.preparePositionsAtLeastOne opAdd) workGroupSize
 
-    let elementWise (clContext: ClContext) opAdd (workGroupSize: int) =
+    let elementWise (clContext: ClContext) (opAdd: Expr<'a option ->'b option -> 'c option>) (workGroupSize: int) =
         elementWiseGeneral clContext (ElementwiseConstructor.preparePositions opAdd) workGroupSize
 
     let private preparePositionsFillSubVector<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct>

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

@@ -95,66 +95,69 @@ module Vector =
                 ClVectorDense <| toDense processor vector
 
     let elementWiseAtLeastOne (clContext: ClContext) (opAdd: Expr<AtLeastOne<'a, 'b> -> 'c option>) workGroupSize =
-        let addCoo =
-            SparseVector.elementWiseAtLeasOne clContext opAdd workGroupSize //TODO()
+        let addSparse =
+            SparseVector.elementWiseAtLeasOne clContext opAdd workGroupSize
 
         let addDense =
             DenseVector.elementWiseAtLeastOne clContext opAdd workGroupSize
 
         fun (processor: MailboxProcessor<_>) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) ->
             match leftVector, rightVector with
-            | ClVectorSparse left, ClVectorSparse right -> ClVectorSparse <| addCoo processor left right
+            | ClVectorSparse left, ClVectorSparse right -> ClVectorSparse <| addSparse processor left right
             | ClVectorDense left, ClVectorDense right -> ClVectorDense <| addDense processor left right
             | _ -> failwith "Vector formats are not matching."
 
     let elementWise (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) (workGroupSize: int) =
         let addDense = DenseVector.elementWise clContext opAdd workGroupSize
 
+        let addSparse = SparseVector.elementWise clContext opAdd workGroupSize
+
         fun (processor: MailboxProcessor<_>) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) ->
             match leftVector, rightVector with
-            | ClVectorDense leftVector, ClVectorDense rightVector -> addDense processor leftVector rightVector
+            | ClVectorDense leftVector, ClVectorDense rightVector -> ClVectorDense <| addDense processor leftVector rightVector
+            | ClVectorSparse left, ClVectorSparse right -> ClVectorSparse <| addSparse processor left right
             | _ -> failwith "Vector formats are not matching."
 
-    let fillSubVector (clContext: ClContext) mask (workGroupSize: int) =
-        let cooFillVector =
-            SparseVector.fillSubVector clContext mask workGroupSize
+    let fillSubVector (clContext: ClContext) maskOp (workGroupSize: int) =
+        let sparseFillVector =
+            SparseVector.fillSubVector clContext maskOp workGroupSize
 
         let denseFillVector =
-            DenseVector.fillSubVector clContext mask workGroupSize
+            DenseVector.fillSubVector clContext maskOp workGroupSize
 
-        let toCooVector =
+        let toSparseVector =
             DenseVector.toSparse clContext workGroupSize
 
-        let toCooMask =
+        let toSparseMask =
             DenseVector.toSparse clContext workGroupSize
 
         fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) (maskVector: ClVector<'b>) (value: ClCell<'a>) ->
             match vector, maskVector with
             | ClVectorSparse vector, ClVectorSparse mask ->
                 ClVectorSparse
-                <| cooFillVector processor vector mask value
+                <| sparseFillVector processor vector mask value
             | ClVectorSparse vector, ClVectorDense mask ->
-                let mask = toCooMask processor mask
+                let mask = toSparseMask processor mask
 
                 ClVectorSparse
-                <| cooFillVector processor vector mask value
+                <| sparseFillVector processor vector mask value
             | ClVectorDense vector, ClVectorSparse mask ->
-                let vector = toCooVector processor vector
+                let vector = toSparseVector processor vector
 
                 ClVectorSparse
-                <| cooFillVector processor vector mask value
+                <| sparseFillVector processor vector mask value
             | ClVectorDense vector, ClVectorDense mask ->
                 ClVectorDense
                 <| denseFillVector processor vector mask value
 
     let reduce (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) =
-        let cooReduce =
+        let sparseReduce =
             SparseVector.reduce clContext workGroupSize opAdd
 
         let denseReduce =
             DenseVector.reduce clContext workGroupSize opAdd
 
         fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) ->
             match vector with
-            | ClVectorSparse vector -> cooReduce processor vector
+            | ClVectorSparse vector -> sparseReduce processor vector
             | ClVectorDense vector -> denseReduce processor vector