Skip to content

Commit 3ceb397

Browse files
kirillgarbarkirillgarbar
committed
Move Map and Bitmap methods to separate modules to ease dependencies
1 parent 90a1efe commit 3ceb397

12 files changed

Lines changed: 208 additions & 195 deletions

File tree

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

Lines changed: 80 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,80 @@
1+
namespace GraphBLAS.FSharp.Backend.Common
2+
3+
open Brahma.FSharp
4+
open GraphBLAS.FSharp.Backend.Objects.ClContext
5+
open GraphBLAS.FSharp.Backend.Quotes
6+
open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions
7+
8+
module Bitmap =
9+
let private getUniqueBitmapGeneral predicate (clContext: ClContext) workGroupSize =
10+
11+
let getUniqueBitmap =
12+
<@ fun (ndRange: Range1D) (inputArray: ClArray<'a>) inputLength (isUniqueBitmap: ClArray<int>) ->
13+
14+
let gid = ndRange.GlobalID0
15+
16+
if gid < inputLength then
17+
let isUnique = (%predicate) gid inputLength inputArray // brahma error
18+
19+
if isUnique then
20+
isUniqueBitmap.[gid] <- 1
21+
else
22+
isUniqueBitmap.[gid] <- 0 @>
23+
24+
let kernel = clContext.Compile(getUniqueBitmap)
25+
26+
fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) ->
27+
28+
let inputLength = inputArray.Length
29+
30+
let ndRange =
31+
Range1D.CreateValid(inputLength, workGroupSize)
32+
33+
let bitmap =
34+
clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputLength)
35+
36+
let kernel = kernel.GetKernel()
37+
38+
processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray inputLength bitmap))
39+
40+
processor.Post(Msg.CreateRunMsg<_, _> kernel)
41+
42+
bitmap
43+
44+
let firstOccurrence clContext =
45+
getUniqueBitmapGeneral
46+
<| Predicates.firstOccurrence ()
47+
<| clContext
48+
49+
let lastOccurrence clContext =
50+
getUniqueBitmapGeneral
51+
<| Predicates.lastOccurrence ()
52+
<| clContext
53+
54+
let private getUniqueBitmap2General<'a when 'a: equality> getUniqueBitmap (clContext: ClContext) workGroupSize =
55+
56+
let map =
57+
Map.map2 <@ fun x y -> x ||| y @> clContext workGroupSize
58+
59+
let firstGetBitmap = getUniqueBitmap clContext workGroupSize
60+
61+
fun (processor: MailboxProcessor<_>) allocationMode (firstArray: ClArray<'a>) (secondArray: ClArray<'a>) ->
62+
let firstBitmap =
63+
firstGetBitmap processor DeviceOnly firstArray
64+
65+
let secondBitmap =
66+
firstGetBitmap processor DeviceOnly secondArray
67+
68+
let result =
69+
map processor allocationMode firstBitmap secondBitmap
70+
71+
firstBitmap.Free processor
72+
secondBitmap.Free processor
73+
74+
result
75+
76+
let firstOccurrence2 clContext =
77+
getUniqueBitmap2General firstOccurrence clContext
78+
79+
let lastOccurrence2 clContext =
80+
getUniqueBitmap2General lastOccurrence clContext

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

Lines changed: 4 additions & 180 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,11 @@
11
namespace GraphBLAS.FSharp.Backend.Common
22

3-
open System.Collections.Generic
43
open Brahma.FSharp
54
open Microsoft.FSharp.Quotations
65
open GraphBLAS.FSharp.Backend.Objects.ClContext
76
open GraphBLAS.FSharp.Backend.Objects.ClCell
87
open GraphBLAS.FSharp.Backend.Quotes
98
open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions
10-
open GraphBLAS.FSharp.Backend.Quotes
119

