Skip to content

Commit 617c402

Browse files
gsvgitgsvgit
authored
Merge pull request #48 from IgorErin/vector
Vector
2 parents 4199c68 + 72a6c5a commit 617c402

24 files changed

Lines changed: 2543 additions & 78 deletions

‎src/GraphBLAS-sharp.Backend/Common/CommonQuotes.fs‎

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,23 @@ module SubSum =
3636

3737
let treeSum<'a> opAdd = sumGeneral<'a> <| treeAccess<'a> opAdd
3838

39+
module SubReduce =
40+
let run opAdd =
41+
<@ fun length wgSize gid lid (localValues: 'a []) ->
42+
let mutable step = 2
43+
44+
while step <= wgSize do
45+
if (gid + wgSize / step) < length
46+
&& lid < wgSize / step then
47+
let firstValue = localValues.[lid]
48+
let secondValue = localValues.[lid + wgSize / step]
49+
50+
localValues.[lid] <- (%opAdd) firstValue secondValue
51+
52+
step <- step <<< 1
53+
54+
barrierLocal () @>
55+
3956
module PreparePositions =
4057
let both<'c> =
4158
<@ fun index (result: 'c option) (rawPositionsBuffer: ClArray<int>) (allValuesBuffer: ClArray<'c>) ->

‎src/GraphBLAS-sharp.Backend/Common/Reduce.fs‎

Lines changed: 144 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,144 @@
1+
namespace GraphBLAS.FSharp.Backend.Common
2+
3+
open Brahma.FSharp
4+
open GraphBLAS.FSharp.Backend
5+
open Microsoft.FSharp.Control
6+
open Microsoft.FSharp.Quotations
7+
8+
module Reduce =
9+
let private scan<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) =
10+
11+
let scan =
12+
<@ fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (resultArray: ClArray<'a>) ->
13+
14+
let gid = ndRange.GlobalID0
15+
let lid = ndRange.LocalID0
16+
17+
let localValues = localArray<'a> workGroupSize
18+
19+
if gid < length then
20+
localValues.[lid] <- inputArray.[gid]
21+
22+
barrierLocal ()
23+
24+
if gid < length then
25+
26+
(%SubReduce.run opAdd) length workGroupSize gid lid localValues
27+
28+
if lid = 0 then
29+
resultArray.[gid / workGroupSize] <- localValues.[0] @>
30+
31+
let kernel = clContext.Compile(scan)
32+
33+
fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) valuesLength (resultArray: ClArray<'a>) ->
34+
35+
let ndRange =
36+
Range1D.CreateValid(valuesArray.Length, workGroupSize)
37+
38+
let kernel = kernel.GetKernel()
39+
40+
processor.Post(
41+
Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange valuesLength valuesArray resultArray)
42+
)
43+
44+
processor.Post(Msg.CreateRunMsg<_, _>(kernel))
45+
46+
let private scanToCell<'a when 'a: struct>
47+
(clContext: ClContext)
48+
(workGroupSize: int)
49+
(opAdd: Expr<'a -> 'a -> 'a>)
50+
=
51+
52+
let scan =
53+
<@ fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (resultValue: ClCell<'a>) ->
54+
55+
let gid = ndRange.GlobalID0
56+
let lid = ndRange.LocalID0
57+
58+
let localValues = localArray<'a> workGroupSize
59+
60+
if gid < length then
61+
localValues.[lid] <- inputArray.[gid]
62+
63+
barrierLocal ()
64+
65+
if gid < length then
66+
67+
(%SubReduce.run opAdd) length workGroupSize gid lid localValues
68+
69+
if lid = 0 then
70+
resultValue.Value <- localValues.[0] @>
71+
72+
let kernel = clContext.Compile(scan)
73+
74+
fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) valuesLength (resultValue: ClCell<'a>) ->
75+
76+
let ndRange =
77+
Range1D.CreateValid(valuesArray.Length, workGroupSize)
78+
79+
let kernel = kernel.GetKernel()
80+
81+
processor.Post(
82+
Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange valuesLength valuesArray resultValue)
83+
)
84+
85+
processor.Post(Msg.CreateRunMsg<_, _>(kernel))
86+
87+
let run<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) =
88+
89+
let scan = scan clContext workGroupSize opAdd
90+
91+
let scanToCell = scanToCell clContext workGroupSize opAdd
92+
93+
fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) ->
94+
95+
let scan = scan processor
96+
97+
let firstLength =
98+
(inputArray.Length - 1) / workGroupSize + 1
99+
100+
let firstVerticesArray =
101+
clContext.CreateClArray(
102+
firstLength,
103+
hostAccessMode = HostAccessMode.NotAccessible,
104+
deviceAccessMode = DeviceAccessMode.ReadWrite,
105+
allocationMode = AllocationMode.Default
106+
)
107+
108+
let secondLength = (firstLength - 1) / workGroupSize + 1
109+
110+
let secondVerticesArray =
111+
clContext.CreateClArray(
112+
secondLength,
113+
hostAccessMode = HostAccessMode.NotAccessible,
114+
deviceAccessMode = DeviceAccessMode.ReadWrite,
115+
allocationMode = AllocationMode.Default
116+
)
117+
118+
let mutable verticesArrays = firstVerticesArray, secondVerticesArray
119+
let swap (a, b) = (b, a)
120+
121+
scan inputArray inputArray.Length (fst verticesArrays)
122+
123+
let mutable verticesLength = firstLength
124+
125+
while verticesLength > workGroupSize do
126+
let fstVertices = fst verticesArrays
127+
let sndVertices = snd verticesArrays
128+
129+
scan fstVertices verticesLength sndVertices
130+
131+
verticesArrays <- swap verticesArrays
132+
verticesLength <- (verticesLength - 1) / workGroupSize + 1
133+
134+
let fstVertices = fst verticesArrays
135+
136+
let result =
137+
clContext.CreateClCell Unchecked.defaultof<'a>
138+
139+
scanToCell processor fstVertices verticesLength result
140+
141+
processor.Post(Msg.CreateFreeMsg(firstVerticesArray))
142+
processor.Post(Msg.CreateFreeMsg(secondVerticesArray))
143+
144+
result

