0 people like it.
Like the snippet!

Immunity

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
65: 
66: 
67: 
68: 
69: 
70: 
71: 
72: 
73: 
74: 
75: 
76: 
77:

let ``BlockingCollection should block if empty``() =
    par {
        let col = new BlockingCollection<int>()
        let ctx = new ParContext()
        do! ctx.ChangeTo 0
        col.Add 1
        do! ctx.ChangeTo 1
        assert(col.Take() = 1)
        do! ctx.ChangeToAfterBlocked 0 (fun() -> assert(col.Take() = 2))
        col.Add 2
    }





// Teh source... nicht wirklich interessant oder lesbar

open System
open System.Threading
open System.Collections.Generic
open System.Collections.Concurrent

type ParThread(name) =
    let conts = new BlockingCollection<unit -> unit>()
    let thread = Thread(fun() ->
        let rec loop() =
            match conts.TryTake(millisecondsTimeout = -1) with
            | (true,cont) -> cont(); loop()
            | _ -> ()
        loop()
    )
    do
        thread.Name <- name
        thread.Start()
    member x.Run cont = conts.Add cont
    member x.IsBlocked = thread.ThreadState = ThreadState.WaitSleepJoin

type ParContext() =
    let threads = Dictionary<int, ParThread>()
    member x.ChangeTo n =
        match threads.TryGetValue n with
        | (true,t) -> t
        | _ ->
            let t = ParThread(n.ToString())
            threads.Add(n,t)
            t
    member x.ChangeToAfterBlocked n blocker = x.ChangeTo n, blocker
        
type ParBuilder() =
    let mutable current : ParThread option = None
    member x.Bind(thread : ParThread, cont) =
        current <- Some thread
        thread.Run cont
    member x.Bind((thread : ParThread, blocker: unit -> unit), cont) =
        ThreadPool.QueueUserWorkItem(fun _ ->
            let current = Option.get current
            current.Run blocker
            while not current.IsBlocked do
                Thread.Sleep 100
            x.Bind(thread, cont)
        ) |> ignore
    member x.Zero() = ()

let par = ParBuilder()

let ``BlockingCollection should block if empty``() =
    par {
        let col = new BlockingCollection<int>()
        let ctx = new ParContext()
        do! ctx.ChangeTo 0
        col.Add 1
        do! ctx.ChangeTo 1
        assert(col.Take() = 1)
        do! ctx.ChangeToAfterBlocked 0 (fun() -> assert(col.Take() = 2))
        col.Add 2
    }

val ( BlockingCollection should block if empty ) : unit -> 'a

Full name: Script.( BlockingCollection should block if empty )

Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>

namespace System

namespace System.Threading

namespace System.Collections

namespace System.Collections.Generic

namespace System.Collections.Concurrent

Multiple items
type ParThread =
  new : name:string -> ParThread
  member Run : cont:(unit -> unit) -> unit
  member IsBlocked : bool

Full name: Script.ParThread

--------------------
new : name:string -> ParThread

val name : string

val conts : BlockingCollection<(unit -> unit)>

Multiple items
type BlockingCollection<'T> =
  new : unit -> BlockingCollection<'T> + 3 overloads
  member Add : item:'T -> unit + 1 overload
  member BoundedCapacity : int
  member CompleteAdding : unit -> unit
  member CopyTo : array:'T[] * index:int -> unit
  member Count : int
  member Dispose : unit -> unit
  member GetConsumingEnumerable : unit -> IEnumerable<'T> + 1 overload
  member IsAddingCompleted : bool
  member IsCompleted : bool
  ...

Full name: System.Collections.Concurrent.BlockingCollection<_>