1210
module ClArray =
1311
let init (initializer: Expr<int -> 'a>) (clContext: ClContext) workGroupSize =
@@ -132,180 +130,6 @@ module ClArray =
132130

133131
outputArray
134132

135-
let map<'a, 'b> (op: Expr<'a -> 'b>) (clContext: ClContext) workGroupSize =
136-
137-
let map =
138-
<@ fun (ndRange: Range1D) lenght (inputArray: ClArray<'a>) (result: ClArray<'b>) ->
139-
140-
let gid = ndRange.GlobalID0
141-
142-
if gid < lenght then
143-
result.[gid] <- (%op) inputArray.[gid] @>
144-
145-
let kernel = clContext.Compile map
146-
147-
fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) ->
148-
149-
let result =
150-
clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputArray.Length)
151-
152-
let ndRange =
153-
Range1D.CreateValid(inputArray.Length, workGroupSize)
154-
155-
let kernel = kernel.GetKernel()
156-
157-
processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray.Length inputArray result))
158-
159-
processor.Post(Msg.CreateRunMsg<_, _>(kernel))
160-
161-
result
162-
163-
let mapWithValue<'a, 'b, 'c> (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b -> 'c>) =
164-
165-
let map =
166-
<@ fun (ndRange: Range1D) lenght (value: ClCell<'a>) (inputArray: ClArray<'b>) (result: ClArray<'c>) ->
167-
168-
let gid = ndRange.GlobalID0
169-
170-
if gid < lenght then
171-
result.[gid] <- (%op) value.Value inputArray.[gid] @>
172-
173-
let kernel = clContext.Compile map
174-
175-
fun (processor: MailboxProcessor<_>) allocationMode (value: 'a) (inputArray: ClArray<'b>) ->
176-
177-
let result =
178-
clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputArray.Length)
179-
180-
let valueClCell = value |> clContext.CreateClCell
181-
182-
let ndRange =
183-
Range1D.CreateValid(inputArray.Length, workGroupSize)
184-
185-
let kernel = kernel.GetKernel()
186-
187-
processor.Post(
188-
Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray.Length valueClCell inputArray result)
189-
)
190-
191-
processor.Post(Msg.CreateRunMsg<_, _>(kernel))
192-
193-
result
194-
195-
let map2InPlace<'a, 'b, 'c> (map: Expr<'a -> 'b -> 'c>) (clContext: ClContext) workGroupSize =
196-
197-
let kernel =
198-
<@ fun (ndRange: Range1D) length (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) (resultArray: ClArray<'c>) ->
199-
200-
let gid = ndRange.GlobalID0
201-
202-
if gid < length then
203-
204-
resultArray.[gid] <- (%map) leftArray.[gid] rightArray.[gid] @>
205-
206-
let kernel = clContext.Compile kernel
207-
208-
fun (processor: MailboxProcessor<_>) (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) (resultArray: ClArray<'c>) ->
209-
210-
let ndRange =
211-
Range1D.CreateValid(resultArray.Length, workGroupSize)
212-
213-
let kernel = kernel.GetKernel()
214-
215-
processor.Post(
216-
Msg.MsgSetArguments
217-
(fun () -> kernel.KernelFunc ndRange resultArray.Length leftArray rightArray resultArray)
218-
)
219-
220-
processor.Post(Msg.CreateRunMsg<_, _>(kernel))
221-
222-
let map2<'a, 'b, 'c> map (clContext: ClContext) workGroupSize =
223-
let map2 =
224-
map2InPlace<'a, 'b, 'c> map clContext workGroupSize
225-
226-
fun (processor: MailboxProcessor<_>) allocationMode (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) ->
227-
228-
let resultArray =
229-
clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, leftArray.Length)
230-
231-
map2 processor leftArray rightArray resultArray
232-
233-
resultArray
234-
235-
module Bitmap =
236-
let private getUniqueBitmapGeneral predicate (clContext: ClContext) workGroupSize =
237-
238-
let getUniqueBitmap =
239-
<@ fun (ndRange: Range1D) (inputArray: ClArray<'a>) inputLength (isUniqueBitmap: ClArray<int>) ->
240-
241-
let gid = ndRange.GlobalID0
242-
243-
if gid < inputLength then
244-
let isUnique = (%predicate) gid inputLength inputArray // brahma error
245-
246-
if isUnique then
247-
isUniqueBitmap.[gid] <- 1
248-
else
249-
isUniqueBitmap.[gid] <- 0 @>
250-
251-
let kernel = clContext.Compile(getUniqueBitmap)
252-
253-
fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) ->
254-
255-
let inputLength = inputArray.Length
256-
257-
let ndRange =
258-
Range1D.CreateValid(inputLength, workGroupSize)
259-
260-
let bitmap =
261-
clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputLength)
262-
263-
let kernel = kernel.GetKernel()
264-
265-
processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray inputLength bitmap))
266-
267-
processor.Post(Msg.CreateRunMsg<_, _> kernel)
268-
269-
bitmap
270-
271-
let firstOccurrence clContext =
272-
getUniqueBitmapGeneral
273-
<| Predicates.firstOccurrence ()
274-
<| clContext
275-
276-
let lastOccurrence clContext =
277-
getUniqueBitmapGeneral
278-
<| Predicates.lastOccurrence ()
279-
<| clContext
280-
281-
let private getUniqueBitmap2General<'a when 'a: equality> getUniqueBitmap (clContext: ClContext) workGroupSize =
282-
283-
let map =
284-
map2 <@ fun x y -> x ||| y @> clContext workGroupSize
285-
286-
let firstGetBitmap = getUniqueBitmap clContext workGroupSize
287-
288-
fun (processor: MailboxProcessor<_>) allocationMode (firstArray: ClArray<'a>) (secondArray: ClArray<'a>) ->
289-
let firstBitmap =
290-
firstGetBitmap processor DeviceOnly firstArray
291-
292-
let secondBitmap =
293-
firstGetBitmap processor DeviceOnly secondArray
294-
295-
let result =
296-
map processor allocationMode firstBitmap secondBitmap
297-
298-
firstBitmap.Free processor
299-
secondBitmap.Free processor
300-
301-
result
302-
303-
let firstOccurrence2 clContext =
304-
getUniqueBitmap2General firstOccurrence clContext
305-
306-
let lastOccurrence2 clContext =
307-
getUniqueBitmap2General lastOccurrence clContext
308-
309133
///<description>Remove duplicates form the given array.</description>
310134
///<param name="clContext">Computational context</param>
311135
///<param name="workGroupSize">Should be a power of 2 and greater than 1.</param>
@@ -406,7 +230,7 @@ module ClArray =
406230

407231
let choose<'a, 'b> (predicate: Expr<'a -> 'b option>) (clContext: ClContext) workGroupSize =
408232
let getBitmap =
409-
map<'a, int> (Map.chooseBitmap predicate) clContext workGroupSize
233+
Map.map<'a, int> (Map.chooseBitmap predicate) clContext workGroupSize
410234

411235
let prefixSum =
412236
PrefixSum.standardExcludeInPlace clContext workGroupSize
@@ -486,7 +310,7 @@ module ClArray =
486310

487311
let choose2 (predicate: Expr<'a -> 'b -> 'c option>) (clContext: ClContext) workGroupSize =
488312
let getBitmap =
489-
map2<'a, 'b, int> (Map.choose2Bitmap predicate) clContext workGroupSize
313+
Map.map2<'a, 'b, int> (Map.choose2Bitmap predicate) clContext workGroupSize
490314

491315
let prefixSum =
492316
PrefixSum.standardExcludeInPlace clContext workGroupSize
@@ -702,7 +526,7 @@ module ClArray =
702526
Gather.runInit Map.inc clContext workGroupSize
703527

704528
let map =
705-
map2 <@ fun first second -> (first, second) @> clContext workGroupSize
529+
Map.map2 <@ fun first second -> (first, second) @> clContext workGroupSize
706530

707531
fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) ->
708532
if values.Length > 1 then
@@ -826,7 +650,7 @@ module ClArray =
826650
PrefixSum.standardExcludeInPlace clContext workGroupSize
827651

828652
let getBitmap =
829-
map<'a, int> (Map.predicateBitmap predicate) clContext workGroupSize
653+
Map.map<'a, int> (Map.predicateBitmap predicate) clContext workGroupSize
830654

831655
fun (processor: MailboxProcessor<_>) (array: ClArray<'a>) ->
832656

0 commit comments

Comments
 (0)