‎src/GraphBLAS-sharp.Backend/Common/StandardOperations.fs‎

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
namespace GraphBLAS.FSharp.Backend.Common
22

3+
open FSharp.Quotations
4+
35
type AtLeastOne<'a, 'b when 'a: struct and 'b: struct> =
46
| Both of 'a * 'b
57
| Left of 'a
@@ -109,3 +111,33 @@ module StandardOperations =
109111
| None, Some right -> (%op) (Right right)
110112
| Some left, None -> (%op) (Left left)
111113
| None, None -> None @>
114+
115+
let fillSubToOption (op: Expr<'a option -> 'a option -> 'a option>) =
116+
<@ fun (leftItem: 'a option) (rightItem: 'b option) (value: 'a) ->
117+
match rightItem with
118+
| Some _ -> (%op) leftItem (Some value)
119+
| None -> (%op) leftItem None @>
120+
121+
let fillSubComplementedToOption (op: Expr<'a option -> 'a option -> 'a option>) =
122+
<@ fun (leftItem: 'a option) (rightItem: 'b option) (value: 'a) ->
123+
match rightItem with
124+
| Some _ -> (%op) leftItem None
125+
| None -> (%op) leftItem (Some value) @>
126+
127+
let fillSubOp<'a when 'a: struct> =
128+
<@ fun (left: 'a option) (right: 'a option) ->
129+
match left, right with
130+
| _, None -> left
131+
| _ -> right @>
132+
133+
let maskOp<'a, 'b when 'a: struct and 'b: struct> =
134+
<@ fun (left: 'a option) (right: 'b option) ->
135+
match right with
136+
| Some _ -> left
137+
| _ -> None @>
138+
139+
let complementedMaskOp<'a, 'b when 'a: struct and 'b: struct> =
140+
<@ fun (left: 'a option) (right: 'b option) ->
141+
match right with
142+
| None -> left
143+
| _ -> None @>

‎src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@
1919
<Compile Include="Common/BitonicSort.fs" />
2020
<Compile Include="Common/Scatter.fs" />
2121
<Compile Include="Common/StandardOperations.fs" />
22+
<Compile Include="Common/Reduce.fs" />
2223
<Compile Include="Predefined/PrefixSum.fs" />
2324
<!--Compile Include="Matrices.fs" /-->
2425
<Compile Include="Masks.fs" />
@@ -32,6 +33,10 @@
3233
<Compile Include="Matrix/CSRMatrix/CSRMatrix.fs" />
3334
<Compile Include="Matrix/CSRMatrix/CSRMatrix.fs" />
3435
<Compile Include="Matrix/Matrix.fs" />
36+
<Compile Include="Vector/SparseVector/SparseElementwise.fs" />
37+
<Compile Include="Vector/SparseVector/SparseVector.fs" />
38+
<Compile Include="Vector/DenseVector/DenseVector.fs" />
39+
<Compile Include="Vector/Vector.fs" />
3540
<Compile Include="Vector/SpMV.fs" />
3641
<!--Compile Include="Backend/CSRMatrix/GetTuples.fs" /-->
3742
<!--Compile Include="Backend/CSRMatrix/SpMSpV.fs" /-->

0 commit comments

Comments
 (0)