--------------------
BlockingCollection() : unit
BlockingCollection(boundedCapacity: int) : unit
BlockingCollection(collection: IProducerConsumerCollection<'T>) : unit
BlockingCollection(collection: IProducerConsumerCollection<'T>, boundedCapacity: int) : unit

type unit = Unit

Full name: Microsoft.FSharp.Core.unit

val thread : Thread

Multiple items
type Thread =
  inherit CriticalFinalizerObject
  new : start:ThreadStart -> Thread + 3 overloads
  member Abort : unit -> unit + 1 overload
  member ApartmentState : ApartmentState with get, set
  member CurrentCulture : CultureInfo with get, set
  member CurrentUICulture : CultureInfo with get, set
  member DisableComObjectEagerCleanup : unit -> unit
  member ExecutionContext : ExecutionContext
  member GetApartmentState : unit -> ApartmentState
  member GetCompressedStack : unit -> CompressedStack
  member GetHashCode : unit -> int
  ...

Full name: System.Threading.Thread

--------------------
Thread(start: ThreadStart) : unit
Thread(start: ParameterizedThreadStart) : unit
Thread(start: ThreadStart, maxStackSize: int) : unit
Thread(start: ParameterizedThreadStart, maxStackSize: int) : unit

val loop : (unit -> unit)

BlockingCollection.TryTake(item: byref<(unit -> unit)>) : bool
BlockingCollection.TryTake(item: byref<(unit -> unit)>, millisecondsTimeout: int) : bool
BlockingCollection.TryTake(item: byref<(unit -> unit)>, timeout: TimeSpan) : bool
BlockingCollection.TryTake(item: byref<(unit -> unit)>, millisecondsTimeout: int, cancellationToken: CancellationToken) : bool

val cont : (unit -> unit)

val x : ParThread

member ParThread.Run : cont:(unit -> unit) -> unit

Full name: Script.ParThread.Run

BlockingCollection.Add(item: unit -> unit) : unit
BlockingCollection.Add(item: unit -> unit, cancellationToken: CancellationToken) : unit

member ParThread.IsBlocked : bool

Full name: Script.ParThread.IsBlocked

property Thread.ThreadState: ThreadState

field ThreadState.WaitSleepJoin = 32

Multiple items
type ParContext =
  new : unit -> ParContext
  member ChangeTo : n:int -> ParThread
  member ChangeToAfterBlocked : n:int -> blocker:'a -> ParThread * 'a

Full name: Script.ParContext

--------------------
new : unit -> ParContext

val threads : Dictionary<int,ParThread>

Multiple items
type Dictionary<'TKey,'TValue> =
  new : unit -> Dictionary<'TKey, 'TValue> + 5 overloads
  member Add : key:'TKey * value:'TValue -> unit
  member Clear : unit -> unit
  member Comparer : IEqualityComparer<'TKey>
  member ContainsKey : key:'TKey -> bool
  member ContainsValue : value:'TValue -> bool
  member Count : int
  member GetEnumerator : unit -> Enumerator<'TKey, 'TValue>
  member GetObjectData : info:SerializationInfo * context:StreamingContext -> unit
  member Item : 'TKey -> 'TValue with get, set
  ...
  nested type Enumerator
  nested type KeyCollection
  nested type ValueCollection

Full name: System.Collections.Generic.Dictionary<_,_>

--------------------
Dictionary() : unit
Dictionary(capacity: int) : unit
Dictionary(comparer: IEqualityComparer<'TKey>) : unit
Dictionary(dictionary: IDictionary<'TKey,'TValue>) : unit
Dictionary(capacity: int, comparer: IEqualityComparer<'TKey>) : unit
Dictionary(dictionary: IDictionary<'TKey,'TValue>, comparer: IEqualityComparer<'TKey>) : unit

val x : ParContext

member ParContext.ChangeTo : n:int -> ParThread

Full name: Script.ParContext.ChangeTo

val n : int

Dictionary.TryGetValue(key: int, value: byref<ParThread>) : bool

val t : ParThread

Int32.ToString() : string
Int32.ToString(provider: IFormatProvider) : string
Int32.ToString(format: string) : string
Int32.ToString(format: string, provider: IFormatProvider) : string

Dictionary.Add(key: int, value: ParThread) : unit

member ParContext.ChangeToAfterBlocked : n:int -> blocker:'a -> ParThread * 'a

Full name: Script.ParContext.ChangeToAfterBlocked

val blocker : 'a

member ParContext.ChangeTo : n:int -> ParThread

Multiple items
type ParBuilder =
  new : unit -> ParBuilder
  member Bind : thread:ParThread * cont:(unit -> unit) -> unit
  member Bind : (ParThread * (unit -> unit)) * cont:(unit -> unit) -> unit
  member Zero : unit -> unit

Full name: Script.ParBuilder

--------------------
new : unit -> ParBuilder

val mutable current : ParThread option

type 'T option = Option<'T>

Full name: Microsoft.FSharp.Core.option<_>

union case Option.None: Option<'T>

val x : ParBuilder

member ParBuilder.Bind : thread:ParThread * cont:(unit -> unit) -> unit

Full name: Script.ParBuilder.Bind

val thread : ParThread

union case Option.Some: Value: 'T -> Option<'T>

member ParThread.Run : cont:(unit -> unit) -> unit

member ParBuilder.Bind : (ParThread * (unit -> unit)) * cont:(unit -> unit) -> unit

Full name: Script.ParBuilder.Bind

val blocker : (unit -> unit)

type ThreadPool =
  static member BindHandle : osHandle:nativeint -> bool + 1 overload
  static member GetAvailableThreads : workerThreads:int * completionPortThreads:int -> unit
  static member GetMaxThreads : workerThreads:int * completionPortThreads:int -> unit
  static member GetMinThreads : workerThreads:int * completionPortThreads:int -> unit
  static member QueueUserWorkItem : callBack:WaitCallback -> bool + 1 overload
  static member RegisterWaitForSingleObject : waitObject:WaitHandle * callBack:WaitOrTimerCallback * state:obj * millisecondsTimeOutInterval:uint32 * executeOnlyOnce:bool -> RegisteredWaitHandle + 3 overloads
  static member SetMaxThreads : workerThreads:int * completionPortThreads:int -> bool
  static member SetMinThreads : workerThreads:int * completionPortThreads:int -> bool
  static member UnsafeQueueNativeOverlapped : overlapped:NativeOverlapped -> bool
  static member UnsafeQueueUserWorkItem : callBack:WaitCallback * state:obj -> bool
  ...

Full name: System.Threading.ThreadPool

ThreadPool.QueueUserWorkItem(callBack: WaitCallback) : bool
ThreadPool.QueueUserWorkItem(callBack: WaitCallback, state: obj) : bool

val current : ParThread

module Option

from Microsoft.FSharp.Core

val get : option:'T option -> 'T

Full name: Microsoft.FSharp.Core.Option.get

val not : value:bool -> bool

Full name: Microsoft.FSharp.Core.Operators.not

property ParThread.IsBlocked: bool

Thread.Sleep(timeout: TimeSpan) : unit
Thread.Sleep(millisecondsTimeout: int) : unit

member ParBuilder.Bind : thread:ParThread * cont:(unit -> unit) -> unit
member ParBuilder.Bind : (ParThread * (unit -> unit)) * cont:(unit -> unit) -> unit

val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore

member ParBuilder.Zero : unit -> unit

Full name: Script.ParBuilder.Zero

val par : ParBuilder

Full name: Script.par

Multiple items
val ( BlockingCollection should block if empty ) : unit -> unit

Full name: Script.( BlockingCollection should block if empty )

--------------------
val ( BlockingCollection should block if empty ) : unit -> 'a

Full name: Script.( BlockingCollection should block if empty )

val col : BlockingCollection<int>

val ctx : ParContext

BlockingCollection.Add(item: int) : unit
BlockingCollection.Add(item: int, cancellationToken: CancellationToken) : unit

BlockingCollection.Take() : int
BlockingCollection.Take(cancellationToken: CancellationToken) : int

member ParContext.ChangeToAfterBlocked : n:int -> blocker:'a -> ParThread * 'a

Raw view Test code New version

More information

Link:	http://fssnip.net/42
Posted:	15 years ago
Author:
Tags: