├── .gitattributes
├── .gitignore
├── .travis.yml
├── FsExamples
├── App.config
├── DragAndDropWinForms.fsx
└── FsExamples.fsproj
├── README.md
├── TODO
├── appveyor.yml
├── evReact.sln
├── lib
└── evReact.dll.nuspec
├── packages
└── repositories.config
├── src
├── evReact.fsproj
├── evreact.fs
├── evreact.fsi
├── utils.fs
└── utils.fsi
├── test
├── bugs.fs
├── empty.fs
├── examples.fs
├── packages.config
├── serialize.fs
├── simple.fs
├── simpleAA.fs
├── simpleAB.fs
├── simpleEpsilon.fs
├── test.fsproj
└── utils.fs
└── typescript
├── Makefile
├── evreact.ts
└── test.ts
/.gitattributes:
--------------------------------------------------------------------------------
1 | ###############################################################################
2 | # Set default behavior to automatically normalize line endings.
3 | ###############################################################################
4 | * text=auto
5 |
6 | ###############################################################################
7 | # Set default behavior for command prompt diff.
8 | #
9 | # This is need for earlier builds of msysgit that does not have it on by
10 | # default for csharp files.
11 | # Note: This is only used by command line
12 | ###############################################################################
13 | #*.cs diff=csharp
14 |
15 | ###############################################################################
16 | # Set the merge driver for project and solution files
17 | #
18 | # Merging from the command prompt will add diff markers to the files if there
19 | # are conflicts (Merging from VS is not affected by the settings below, in VS
20 | # the diff markers are never inserted). Diff markers may cause the following
21 | # file extensions to fail to load in VS. An alternative would be to treat
22 | # these files as binary and thus will always conflict and require user
23 | # intervention with every merge. To do so, just uncomment the entries below
24 | ###############################################################################
25 | #*.sln merge=binary
26 | #*.csproj merge=binary
27 | #*.vbproj merge=binary
28 | #*.vcxproj merge=binary
29 | #*.vcproj merge=binary
30 | #*.dbproj merge=binary
31 | #*.fsproj merge=binary
32 | #*.lsproj merge=binary
33 | #*.wixproj merge=binary
34 | #*.modelproj merge=binary
35 | #*.sqlproj merge=binary
36 | #*.wwaproj merge=binary
37 |
38 | ###############################################################################
39 | # behavior for image files
40 | #
41 | # image files are treated as binary by default.
42 | ###############################################################################
43 | #*.jpg binary
44 | #*.png binary
45 | #*.gif binary
46 |
47 | ###############################################################################
48 | # diff behavior for common document formats
49 | #
50 | # Convert binary document formats to text before diffing them. This feature
51 | # is only available from the command line. Turn it on by uncommenting the
52 | # entries below.
53 | ###############################################################################
54 | #*.doc diff=astextplain
55 | #*.DOC diff=astextplain
56 | #*.docx diff=astextplain
57 | #*.DOCX diff=astextplain
58 | #*.dot diff=astextplain
59 | #*.DOT diff=astextplain
60 | #*.pdf diff=astextplain
61 | #*.PDF diff=astextplain
62 | #*.rtf diff=astextplain
63 | #*.RTF diff=astextplain
64 |
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | *~
2 | */bin
3 | */obj
4 | *.suo
5 | packages/*
6 | lib/*.dll
7 | lib/*.xml
8 | lib/*.pdb
9 | typescript/*.js
10 |
--------------------------------------------------------------------------------
/.travis.yml:
--------------------------------------------------------------------------------
1 | sudo: false
2 | language: csharp
3 | solution: evReact.sln
4 | mono:
5 | - nightly
6 | - latest
7 | - 3.12.0
8 | env:
9 | - CFG=Debug
10 | - CFG=Release
11 | script:
12 | - xbuild /p:Configuration=$CFG evReact.sln
13 | - mono ./packages/NUnit.Runners.*/tools/nunit-console.exe ./test/bin/$CFG/net40/test.dll
14 | matrix:
15 | allow_failures:
16 | - mono: nightly
17 | - mono: latest
18 |
--------------------------------------------------------------------------------
/FsExamples/App.config:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
--------------------------------------------------------------------------------
/FsExamples/DragAndDropWinForms.fsx:
--------------------------------------------------------------------------------
1 | #r @"..\lib\evReact.dll"
2 |
3 | open EvReact
4 | open EvReact.Expr
5 | open EvReact.Orchestrator
6 |
7 | open System.Windows.Forms
8 |
9 | let E (e:IEvent<'c,'a>) =
10 | let evt = new Control.Event<'a>()
11 | e.Add(fun e -> evt.Trigger(e))
12 | evt.Publish
13 |
14 | let f = new Form(Text="Drag&Drop test with evReact")
15 |
16 | let md = E f.MouseDown
17 | let mm = E f.MouseMove
18 | let mu = E f.MouseUp
19 |
20 | let net =
21 | +(
22 | (!!md |-> fun e -> printfn "Mouse down @(%d,%d)" e.X e.Y)
23 | - (+(!!mm) |-> fun e -> printfn "Mouse move @(%d,%d)" e.X e.Y) / [|mu|]
24 | - !!mu |-> fun e -> printfn "Mouse up @(%d,%d)" e.X e.Y
25 | )
26 |
27 | let orch = Orchestrator.create()
28 | Expr.start null orch net
29 |
30 | f.Show()
31 |
--------------------------------------------------------------------------------
/FsExamples/FsExamples.fsproj:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 | Debug
6 | AnyCPU
7 | 2.0
8 | 08ef0e77-6201-425f-97eb-13871a5f7c9b
9 | Exe
10 | FsExamples
11 | FsExamples
12 | v4.5
13 | true
14 | 4.3.1.0
15 | FsExamples
16 |
17 |
18 | true
19 | full
20 | false
21 | false
22 | bin\Debug\
23 | DEBUG;TRACE
24 | 3
25 | AnyCPU
26 | bin\Debug\FsExamples.XML
27 | true
28 |
29 |
30 | pdbonly
31 | true
32 | true
33 | bin\Release\
34 | TRACE
35 | 3
36 | AnyCPU
37 | bin\Release\FsExamples.XML
38 | true
39 |
40 |
41 |
42 |
43 | True
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 |
54 | 11
55 |
56 |
57 |
58 |
59 | $(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets
60 |
61 |
62 |
63 |
64 | $(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets
65 |
66 |
67 |
68 |
69 |
76 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # EvReact
2 |
3 | ### A lightweight framework for reactive programming
4 | - [Documentation](http://vslab.github.io/evreact/)
5 | - [NuGet Package](https://www.nuget.org/packages/evReact)
6 |
7 | ### Build Status
8 | | |Linux|Windows|
9 | |--------:|:---:|:-----:|
10 | |**Status**|[](https://travis-ci.org/vslab/evreact)|[](https://ci.appveyor.com/project/ranma42/evreact)|
11 |
--------------------------------------------------------------------------------
/TODO:
--------------------------------------------------------------------------------
1 | Add more documentation and examples
2 | Improve README.md for good-looking repo in github
3 | Expr simplification
4 |
--------------------------------------------------------------------------------
/appveyor.yml:
--------------------------------------------------------------------------------
1 | configuration:
2 | - Debug
3 | - Release
4 | before_build:
5 | - ps: nuget restore
6 |
--------------------------------------------------------------------------------
/evReact.sln:
--------------------------------------------------------------------------------
1 |
2 | Microsoft Visual Studio Solution File, Format Version 12.00
3 | # Visual Studio 2013
4 | VisualStudioVersion = 12.0.30723.0
5 | MinimumVisualStudioVersion = 10.0.40219.1
6 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "evReact", "src\evReact.fsproj", "{20D72B7F-696D-478E-837C-9415C4E20808}"
7 | EndProject
8 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "test", "test\test.fsproj", "{E522C6DA-1E95-4612-A4B5-684C1DECE0B4}"
9 | EndProject
10 | Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FsExamples", "FsExamples\FsExamples.fsproj", "{08EF0E77-6201-425F-97EB-13871A5F7C9B}"
11 | EndProject
12 | Global
13 | GlobalSection(SolutionConfigurationPlatforms) = preSolution
14 | Debug|Any CPU = Debug|Any CPU
15 | Release|Any CPU = Release|Any CPU
16 | EndGlobalSection
17 | GlobalSection(ProjectConfigurationPlatforms) = postSolution
18 | {20D72B7F-696D-478E-837C-9415C4E20808}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
19 | {20D72B7F-696D-478E-837C-9415C4E20808}.Debug|Any CPU.Build.0 = Debug|Any CPU
20 | {20D72B7F-696D-478E-837C-9415C4E20808}.Release|Any CPU.ActiveCfg = Release|Any CPU
21 | {20D72B7F-696D-478E-837C-9415C4E20808}.Release|Any CPU.Build.0 = Release|Any CPU
22 | {E522C6DA-1E95-4612-A4B5-684C1DECE0B4}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
23 | {E522C6DA-1E95-4612-A4B5-684C1DECE0B4}.Debug|Any CPU.Build.0 = Debug|Any CPU
24 | {E522C6DA-1E95-4612-A4B5-684C1DECE0B4}.Release|Any CPU.ActiveCfg = Release|Any CPU
25 | {E522C6DA-1E95-4612-A4B5-684C1DECE0B4}.Release|Any CPU.Build.0 = Release|Any CPU
26 | {08EF0E77-6201-425F-97EB-13871A5F7C9B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
27 | {08EF0E77-6201-425F-97EB-13871A5F7C9B}.Release|Any CPU.ActiveCfg = Release|Any CPU
28 | EndGlobalSection
29 | GlobalSection(SolutionProperties) = preSolution
30 | HideSolutionNode = FALSE
31 | EndGlobalSection
32 | EndGlobal
33 |
--------------------------------------------------------------------------------
/lib/evReact.dll.nuspec:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | evReact
5 | 0.9.0
6 | Andrea Canciani
7 | https://vslab.github.io/evreact
8 | Event-based control flow management library for F# and .NET.
9 |
10 |
11 |
12 |
13 |
14 |
--------------------------------------------------------------------------------
/packages/repositories.config:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
--------------------------------------------------------------------------------
/src/evReact.fsproj:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 | Debug
6 | AnyCPU
7 | 2.0
8 | 20d72b7f-696d-478e-837c-9415c4e20808
9 | Library
10 | evReact
11 | evReact
12 | evReact
13 | v4.0
14 |
15 |
16 | net20
17 | $(DefineConstants);FX_NO_MONITOR_REPORTS_LOCKTAKEN
18 |
19 |
20 | net40
21 |
22 |
23 | true
24 | full
25 | false
26 | false
27 | $(DefineConstants);DEBUG
28 |
29 |
30 | pdbonly
31 | true
32 | true
33 |
34 |
35 | bin\$(Configuration)\$(TargetFrameworkOutputDirectory)
36 | obj\$(Configuration)\$(TargetFrameworkOutputDirectory)
37 | 3
38 | bin\$(Configuration)\evReact.XML
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
52 |
53 | 11
54 |
55 |
56 | ..\lib\Debug
57 | ..\lib\Debug\evReact.XML
58 |
59 |
60 | ..\lib
61 | ..\lib\evReact.XML
62 |
63 |
64 |
65 |
66 | $(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets
67 |
68 |
69 |
70 |
71 | $(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets
72 |
73 |
74 |
75 |
76 |
83 |
84 |
--------------------------------------------------------------------------------
/src/evreact.fs:
--------------------------------------------------------------------------------
1 | namespace EvReact
2 |
3 | open System
4 | open System.Collections.Generic
5 |
6 | module Internals =
7 | let inline swap (a:List<_>) i j =
8 | let tmp = a.[i]
9 | a.[i] <- a.[j]
10 | a.[j] <- tmp
11 |
12 | #if FX_NO_MONITOR_REPORTS_LOCKTAKEN
13 |
14 | let inline safeLock obj (taken:byref<_>) =
15 | System.Threading.Monitor.Enter(obj)
16 |
17 | let inline safeUnlock obj (taken:byref<_>) =
18 | System.Threading.Monitor.Exit(obj)
19 |
20 | #else
21 |
22 | let inline safeLock obj (taken:byref<_>) =
23 | System.Threading.Monitor.Enter(obj, &taken)
24 |
25 | let inline safeUnlock obj (taken:byref<_>) =
26 | if taken then
27 | System.Threading.Monitor.Exit(obj)
28 | taken <- false
29 |
30 | #endif
31 |
32 | let inline mapMax (a:_[]) f =
33 | let mutable r = -1
34 | for v in a do
35 | r <- max r (f v)
36 | r
37 |
38 | let inline opString (operands:_[]) opS emptyS =
39 | if operands.Length = 0 then
40 | emptyS
41 | else
42 | operands
43 | |> Array.map (sprintf "(%A)")
44 | |> String.concat opS
45 |
46 | (* A binary heap implementation of a Priority queue *)
47 | type BinaryHeap<'Key,'Value when 'Key : comparison>() =
48 | let keys = new List<'Key>()
49 | let values = new List<'Value>()
50 |
51 | let swap i j =
52 | swap keys i j
53 | swap values i j
54 |
55 | member this.Count = keys.Count
56 |
57 | member this.Dequeue() =
58 | let r = values.[0]
59 | let n = keys.Count - 1
60 |
61 | keys.[0] <- keys.[n]
62 | values.[0] <- values.[n]
63 |
64 | keys.RemoveAt(n)
65 | values.RemoveAt(n)
66 |
67 | let mutable working = n <> 0
68 | let mutable i = 0
69 | while working do
70 | let left = i*2
71 | let right = left+1
72 | if right < n && keys.[right] < keys.[i] && keys.[right] < keys.[left] then
73 | swap i right
74 | i <- right
75 | elif left < n && keys.[left] < keys.[i] then
76 | swap i left
77 | i <- left
78 | else
79 | working <- false
80 | r
81 |
82 | member this.Enqueue(key, value) =
83 | let mutable i = keys.Count
84 | keys.Add(key)
85 | values.Add(value)
86 | while i > 0 do
87 | let parent = i/2
88 | if keys.[i] < keys.[parent] then
89 | swap i parent
90 | i <- parent
91 | else
92 | i <- 0
93 |
94 | open Internals
95 |
96 | []
97 | type Event<'T>(name) =
98 | [] val mutable multicast : Handler<'T>
99 | new() = Event<'T>(null)
100 |
101 | member x.Id = name
102 | member x.Trigger(arg:'T) =
103 | match x.multicast with
104 | | null -> ()
105 | | d -> d.Invoke(null,arg) |> ignore
106 | member x.Publish =
107 | { new obj() with
108 | member e.ToString() = if x.Id = null then "" else x.Id
109 | interface IEvent<'T>
110 | interface IDelegateEvent> with
111 | member e.AddHandler(d) =
112 | x.multicast <- (System.Delegate.Combine(x.multicast, d) :?> Handler<'T>)
113 | member e.RemoveHandler(d) =
114 | x.multicast <- (System.Delegate.Remove(x.multicast, d) :?> Handler<'T>)
115 | interface System.IObservable<'T> with
116 | member e.Subscribe(observer) =
117 | let h = new Handler<_>(fun sender args -> observer.OnNext(args))
118 | (e :?> IEvent<_,_>).AddHandler(h)
119 | { new System.IDisposable with
120 | member x.Dispose() = (e :?> IEvent<_,_>).RemoveHandler(h) } }
121 |
122 | module Event =
123 | let create name =
124 | new Event<_>(name)
125 |
126 | type INotifiable<'T> =
127 | abstract member NotifyDeactivation: int * 'T -> unit
128 | abstract member NotifyMatch: int * 'T -> unit
129 | abstract member NotifyUnmatch: int * 'T -> unit
130 |
131 |
132 | type PrioritySet<'U,'T when 'U :> SimpleNet<'T>>() =
133 | let queue = new BinaryHeap()
134 | let set = new HashSet<'U>()
135 |
136 | member this.Count = queue.Count
137 |
138 | member this.Enqueue(net) =
139 | if set.Add(net) then
140 | queue.Enqueue(net.Priority, net)
141 |
142 | member this.Dequeue() =
143 | queue.Dequeue()
144 |
145 | member this.Reset() =
146 | assert (queue.Count = 0)
147 | set.Clear()
148 |
149 |
150 | and [] SimpleNet<'T>(orch, priority) =
151 | let mutable matching = false
152 |
153 | member val Parent = Unchecked.defaultof> with get, set
154 | member val Aux = 0 with get, set
155 |
156 | member val Orch : Orchestrator<'T> = orch
157 | member val Priority : int = priority
158 |
159 | member this.SetMatching(v, args) =
160 | if v then
161 | this.Parent.NotifyMatch(this.Aux, args)
162 | elif matching then
163 | this.Parent.NotifyUnmatch(this.Aux, args)
164 | matching <- v
165 |
166 | abstract member Start: 'T -> unit
167 | abstract member Stop: unit -> unit
168 |
169 | abstract member Initialize: unit -> unit
170 |
171 | interface System.IDisposable with
172 | member this.Dispose() = this.Stop()
173 |
174 | and Orchestrator<'T>() =
175 | let mutable evaluating = false
176 |
177 | let dispatchers = new Dictionary, Dispatcher<'T>>()
178 | let muxers = new Dictionary>, Muxer<'T>>()
179 |
180 | let eventQueue = new Queue>()
181 | let senderQueue = new Queue()
182 | let argsQueue = new Queue<'T>()
183 |
184 | let activeGroundTerms = new HashSet>()
185 | let activeOperators = new PrioritySet,_>()
186 | let disablingOperators = new PrioritySet,_>()
187 | let reactions = new PrioritySet,_>()
188 |
189 | member this.EnqueueGroundTerm(net) =
190 | activeGroundTerms.Add(net) |> ignore
191 |
192 | member this.EnqueueOpEval(net) =
193 | activeOperators.Enqueue(net)
194 |
195 | member this.EnqueueNotifyDisable(net) =
196 | disablingOperators.Enqueue(net)
197 |
198 | member this.EnqueueReaction(net) =
199 | reactions.Enqueue(net)
200 |
201 | member this.Dispatcher(event) =
202 | lock dispatchers (fun () ->
203 | let mutable d = Unchecked.defaultof<_>
204 | if not (dispatchers.TryGetValue(event, &d)) then
205 | d <- new Dispatcher<_>(this, event)
206 | dispatchers.[event] <- d
207 | d)
208 |
209 | member private this.Muxer(events) =
210 | lock muxers (fun () ->
211 | let mutable m = Unchecked.defaultof<_>
212 | if not (muxers.TryGetValue(events, &m)) then
213 | m <- new Muxer<_>(this, events)
214 | muxers.[events] <- m
215 | m)
216 |
217 | member this.Subscribe(events) =
218 | new Subscription<'T>(this.Muxer(events))
219 |
220 | member this.Unsubscribe(event) =
221 | lock dispatchers (fun () -> dispatchers.Remove(event) |> ignore)
222 |
223 | member this.Unsubscribe(events) =
224 | lock muxers (fun () -> muxers.Remove(events) |> ignore)
225 |
226 | member this.IsEmpty =
227 | lock muxers (fun () ->
228 | lock dispatchers (fun () -> dispatchers.Count = 0 && muxers.Count = 0))
229 |
230 | // FIXME: this should be a virtual protected member
231 | member val EnqueueEvent =
232 | fun (orch:Orchestrator<'T>) event sender args ->
233 | let mutable taken = false
234 | let mutable runEval =
235 | try
236 | safeLock eventQueue &taken
237 | if evaluating then
238 | eventQueue.Enqueue(event)
239 | senderQueue.Enqueue(sender)
240 | argsQueue.Enqueue(args)
241 | false
242 | else
243 | evaluating <- true
244 | true
245 | finally
246 | safeUnlock eventQueue &taken
247 |
248 | let mutable event = event
249 | let mutable sender = sender
250 | let mutable args = args
251 | while runEval do
252 | orch.EvalEvent orch event sender args
253 | try
254 | safeLock eventQueue &taken
255 | runEval <- eventQueue.Count <> 0
256 | if runEval then
257 | event <- eventQueue.Dequeue()
258 | sender <- senderQueue.Dequeue()
259 | args <- argsQueue.Dequeue()
260 | else
261 | evaluating <- false
262 | finally
263 | safeUnlock eventQueue &taken
264 | with get, set
265 |
266 | // FIXME: this should be a virtual protected member
267 | member val EvalEvent =
268 | fun (orch:Orchestrator<'T>) event sender args ->
269 | if event <> Unchecked.defaultof<_> then
270 | lock dispatchers (fun () -> dispatchers.[event].EvalEvent(args))
271 |
272 | // Evaluate ground terms:
273 |
274 | // 1. deactivate all of the ground terms that have terminated
275 | for net in activeGroundTerms do
276 | net.EvalDeactivate(args)
277 |
278 | // 2. update the matching state
279 | for net in activeGroundTerms do
280 | net.EvalMatching(args)
281 |
282 | // 3. if the term has not been reactivated, notify deactivation
283 | for net in activeGroundTerms do
284 | net.EvalNotify(args)
285 |
286 | activeGroundTerms.Clear()
287 |
288 | // Evaluate operators (bottom-up).
289 | while activeOperators.Count <> 0 do
290 | let net = activeOperators.Dequeue()
291 | net.SetMatching(net.Matching, args)
292 | activeOperators.Reset()
293 |
294 | while disablingOperators.Count <> 0 do
295 | let net = disablingOperators.Dequeue()
296 | if net.Active.Count = 0 then
297 | net.Parent.NotifyDeactivation(net.Aux, args)
298 | disablingOperators.Reset()
299 |
300 | while reactions.Count <> 0 do
301 | let net = reactions.Dequeue()
302 | net.Cb(args)
303 | reactions.Reset()
304 | with get, set
305 |
306 |
307 | and [] Dispatcher<'T>(orch, event) as this =
308 | let active = new HashSet>()
309 | let inactive = new HashSet>()
310 | let handler = new Handler<_>(this.HandleEvent)
311 |
312 | member this.AsString =
313 | sprintf "%A" event
314 |
315 | member this.HandleEvent sender args =
316 | orch.EnqueueEvent orch event sender args
317 |
318 | member this.EvalEvent(args) =
319 | let mutable deactivate = []
320 | for m in active do
321 | if m.EvalEvent(this, args) then
322 | deactivate <- m :: deactivate
323 | active.ExceptWith(deactivate)
324 | inactive.UnionWith(deactivate)
325 | if active.Count = 0 then
326 | event.RemoveHandler(handler)
327 |
328 | member this.Attach(mux) =
329 | if active.Count = 0 then
330 | event.AddHandler(handler)
331 | inactive.Remove(mux) |> ignore
332 | active.Add(mux) |> ignore
333 |
334 | member this.Detach(mux) =
335 | inactive.Remove(mux) |> ignore
336 | active.Remove(mux) |> ignore
337 | if active.Count = 0 then
338 | event.RemoveHandler(handler)
339 | if inactive.Count = 0 then
340 | orch.Unsubscribe(event)
341 |
342 | and [] Muxer<'T>(orch, events) =
343 | let activeSubscriptions = new HashSet>()
344 | let inactiveSubscriptions = new HashSet>()
345 |
346 | let enabledDispatchers = new HashSet>()
347 | let disabledDispatchers = new HashSet>()
348 |
349 | do
350 | for e in events do
351 | disabledDispatchers.Add(orch.Dispatcher(e)) |> ignore
352 |
353 | member this.AsString =
354 | if events.Count = 1 then
355 | events |> Seq.head |> sprintf "%A"
356 | else
357 | events |> Seq.toList |> sprintf "%A"
358 |
359 | member this.EvalEvent(dispatcher, args) =
360 | let r = activeSubscriptions.Count = 0
361 | if r then
362 | enabledDispatchers.Remove(dispatcher) |> ignore
363 | disabledDispatchers.Add(dispatcher) |> ignore
364 | else
365 | for s in activeSubscriptions do
366 | s.EvalEvent(args)
367 | r
368 |
369 | member this.Enable(subscription) =
370 | if activeSubscriptions.Count = 0 then
371 | for d in disabledDispatchers do
372 | d.Attach(this)
373 | enabledDispatchers.UnionWith(disabledDispatchers)
374 | disabledDispatchers.Clear()
375 | inactiveSubscriptions.Remove(subscription) |> ignore
376 | activeSubscriptions.Add(subscription) |> ignore
377 |
378 | member this.Disable(subscription) =
379 | activeSubscriptions.Remove(subscription) |> ignore
380 | inactiveSubscriptions.Add(subscription) |> ignore
381 | // disabling of dispatchers is performed lazily in EvalEvent
382 |
383 | member this.Unsubscribe(subscription) =
384 | activeSubscriptions.Remove(subscription) |> ignore
385 | inactiveSubscriptions.Remove(subscription) |> ignore
386 | if activeSubscriptions.Count = 0 && inactiveSubscriptions.Count = 0 then
387 | for d in enabledDispatchers do
388 | d.Detach(this)
389 | for d in disabledDispatchers do
390 | d.Detach(this)
391 | orch.Unsubscribe(events)
392 |
393 | and [] Subscription<'T>(mux) =
394 | [] val mutable EvalEvent : 'T -> unit
395 |
396 | member this.AsString =
397 | sprintf "%A" mux
398 |
399 | member this.Enable() =
400 | mux.Enable(this)
401 |
402 | member this.Disable() =
403 | mux.Disable(this)
404 |
405 | member this.Dispose() =
406 | mux.Unsubscribe(this)
407 |
408 |
409 | and [] UnaryOperatorNet<'T>(orch, subnet:SimpleNet<'T>) =
410 | inherit SimpleNet<'T>(orch, 1 + subnet.Priority)
411 |
412 | member val Subnet = subnet
413 |
414 | abstract member SideEffect : 'T -> unit
415 | abstract member DisablingSideEffect : 'T -> unit
416 | default this.DisablingSideEffect(args) = ()
417 |
418 | override this.Initialize() =
419 | this.Subnet.Parent <- this
420 | this.Subnet.Initialize()
421 |
422 | override this.Start(args) =
423 | this.Subnet.Start(args)
424 |
425 | override this.Stop() =
426 | this.Subnet.Stop()
427 |
428 | interface INotifiable<'T> with
429 | member this.NotifyDeactivation(aux, args) =
430 | this.DisablingSideEffect(args)
431 | this.Parent.NotifyDeactivation(this.Aux, args)
432 |
433 | member this.NotifyMatch(aux, args) =
434 | // Unary operators do not need to be queued to wait for all
435 | // subexpressions to complete, as they only have one.
436 | this.SideEffect(args)
437 | this.SetMatching(true, args)
438 |
439 | member this.NotifyUnmatch(aux, args) =
440 | this.SetMatching(false, args)
441 |
442 |
443 | and [] CallbackNet<'T>(orch, subnet, cb) =
444 | inherit UnaryOperatorNet<'T>(orch, subnet)
445 |
446 | member private this.AsString =
447 | sprintf "(%A) |-> ..." subnet
448 |
449 | member val Cb: ('T -> unit) = cb
450 |
451 | override this.SideEffect(args) =
452 | this.Orch.EnqueueReaction(this)
453 |
454 |
455 | and [] IterNet<'T>(orch, subnet) =
456 | inherit UnaryOperatorNet<'T>(orch, subnet)
457 |
458 | member private this.AsString =
459 | sprintf "+(%A)" subnet
460 |
461 | override this.SideEffect(args) =
462 | this.Start(args)
463 |
464 |
465 | and [] OperatorNet<'T>(orch, subnets:SimpleNet<'T>[]) =
466 | inherit SimpleNet<'T>(orch, 1 + mapMax subnets (fun n -> n.Priority))
467 |
468 | member val Subnets = subnets
469 | member val Active : HashSet = new HashSet<_>()
470 |
471 | member this.SubStart(i, args) =
472 | this.Active.Add(i) |> ignore
473 | this.Subnets.[i].Start(args)
474 |
475 | override this.Initialize() =
476 | for i = 0 to this.Subnets.Length-1 do
477 | this.Subnets.[i].Parent <- this
478 | this.Subnets.[i].Aux <- i
479 | this.Subnets.[i].Initialize()
480 |
481 | override this.Stop() =
482 | for n in this.Subnets do
483 | n.Stop()
484 |
485 | abstract member Matching : bool
486 | abstract member SubMatch : int * 'T -> unit
487 | abstract member SubUnmatch : int * 'T -> unit
488 |
489 | interface INotifiable<'T> with
490 | member this.NotifyDeactivation(aux, args) =
491 | this.Active.Remove(aux) |> ignore
492 | if this.Active.Count = 0 then
493 | this.Orch.EnqueueNotifyDisable(this)
494 |
495 | member this.NotifyMatch(aux, args) =
496 | this.SubMatch(aux, args)
497 |
498 | member this.NotifyUnmatch(aux, args) =
499 | this.SubUnmatch(aux, args)
500 |
501 |
502 | and [] GroundTermNet<'T>(orch, predicate, e:IEvent<_>, bound:HashSet<_>) =
503 | inherit SimpleNet<'T>(orch, 0)
504 |
505 | let mutable active = false
506 | let mutable successful = false
507 | let mutable pos = Unchecked.defaultof<_>
508 | let mutable neg = Unchecked.defaultof<_>
509 |
510 | override this.Initialize() =
511 | pos <- orch.Subscribe(new HashSet<_>([| e |]))
512 | neg <- orch.Subscribe(bound)
513 | pos.EvalEvent <- this.PosCb
514 | neg.EvalEvent <- this.NegCb
515 |
516 | member this.Initialized = pos <> Unchecked.defaultof<_>
517 |
518 | member private this.AsString =
519 | let c = if active then "." else ""
520 | if bound.Count = 0 then
521 | sprintf "%s%A" c pos
522 | else
523 | sprintf "%s%A/%A" c pos neg
524 |
525 | member private this.PosCb(args) =
526 | if predicate args then
527 | successful <- true
528 | this.Orch.EnqueueGroundTerm(this)
529 |
530 | member private this.NegCb(args) =
531 | this.Orch.EnqueueGroundTerm(this)
532 |
533 | override this.Start(args) =
534 | successful <- false
535 | this.SetMatching(successful, args)
536 | if not active then
537 | pos.Enable()
538 | neg.Enable()
539 | active <- true
540 |
541 | member this.EvalDeactivate(args:'T) : unit =
542 | assert active
543 | active <- false
544 | pos.Disable()
545 | neg.Disable()
546 |
547 | member this.EvalMatching(args:'T) : unit =
548 | this.SetMatching(successful, args)
549 |
550 | member this.EvalNotify(args:'T) : unit =
551 | if not active then
552 | this.Parent.NotifyDeactivation(this.Aux, args)
553 |
554 | override this.Stop() =
555 | if this.Initialized then
556 | pos.Dispose()
557 | neg.Dispose()
558 | pos <- Unchecked.defaultof<_>
559 | neg <- Unchecked.defaultof<_>
560 |
561 |
562 | type DebugOrchestrator<'T>() as this =
563 | inherit Orchestrator<'T>()
564 |
565 | let onEvent = new Event * obj * 'T>()
566 | let onStepBegin = new Event * obj * 'T>()
567 | let onStepEnd = new Event * obj * 'T>()
568 |
569 | do
570 | let oldEnqueue = this.EnqueueEvent
571 | let oldEval = this.EvalEvent
572 |
573 | this.EnqueueEvent <-
574 | fun orch event sender args ->
575 | onEvent.Trigger(event, sender, args)
576 | oldEnqueue orch event sender args
577 |
578 | this.EvalEvent <-
579 | fun orch event sender args ->
580 | onStepBegin.Trigger(event, sender, args)
581 | oldEval orch event sender args
582 | onStepEnd.Trigger(event, sender, args)
583 |
584 | member this.IsEmpty = base.IsEmpty
585 |
586 | []
587 | member val OnEvent = onEvent.Publish
588 |
589 | []
590 | member val OnStepBegin = onStepBegin.Publish
591 |
592 | []
593 | member val OnStepEnd = onStepEnd.Publish
594 |
595 |
596 | type [] ReactNet<'T>(orch, subnet, cb) =
597 | inherit CallbackNet<'T>(orch, subnet, cb)
598 |
599 | member private this.AsString =
600 | sprintf "(%A) |-> ..." subnet
601 |
602 | override this.SideEffect(args) =
603 | this.Orch.EnqueueReaction(this)
604 |
605 |
606 | type [] FinallyNet<'T>(orch, subnet, cb) =
607 | inherit CallbackNet<'T>(orch, subnet, cb)
608 |
609 | member private this.AsString =
610 | sprintf "(%A) |=> ..." subnet
611 |
612 | override this.DisablingSideEffect(args) =
613 | this.Orch.EnqueueReaction(this)
614 |
615 | override this.SideEffect(args) =
616 | ()
617 |
618 |
619 | []
620 | type CatNet<'T>(orch, subnets) =
621 | inherit OperatorNet<'T>(orch, subnets)
622 |
623 | let mutable submatching = false
624 |
625 | member private this.AsString = opString this.Subnets " - " "nil"
626 |
627 | override this.Matching = submatching
628 |
629 | override this.Start(args) =
630 | if this.Subnets.Length <> 0 then
631 | submatching <- false
632 | this.SubStart(0, args)
633 | else
634 | this.Parent.NotifyDeactivation(this.Aux, args)
635 |
636 | override this.SubMatch(aux, args) =
637 | let next = aux + 1
638 | if next = this.Subnets.Length then
639 | submatching <- true
640 | this.Orch.EnqueueOpEval(this)
641 | else
642 | this.SubStart(next, args)
643 |
644 | override this.SubUnmatch(aux, args) =
645 | let next = aux + 1
646 | if next = this.Subnets.Length then
647 | submatching <- false
648 | this.Orch.EnqueueOpEval(this)
649 |
650 | []
651 | type CommutativeOperatorNet<'T>(orch, subnets:SimpleNet<'T>[]) =
652 | inherit OperatorNet<'T>(orch, subnets)
653 |
654 | member val SubMatching = new HashSet<_>()
655 |
656 | override this.Start(args) =
657 | if this.Active.Add(-1) then
658 | if this.Subnets.Length = 0 then
659 | this.SetMatching(this.Matching, args)
660 | else
661 | for i = 0 to this.Subnets.Length-1 do
662 | this.SubStart(i, args)
663 | (this :> INotifiable<_>).NotifyDeactivation(-1, args)
664 |
665 | override this.SubMatch(aux, args) =
666 | this.SubMatching.Add(aux) |> ignore
667 | if this.Matching then
668 | this.Orch.EnqueueOpEval(this)
669 |
670 | override this.SubUnmatch(aux, args) =
671 | this.SubMatching.Remove(aux) |> ignore
672 | if not this.Matching then
673 | this.Orch.EnqueueOpEval(this)
674 |
675 |
676 | []
677 | type AnyNet<'T>(orch, subnets) =
678 | inherit CommutativeOperatorNet<'T>(orch, subnets)
679 |
680 | member private this.AsString = opString this.Subnets " ||| " "nil"
681 |
682 | override this.Matching = this.SubMatching.Count <> 0
683 |
684 |
685 | []
686 | type AllNet<'T>(orch, subnets) =
687 | inherit CommutativeOperatorNet<'T>(orch, subnets)
688 |
689 | member private this.AsString = opString this.Subnets " &&& " "epsilon"
690 |
691 | override this.Matching = this.SubMatching.Count = this.Subnets.Length
692 |
693 | type Expr<'T> =
694 | | SimpleEvent of IEvent<'T> * ('T -> bool)
695 | | Restrict of Expr<'T> * IEvent<'T>[]
696 | | Iter of Expr<'T>
697 | | Any of Expr<'T>[]
698 | | All of Expr<'T>[]
699 | | Cat of Expr<'T>[]
700 | | Reaction of Expr<'T> * ('T -> unit)
701 | | Finally of Expr<'T> * ('T -> unit)
702 | with
703 | static member ( / ) (expr, events) = Restrict(expr, events)
704 | static member ( ~+ ) (expr) = Iter(expr)
705 | static member ( - ) (x, y) = Cat([| x ; y |])
706 | static member ( &&& ) (x, y) = All([| x ; y |])
707 | static member ( ||| ) (x, y) = Any([| x ; y |])
708 | static member ( |-> ) (expr, f) = Reaction(expr, f)
709 | static member ( |=> ) (expr, f) = Finally(expr, f)
710 |
711 | module Expr =
712 | let epsilon = All [| |]
713 | let never = Any [| |]
714 |
715 | let trueP _ = true
716 |
717 | let ( !! ) x = SimpleEvent(x, trueP)
718 | let ( %- ) x y = SimpleEvent(x, y)
719 |
720 | let rec compile (orch:Orchestrator<'T>) restriction expr : SimpleNet<'T> =
721 | match expr with
722 | | SimpleEvent(e, p) -> new GroundTermNet<_>(orch, p, e, restriction) :> _
723 | | Restrict(subexpr, events) ->
724 | let events = new HashSet<_>(events)
725 | events.UnionWith(restriction)
726 | compile orch events subexpr
727 |
728 | | All(subexprs) -> new AllNet<_>(orch, Array.map (compile orch restriction) subexprs) :> _
729 | | Any(subexprs) -> new AnyNet<_>(orch, Array.map (compile orch restriction) subexprs) :> _
730 | | Cat(subexprs) -> new CatNet<_>(orch, Array.map (compile orch restriction) subexprs) :> _
731 |
732 | | Iter(subexpr) -> new IterNet<_>(orch, compile orch restriction subexpr) :> _
733 |
734 | | Reaction(subexpr, f) -> new ReactNet<_>(orch, compile orch restriction subexpr, f) :> _
735 | | Finally(subexpr, f) -> new FinallyNet<_>(orch, compile orch restriction subexpr, f) :> _
736 |
737 |
738 | let simple event =
739 | SimpleEvent(event, trueP)
740 |
741 | let cond event pred =
742 | SimpleEvent(event, pred)
743 |
744 | let restrict bounds subexpr =
745 | Restrict(subexpr, bounds)
746 |
747 | let all ([] subexprs) =
748 | All subexprs
749 |
750 | let any ([] subexprs) =
751 | Any subexprs
752 |
753 | let cat ([] subexprs) =
754 | Cat subexprs
755 |
756 | let iter expr =
757 | Iter expr
758 |
759 | let react f expr =
760 | Reaction(expr, f)
761 |
762 | let finallyDo f expr =
763 | Finally(expr, f)
764 |
765 |
766 | let condInvoke event (pred:Predicate<_>) =
767 | SimpleEvent(event, pred.Invoke)
768 |
769 | let reactInvoke (action:Action<_>) expr =
770 | Reaction(expr, action.Invoke)
771 |
772 | let finallyDoInvoke (action:Action<_>) expr =
773 | Finally(expr, action.Invoke)
774 |
775 |
776 | type RootNotifiable<'T>(net:IDisposable) =
777 | interface INotifiable<'T> with
778 | member this.NotifyDeactivation(aux, args) =
779 | net.Dispose()
780 |
781 | member this.NotifyMatch(aux, args) = ()
782 | member this.NotifyUnmatch(aux, args) = ()
783 |
784 | let start args orch expr =
785 | let empty = new HashSet<_>()
786 | let net = compile orch empty expr
787 | net.Parent <- new RootNotifiable<_>(net)
788 | net.Initialize()
789 | net.Start(args)
790 | orch.EnqueueEvent orch Unchecked.defaultof<_> null args
791 | net :> IDisposable
792 |
793 | let stop (net:IDisposable) =
794 | net.Dispose()
795 |
796 | module Orchestrator =
797 | let create () =
798 | new Orchestrator<_>()
799 |
800 | let createDebug () =
801 | new DebugOrchestrator<_>()
802 |
--------------------------------------------------------------------------------
/src/evreact.fsi:
--------------------------------------------------------------------------------
1 | namespace EvReact
2 | open System
3 |
4 | type Event<'T> =
5 | new : unit -> Event<'T>
6 | new : string -> Event<'T>
7 | member Trigger : 'T -> unit
8 | member Publish : IEvent<'T>
9 |
10 | module Event =
11 | val create : string -> Event<'a>
12 |
13 |
14 | type Orchestrator<'T> =
15 | class
16 | end
17 |
18 | type DebugOrchestrator<'T> =
19 | class
20 | inherit Orchestrator<'T>
21 | member IsEmpty : bool
22 | [] member OnEvent : IEvent * obj * 'T>
23 | [] member OnStepBegin : IEvent * obj * 'T>
24 | [] member OnStepEnd : IEvent * obj * 'T>
25 | end
26 |
27 | module Orchestrator =
28 | val create : unit -> Orchestrator<'a>
29 | val createDebug : unit -> DebugOrchestrator<'a>
30 |
31 |
32 | []
33 | type Expr<'T> =
34 | static member ( |=> ) : Expr<'a> * ('a -> unit) -> Expr<'a>
35 | static member ( |-> ) : Expr<'a> * ('a -> unit) -> Expr<'a>
36 | static member ( &&& ) : Expr<'a> * Expr<'a> -> Expr<'a>
37 | static member ( ||| ) : Expr<'a> * Expr<'a> -> Expr<'a>
38 | static member ( - ) : Expr<'a> * Expr<'a> -> Expr<'a>
39 | static member ( / ) : Expr<'a> * IEvent<'a>[] -> Expr<'a>
40 | static member ( ~+ ) : Expr<'a> -> Expr<'a>
41 |
42 | module Expr =
43 | val ( !! ) : IEvent<'a> -> Expr<'a>
44 | val ( %- ) : IEvent<'a> -> ('a -> bool) -> Expr<'a>
45 |
46 | val epsilon : Expr<'a>
47 | val never : Expr<'a>
48 |
49 | val simple : IEvent<'a> -> Expr<'a>
50 | val cond : IEvent<'a> -> ('a -> bool) -> Expr<'a>
51 |
52 | val all : [] subexprs:Expr<'a> [] -> Expr<'a>
53 | val any : [] subexprs:Expr<'a> [] -> Expr<'a>
54 | val cat : [] subexprs:Expr<'a> [] -> Expr<'a>
55 | val iter : Expr<'a> -> Expr<'a>
56 | val restrict : IEvent<'a> [] -> Expr<'a> -> Expr<'a>
57 | val react : ('a -> unit) -> Expr<'a> -> Expr<'a>
58 | val finallyDo : ('a -> unit) -> Expr<'a> -> Expr<'a>
59 |
60 | val start : 'a -> Orchestrator<'a> -> Expr<'a> -> IDisposable
61 | val stop : IDisposable -> unit
62 |
63 | val condInvoke : IEvent<'a> -> Predicate<'a> -> Expr<'a>
64 | val reactInvoke : Action<'a> -> Expr<'a> -> Expr<'a>
65 | val finallyDoInvoke : Action<'a> -> Expr<'a> -> Expr<'a>
66 |
--------------------------------------------------------------------------------
/src/utils.fs:
--------------------------------------------------------------------------------
1 | namespace EvReact
2 |
3 | open Expr
4 | open System
5 | open System.Threading
6 | open System.Collections.Generic
7 |
8 | module Utils =
9 | let start0 orch expr = start Unchecked.defaultof<_> orch expr
10 |
11 | type Demultiplexer<'K, 'T when 'K : equality>(evt:IEvent<'T>, f) =
12 | let noNet = Unchecked.defaultof<_>
13 | let noEvt = Unchecked.defaultof<_>
14 |
15 | let mutable net = noNet
16 | let dict = Dictionary<'K,WeakReference>()
17 |
18 | let get key =
19 | let mutable wr = Unchecked.defaultof<_>
20 | if dict.TryGetValue(key, &wr) then
21 | wr.Target :?> DemultiplexEvent<_,_>
22 | else
23 | noEvt
24 |
25 | let demux _ args =
26 | let locked () = get (f args)
27 | let e = lock dict locked
28 | if e <> noEvt then
29 | e.Trigger(args)
30 |
31 | let demux = Handler<_>(demux)
32 |
33 | let unsubscribe self key () =
34 | dict.Remove(key) |> ignore
35 | if dict.Count = 0 then
36 | evt.RemoveHandler(demux)
37 |
38 | let subscribe self key () =
39 | if dict.Count = 0 then
40 | evt.AddHandler(demux)
41 | let mutable e = get key
42 | if e = noEvt then
43 | e <- new DemultiplexEvent<_,_>(self, key)
44 | dict.[key] <- WeakReference(e)
45 | e.Publish
46 |
47 | member x.Unsubscribe(key) = lock dict <| unsubscribe x key
48 | member x.Item with get(key) = lock dict <| subscribe x key
49 |
50 | and DemultiplexEvent<'K, 'T when 'K : equality>(demux:Demultiplexer<'K,'T>, key: 'K) =
51 | inherit Event<'T>(key.ToString())
52 |
53 | override x.Finalize() = demux.Unsubscribe(key)
54 |
--------------------------------------------------------------------------------
/src/utils.fsi:
--------------------------------------------------------------------------------
1 | namespace EvReact
2 | open System
3 |
4 | module Utils =
5 | val start0 : Orchestrator<'a> -> expr:Expr<'a> -> IDisposable
6 |
7 | type Demultiplexer<'K,'T when 'K : equality> =
8 | class
9 | new : IEvent<'T> * ('T -> 'K) -> Demultiplexer<'K,'T>
10 | member Item : 'K -> IEvent<'T> with get
11 | end
12 |
--------------------------------------------------------------------------------
/test/bugs.fs:
--------------------------------------------------------------------------------
1 | namespace EvReact.Test
2 |
3 | open NUnit.Framework
4 | open EvReact
5 | open EvReact.Expr
6 | open EvReact.Test.Utils
7 |
8 | []
9 | type BugsTest() =
10 | []
11 | member this.BugIterAll () =
12 | let e,check = prepare [ "ab.ab.ba.ba." ; "cacacacb.cbcbcbca.cacacacb." ]
13 | +(!!(e 'a') &&& !!(e 'b'))
14 | |> check
15 |
16 | []
17 | member this.BugAnyCatACatB () =
18 | let e,check = prepare [ "ab!"; "bbbab!"; "bbbcccaaacccaaacccb!aaabbbccc" ]
19 | any [| cat [| !!(e 'a') |] |] - (!!(e 'b'))
20 | |> check
21 |
22 | []
23 | member this.BugReactACatB () =
24 | let triggered = Event.create "triggeredEvent"
25 | let e,check = prepare [ "a!"; "bbba!bbb" ]
26 | (!!(e 'a') |-> triggered.Trigger) - !!(triggered.Publish)
27 | |> check
28 |
29 | []
30 | member this.BugIterAnyABCatC () =
31 | let e,check = prepare [ "ac.bc."; "abc."; "cccaaac.cccabababc." ]
32 | +((!!(e 'a') ||| !!(e 'b')) - !!(e 'c'))
33 | |> check
34 |
35 | []
36 | member this.BugUntil () =
37 | let e,check = prepare [ "ab!"; "aab!"; "aaab!aaabbb" ; "aaaab!aaabbb" ]
38 | (+(!!(e 'a')) - !!(e 'b')) / [| e 'a'; e 'b' |]
39 | |> check
40 |
--------------------------------------------------------------------------------
/test/empty.fs:
--------------------------------------------------------------------------------
1 | namespace EvReact.Test
2 |
3 | open NUnit.Framework
4 | open EvReact
5 | open EvReact.Expr
6 | open EvReact.Test.Utils
7 |
8 | []
9 | type EmptyTest() =
10 | []
11 | member this.EmptyCat () =
12 | let e,check = prepare [ "0"; "0aaa" ]
13 | cat [| |]
14 | |> check
15 |
16 | []
17 | member this.EmptyAnd () =
18 | let e,check = prepare [ "!"; "!aaa" ]
19 | all [| |]
20 | |> check
21 |
22 | []
23 | member this.EmptyOr () =
24 | let e,check = prepare [ "0"; "0aaa" ]
25 | any [| |]
26 | |> check
27 |
--------------------------------------------------------------------------------
/test/examples.fs:
--------------------------------------------------------------------------------
1 | namespace EvReact.Test
2 |
3 | open NUnit.Framework
4 | open EvReact
5 | open EvReact.Expr
6 | open EvReact.Test.Utils
7 |
8 | []
9 | type ExampleTests() =
10 | []
11 | member this.Balanced () =
12 | let nets = new System.Collections.Generic.List()
13 |
14 | let makeGrammar expr suffix =
15 | let m = Event.create suffix
16 | (epsilon |-> (expr m.Trigger >> ignore)) &&& iter !!m.Publish
17 |
18 | let balancedParens orch ``(`` ``)`` callback =
19 | let bound = [| ``(``; ``)`` |]
20 | let ``(`` = !! ``(`` / bound
21 | let ``)`` = !! ``)`` / bound
22 | let rec expr cb () =
23 | let abort = Event.create "abort"
24 | let expr = makeGrammar expr "E" / [| abort.Publish |]
25 | let expr =
26 | epsilon |||
27 | +(``(`` - expr - ``)`` |-> abort.Trigger)
28 | let expr = expr |-> cb
29 | let net = start () orch expr
30 | nets.Add(net)
31 | net
32 | expr callback ()
33 |
34 | let orch = Orchestrator.createDebug()
35 | let o = Event.create "-(-"
36 | let c = Event.create "-)-"
37 | let count = ref 0
38 | Assert.IsTrue(orch.IsEmpty)
39 | let net = balancedParens orch o.Publish c.Publish (fun () -> Assert.AreEqual(0, !count))
40 | Assert.IsFalse(orch.IsEmpty)
41 | for v in "(((())))(()(()))" do
42 | match v with
43 | | '(' -> count := !count + 1 ; o.Trigger()
44 | | ')' -> count := !count - 1 ; c.Trigger()
45 | | _ -> failwith "Error"
46 | Assert.IsFalse(orch.IsEmpty)
47 | stop net
48 | Assert.IsTrue(orch.IsEmpty)
49 |
50 | []
51 | member this.PingPong () =
52 | let orch = Orchestrator.createDebug()
53 | let a = Event.create "a"
54 | let b = Event.create "b"
55 | let count = ref 0
56 | Assert.IsTrue(orch.IsEmpty)
57 | let net (x:Event<_>) (y:Event<_>) =
58 | let post = x.Trigger
59 | let receive = !!y.Publish
60 | +receive |-> fun v -> if v > 0 then post (v-1)
61 | let net1 = start 0 orch <| net a b
62 | let net2 = start 0 orch <| net b a
63 | Assert.IsFalse(orch.IsEmpty)
64 | a.Trigger(10)
65 | Assert.IsFalse(orch.IsEmpty)
66 | stop net1
67 | stop net2
68 | Assert.IsTrue(orch.IsEmpty)
69 |
70 | []
71 | member this.If () =
72 | let ifElseExpr cond trueExpr falseExpr =
73 | let e = Event.create "e"
74 | let ie = e.Publish
75 | let restriction = [| ie |]
76 | let trueBranch = (ie %- cond) / restriction - trueExpr
77 | let falseBranch = (ie %- (cond >> not)) / restriction - falseExpr
78 | (epsilon |-> e.Trigger) - (trueBranch ||| falseBranch)
79 |
80 | let em = Event.create "m"
81 | let im = em.Publish
82 | let n = ref 0
83 | let guard _ = 0 = !n % 3
84 | let incrN _ = incr n
85 |
86 | let e,check = prepare [ "aaa."; "bbbabbbabbba.bbbabbbabbba.bbb" ]
87 | +((!!(e 'a') |-> incrN) - ifElseExpr guard (epsilon |-> em.Trigger) epsilon) - !!im
88 | |> check
89 |
90 | []
91 | member this.RetryAlways () =
92 | let retryAlways expr =
93 | let e = Event.create "e"
94 | let ie = e.Publish
95 | +(((expr |=> e.Trigger) ||| epsilon) - !!ie)
96 |
97 | let e,check = prepare [ "bc.a"; "cccbbbc.a.ccca.bbba.ba.cbc." ]
98 | retryAlways ((!!(e 'b') - !!(e 'c')) / [| e 'a' |])
99 | |> check
100 |
101 | []
102 | member this.Shortcut () =
103 | let shortcut expr =
104 | let e = Event.create "e"
105 | let ie = e.Publish
106 | (expr |-> e.Trigger) / [| ie |]
107 |
108 | let e,check = prepare [ "b!"; "a!"; "cccb!cccaaa"; "ccca!aaacccbbb" ]
109 | shortcut (!!(e 'a') ||| !!(e 'b'))
110 | |> check
111 |
112 | []
113 | member this.SoftNegation () =
114 | let negation expr =
115 | let e = Event.create "e"
116 | let ie = e.Publish
117 | !!ie ||| (never &&& expr |=> e.Trigger)
118 | let e,check = prepare [ "b!"; "aaacccaaab!" ]
119 | negation +(!!(e 'a') / [| e 'b' |])
120 | |> check
121 |
122 | []
123 | member this.HardNegation () =
124 | let negation expr =
125 | let fail = Event.create "fail"
126 | let ifail = fail.Publish
127 | let success = Event.create "success"
128 | let isuccess = success.Publish
129 | (((expr |-> fail.Trigger |=> success.Trigger) - never) ||| !!isuccess) / [| ifail |]
130 | let e,check = prepare [ "b!"; "a0aacccaaab" ]
131 | negation +(!!(e 'a') / [| e 'b' |])
132 | |> check
133 |
--------------------------------------------------------------------------------
/test/packages.config:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
--------------------------------------------------------------------------------
/test/serialize.fs:
--------------------------------------------------------------------------------
1 | namespace EvReact.Test
2 |
3 | open NUnit.Framework
4 | open EvReact
5 | open EvReact.Expr
6 | open EvReact.Test.Utils
7 |
8 | []
9 | type SerializeTest() =
10 | []
11 | member this.BinaryAll () =
12 | let success = ref false
13 | let e = Event.create "e"
14 | let i = e.Publish
15 | let orch = Orchestrator.createDebug()
16 | let expr = !!i - !!i |-> (fun _ -> success := true)
17 | let net = start () orch expr
18 | e.Trigger()
19 |
20 | let newsuccess,newe,neworch,newnet = serializationClone (success,e,orch,net)
21 |
22 | Assert.IsFalse(orch.IsEmpty)
23 | stop net
24 | Assert.IsTrue(orch.IsEmpty)
25 | Assert.IsFalse(!success)
26 |
27 | Assert.IsFalse(!newsuccess)
28 | Assert.IsFalse(neworch.IsEmpty)
29 | newe.Trigger()
30 | Assert.IsTrue(!newsuccess)
31 | Assert.IsTrue(neworch.IsEmpty)
32 |
33 | []
34 | member this.BinaryEvent () =
35 | let success = ref false
36 | let e = Event.create "e"
37 | let i = e.Publish
38 | let orch = Orchestrator.create()
39 | let expr = !!i - !!i |-> (fun _ -> success := true)
40 | let net = start () orch expr
41 | e.Trigger()
42 | let newsuccess,newe = serializationClone (success,e)
43 | stop net
44 | Assert.IsFalse(!success)
45 | Assert.IsFalse(!newsuccess)
46 | newe.Trigger()
47 | Assert.IsTrue(!newsuccess)
48 |
--------------------------------------------------------------------------------
/test/simple.fs:
--------------------------------------------------------------------------------
1 | namespace EvReact.Test
2 |
3 | open NUnit.Framework
4 | open EvReact
5 | open EvReact.Expr
6 | open EvReact.Test.Utils
7 |
8 | []
9 | type SimpleTest() =
10 | []
11 | member this.Simple () =
12 | let e,check = prepare [ "a!"; "bbba!bbb" ]
13 | !!(e 'a')
14 | |> check
15 |
16 | []
17 | member this.SimpleCat () =
18 | let e,check = prepare [ "a!"; "bbba!bbb" ]
19 | cat [| !!(e 'a') |]
20 | |> check
21 |
22 | []
23 | member this.SimpleAnd () =
24 | let e,check = prepare [ "a!"; "bbba!bbb" ]
25 | all [| !!(e 'a') |]
26 | |> check
27 |
28 | []
29 | member this.SimpleOr () =
30 | let e,check = prepare [ "a!"; "bbba!bbb" ]
31 | any [| !!(e 'a') |]
32 | |> check
33 |
34 | []
35 | member this.SimpleRestrictEmpty () =
36 | let e,check = prepare [ "a!"; "bbba!bbb" ]
37 | !!(e 'a') / [| |]
38 | |> check
39 |
40 | []
41 | member this.SimpleBindSame () =
42 | let e,check = prepare [ "a!"; "bbba!bbb" ]
43 | !!(e 'a') / [| e 'a' |]
44 | |> check
45 |
46 | []
47 | member this.SimpleIter () =
48 | let e,check = prepare [ "a.a.a."; "bbba.bbba.bbba.bbb" ]
49 | +(!!(e 'a'))
50 | |> check
51 |
--------------------------------------------------------------------------------
/test/simpleAA.fs:
--------------------------------------------------------------------------------
1 | namespace EvReact.Test
2 |
3 | open NUnit.Framework
4 | open EvReact
5 | open EvReact.Expr
6 | open EvReact.Test.Utils
7 |
8 | []
9 | type SimpleAATest() =
10 | []
11 | member this.SimpleCatAA () =
12 | let e,check = prepare [ "aa!"; "bbbabbba!bbb" ]
13 | !!(e 'a') - !!(e 'a')
14 | |> check
15 |
16 | []
17 | member this.SimpleAndAA () =
18 | let e,check = prepare [ "a!"; "bbba!bbb" ]
19 | !!(e 'a') &&& !!(e 'a')
20 | |> check
21 |
22 | []
23 | member this.SimpleOrAA () =
24 | let e,check = prepare [ "a!"; "bbba!bbb" ]
25 | !!(e 'a') ||| !!(e 'a')
26 | |> check
27 |
--------------------------------------------------------------------------------
/test/simpleAB.fs:
--------------------------------------------------------------------------------
1 | namespace EvReact.Test
2 |
3 | open NUnit.Framework
4 | open EvReact
5 | open EvReact.Expr
6 | open EvReact.Test.Utils
7 |
8 | []
9 | type SimpleABTest() =
10 | []
11 | member this.SimpleCatAB () =
12 | let e,check = prepare [ "ab!"; "bbbab!"; "bbbcccaaacccaaacccb!aaabbbccc" ]
13 | !!(e 'a') - !!(e 'b')
14 | |> check
15 |
16 | []
17 | member this.SimpleAndAB () =
18 | let e,check = prepare [ "ab!"; "ba!"; "cccaaacccaaacccb!aaabbbccc" ]
19 | !!(e 'a') &&& !!(e 'b')
20 | |> check
21 |
22 | []
23 | member this.SimpleAndBA () =
24 | let e,check = prepare [ "ab!"; "ba!"; "cccaaacccaaacccb!aaabbbccc" ]
25 | !!(e 'b') &&& !!(e 'a')
26 | |> check
27 |
28 | []
29 | member this.SimpleOrAB () =
30 | let e,check = prepare [ "a.b!"; "b.a!"; "ccca.aacccaaacccb!aaabbbccc" ]
31 | !!(e 'a') ||| !!(e 'b')
32 | |> check
33 |
34 | []
35 | member this.SimpleOrBA () =
36 | let e,check = prepare [ "a.b!"; "b.a!"; "ccca.aacccaaacccb!aaabbbccc" ]
37 | !!(e 'b') ||| !!(e 'a')
38 | |> check
39 |
--------------------------------------------------------------------------------
/test/simpleEpsilon.fs:
--------------------------------------------------------------------------------
1 | namespace EvReact.Test
2 |
3 | open NUnit.Framework
4 | open EvReact
5 | open EvReact.Expr
6 | open EvReact.Test.Utils
7 |
8 | []
9 | type SimpleEpsilonTest() =
10 | []
11 | member this.SimpleCatAEpsilon () =
12 | let e,check = prepare [ "a!"; "bbba!bbb" ]
13 | !!(e 'a') - epsilon
14 | |> check
15 |
16 | []
17 | member this.SimpleCatEpsilonA () =
18 | let e,check = prepare [ "a!"; "bbba!bbb" ]
19 | epsilon - !!(e 'a')
20 | |> check
21 |
22 | []
23 | member this.SimpleAndAEpsilon () =
24 | let e,check = prepare [ "a!"; "bbba!bbb" ]
25 | !!(e 'a') &&& epsilon
26 | |> check
27 |
28 | []
29 | member this.SimpleAndEpsilonA () =
30 | let e,check = prepare [ "a!"; "bbba!bbb" ]
31 | epsilon &&& !!(e 'a')
32 | |> check
33 |
34 | []
35 | member this.SimpleOrAEpsilon () =
36 | let e,check = prepare [ ".a!"; ".bbba!bbb" ]
37 | !!(e 'a') ||| epsilon
38 | |> check
39 |
40 | []
41 | member this.SimpleOrEpsilonA () =
42 | let e,check = prepare [ ".a!"; ".bbba!bbb" ]
43 | epsilon ||| !!(e 'a')
44 | |> check
45 |
46 | []
47 | member this.SimpleCatEE () =
48 | let e,check = prepare [ "!"; "!bbb" ]
49 | epsilon - epsilon
50 | |> check
51 |
52 | []
53 | member this.SimpleAndEE () =
54 | let e,check = prepare [ "!"; "!bbb" ]
55 | epsilon &&& epsilon
56 | |> check
57 |
58 | []
59 | member this.SimpleOrEE () =
60 | let e,check = prepare [ "!"; "!bbb" ]
61 | epsilon ||| epsilon
62 | |> check
63 |
64 | []
65 | member this.SimpleIterEpsilon () =
66 | let e,check = prepare [ "!"; "!bbb" ]
67 | epsilon ||| epsilon
68 | |> check
69 |
--------------------------------------------------------------------------------
/test/test.fsproj:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 | Debug
6 | AnyCPU
7 | 2.0
8 | e522c6da-1e95-4612-a4b5-684c1dece0b4
9 | Library
10 | test
11 | test
12 | true
13 | v4.0
14 | test
15 |
16 |
17 | net20
18 | $(DefineConstants);FX_NO_MONITOR_REPORTS_LOCKTAKEN
19 |
20 |
21 | net40
22 |
23 |
24 | true
25 | full
26 | false
27 | false
28 | $(DefineConstants);DEBUG
29 |
30 |
31 | pdbonly
32 | true
33 | true
34 |
35 |
36 | bin\$(Configuration)\$(TargetFrameworkOutputDirectory)
37 | obj\$(Configuration)\$(TargetFrameworkOutputDirectory)
38 | 3
39 | bin\$(Configuration)\evReact.XML
40 |
41 |
42 | 11
43 |
44 |
45 |
46 |
47 | $(MSBuildExtensionsPath32)\..\Microsoft SDKs\F#\3.0\Framework\v4.0\Microsoft.FSharp.Targets
48 |
49 |
50 |
51 |
52 | $(MSBuildExtensionsPath32)\Microsoft\VisualStudio\v$(VisualStudioVersion)\FSharp\Microsoft.FSharp.Targets
53 |
54 |
55 |
56 |
57 |
58 |
59 |
60 |
61 |
62 |
63 |
64 |
65 |
66 |
67 |
68 |
69 |
70 |
71 |
72 |
73 | ..\packages\NUnit.2.6.3\lib\nunit.framework.dll
74 | True
75 |
76 |
77 |
78 |
79 | evReact
80 | {20d72b7f-696d-478e-837c-9415c4e20808}
81 | True
82 |
83 |
84 |
91 |
92 |
--------------------------------------------------------------------------------
/test/utils.fs:
--------------------------------------------------------------------------------
1 | namespace EvReact.Test
2 |
3 | open EvReact
4 | open NUnit.Framework
5 |
6 | module Utils =
7 | let serializationClone<'T> (x:'T) =
8 | use stream = new System.IO.MemoryStream()
9 | let formatter = new System.Runtime.Serialization.Formatters.Binary.BinaryFormatter()
10 | formatter.Serialize(stream, x)
11 | stream.Flush()
12 | stream.Position <- 0L
13 | formatter.Deserialize(stream) :?> 'T
14 |
15 | let prepare patterns =
16 | let events = new System.Collections.Generic.Dictionary<_,_>()
17 | for pattern in patterns do
18 | for v in pattern do
19 | if System.Char.IsLetter(v) && not (events.ContainsKey(v)) then
20 | events.[v] <- Event.create(string v)
21 |
22 | let check expr =
23 | for pattern in patterns do
24 | let matchCount = ref 0
25 | let receivedArgs = ref null
26 | let update args =
27 | matchCount := !matchCount + 1
28 | receivedArgs := args
29 |
30 | let orch = Orchestrator.createDebug()
31 | let mutable expectedMatchCount = 0
32 | let mutable expectedArgs = null
33 | let mutable sentArgs = obj()
34 | let mutable expectedEmpty = false
35 | let mutable net = expr |> Expr.react update |> Expr.start sentArgs orch
36 |
37 | let find v = Seq.exists ((=) v)
38 | let mutable prefix = sprintf "%A <- " net
39 |
40 | for v in pattern do
41 | prefix <- prefix + string(v)
42 |
43 | // 0 indicates net termination, with no match
44 | // . indicates match without net termination
45 | // ! indicates match and net termination together
46 | // letters indicate event triggers
47 |
48 | if find v "0!" then
49 | expectedEmpty <- true
50 |
51 | if find v ".!" then
52 | expectedArgs <- sentArgs
53 | expectedMatchCount <- expectedMatchCount + 1
54 |
55 | Assert.AreEqual(expectedEmpty, orch.IsEmpty,
56 | "{0}\n{1} Bad state", prefix, sprintf "%A" net)
57 | Assert.AreEqual(expectedMatchCount, !matchCount,
58 | "{0}\n{1} Bad match count", prefix, sprintf "%A" net)
59 | Assert.AreEqual(expectedArgs, !receivedArgs,
60 | "{0}\n{1} Bad arguments", prefix, sprintf "%A" net)
61 |
62 | if not (find v "0.!") then
63 | sentArgs <- obj()
64 | events.[v].Trigger(sentArgs)
65 |
66 | Expr.stop net
67 | Assert.IsTrue(orch.IsEmpty,
68 | "{0}\n{1} Could not stop net", prefix, sprintf "%A" net)
69 |
70 | let ievents = new System.Collections.Generic.Dictionary<_,_>()
71 | for e in events do
72 | ievents.[e.Key] <- e.Value.Publish
73 | let getevent v = ievents.[v]
74 | getevent,check
75 |
--------------------------------------------------------------------------------
/typescript/Makefile:
--------------------------------------------------------------------------------
1 | TSCFLAGS = --noImplicitAny --target ES5
2 |
3 | all: evreact.js test
4 |
5 | clean:
6 | -rm *.js
7 |
8 | test: test.js
9 | @if node test.js ; then echo "Test passed" ; else echo "Test failed" ; fi
10 |
11 | evreact.js: evreact.ts
12 | tsc $(TSCFLAGS) --out $@ $^
13 |
14 | test.js: test.ts
15 | tsc $(TSCFLAGS) --out $@ $^
16 |
17 | .PHONY: all clean test
18 |
--------------------------------------------------------------------------------
/typescript/evreact.ts:
--------------------------------------------------------------------------------
1 | module collections {
2 | "use strict"
3 | // TODO:
4 | // high performance collection implementations
5 |
6 | export interface ILessFunction {
7 | (a: T, b: T): boolean;
8 | }
9 |
10 | export interface IEqualsFunction {
11 | (a: T, b: T): boolean;
12 | }
13 |
14 | export interface IHashFunction {
15 | (a: T): number;
16 | }
17 |
18 | export interface IIterator {
19 | next(): { value: T; done: boolean };
20 | }
21 |
22 | export interface IIterable {
23 | iterator(): IIterator;
24 | }
25 |
26 | function arrayIterator(array: T[]) : IIterator {
27 | var a = array.slice();
28 | var i = 0;
29 | return {
30 | next: () =>
31 | {
32 | var done = i === a.length;
33 | var value : T;
34 | if (!done) {
35 | value = a[i];
36 | i++;
37 | }
38 | return { value: value, done: done };
39 | }
40 | };
41 | }
42 |
43 | export class Queue {
44 | private _values: T[] = [];
45 |
46 | get size() {
47 | return this._values.length;
48 | }
49 |
50 | dequeue() {
51 | return this._values.shift();
52 | }
53 |
54 | enqueue(v: T) {
55 | this._values.push(v);
56 | }
57 | }
58 |
59 | export class Map {
60 | private _keys: T[] = [];
61 | private _values: U[] = [];
62 |
63 | constructor(private equals: IEqualsFunction,
64 | private hash: IHashFunction) { }
65 |
66 | private lookup(key: T) {
67 | for (var i = 0; i < this._keys.length; i++)
68 | if (this.equals(key, this._keys[i]))
69 | return i;
70 |
71 | return -1;
72 | }
73 |
74 | get size() {
75 | return this._keys.length;
76 | }
77 |
78 | clear() {
79 | this._keys = [];
80 | this._values = [];
81 | }
82 |
83 | delete(key: T) {
84 | var idx = this.lookup(key);
85 | if (idx === -1)
86 | return false;
87 |
88 | this._keys.splice(idx, 1);
89 | this._values.splice(idx, 1);
90 | return true;
91 | }
92 |
93 | entries() : IIterator<{ key: T; value: U }>{
94 | var keys = this._keys.slice();
95 | var values = this._values.slice();
96 | var i = 0;
97 | return {
98 | next: () =>
99 | {
100 | var done = i === keys.length;
101 | var value : { key: T; value: U };
102 | if (!done) {
103 | value = { key: keys[i], value: values[i] };
104 | i++;
105 | }
106 | return { value: value, done: done };
107 | }
108 | };
109 | }
110 |
111 | forEach(callback: (value: U, key: T, map: Map) => void, thisArg?: any) {
112 | // TODO: prevent changes during iteration
113 | for (var i = 0; i < this._keys.length; i++)
114 | callback.call(thisArg, this._values[i], this._keys[i], this);
115 | }
116 |
117 | get(key: T) : U {
118 | var idx = this.lookup(key);
119 | if (idx === -1)
120 | return undefined;
121 |
122 | return this._values[idx];
123 | }
124 |
125 | has(key: T) {
126 | var idx = this.lookup(key);
127 | return idx !== -1;
128 | }
129 |
130 | keys() {
131 | return arrayIterator(this._keys);
132 | }
133 |
134 | set(key: T, value: U) {
135 | var idx = this.lookup(key);
136 | if (idx === -1) {
137 | this._keys.push(key);
138 | this._values.push(value);
139 | } else {
140 | this._values[idx] = value;
141 | }
142 |
143 | return this;
144 | }
145 |
146 | values() {
147 | return arrayIterator(this._values);
148 | }
149 | }
150 |
151 | function imul(a: number, b: number) {
152 | var ah = (a >>> 16) & 0xffff;
153 | var al = a & 0xffff;
154 | var bh = (b >>> 16) & 0xffff;
155 | var bl = b & 0xffff;
156 | // the shift by 0 fixes the sign on the high part
157 | // the final |0 converts the unsigned value into a signed value
158 | return ((al * bl) + (((ah * bl + al * bh) << 16) >>> 0)|0);
159 | }
160 |
161 | export function setContentEquals(a: Set, b: Set) {
162 | if (a.size !== b.size || a.currentHash !== b.currentHash)
163 | return false;
164 |
165 | var iter = a.values();
166 | var v = iter.next();
167 | while (!v.done) {
168 | if (!b.has(v.value))
169 | return false;
170 | v = iter.next();
171 | }
172 |
173 | return true;
174 | }
175 |
176 | export function setHashFunction(set: Set) {
177 | var r = set.currentHash ^ 2166136261;
178 | return imul(r, 16777619);
179 | }
180 |
181 | export class Set {
182 | private _values: T[] = [];
183 | public currentHash = 0;
184 |
185 | constructor(private equals: IEqualsFunction,
186 | private hash: IHashFunction) { }
187 |
188 | private lookup(value: T) {
189 | for (var i = 0; i < this._values.length; i++)
190 | if (this.equals(value, this._values[i]))
191 | return i;
192 |
193 | return -1;
194 | }
195 |
196 | get size() {
197 | return this._values.length;
198 | }
199 |
200 | add(value: T) {
201 | var h = this.hash(value);
202 | var idx = this.lookup(value);
203 | if (idx === -1) {
204 | this._values.push(value);
205 | this.currentHash ^= h;
206 | }
207 |
208 | return this;
209 | }
210 |
211 | clear() {
212 | this._values = [];
213 | this.currentHash = 0;
214 | }
215 |
216 | delete(value: T) {
217 | var h = this.hash(value);
218 | var idx = this.lookup(value);
219 | if (idx === -1)
220 | return false;
221 |
222 | this._values.splice(idx, 1);
223 | this.currentHash ^= h;
224 | return true;
225 | }
226 |
227 | entries() : IIterator<{ key: T; value: T }>{
228 | var values = this._values.slice();
229 | var i = 0;
230 | return {
231 | next: () =>
232 | {
233 | var done = i === values.length;
234 | var value : { key: T; value: T };
235 | if (!done) {
236 | value = { key: values[i], value: values[i] };
237 | i++;
238 | }
239 | return { value: value, done: done };
240 | }
241 | };
242 | }
243 |
244 | forEach(callback: (value: T, key: T, set: Set) => void, thisArg?: any) {
245 | // TODO: prevent changes during iteration
246 | for (var i = 0; i < this._values.length; i++)
247 | callback.call(thisArg, this._values[i], this._values[i], this);
248 | }
249 |
250 | has(key: T) {
251 | var idx = this.lookup(key);
252 | return idx !== -1;
253 | }
254 |
255 | values() {
256 | return arrayIterator(this._values);
257 | }
258 |
259 | toString() {
260 | return "[ " + this._values.join(", ") + " ]";
261 | }
262 | }
263 |
264 | function swap(a: T[], i: number, j: number) {
265 | var tmp = a[i];
266 | a[i] = a[j];
267 | a[j] = tmp;
268 | }
269 |
270 | export class BinaryHeap {
271 | private values: T[] = [];
272 |
273 | constructor(private less: ILessFunction) { }
274 |
275 | get size() {
276 | return this.values.length;
277 | }
278 |
279 | dequeue() {
280 | var r = this.values[0];
281 | var n = this.size - 1;
282 |
283 | this.values[0] = this.values[n];
284 | this.values.pop();
285 |
286 | var i = 0;
287 | while (true) {
288 | var left = i << 1;
289 | var right = left + 1;
290 |
291 | if (right < n &&
292 | this.less(this.values[right], this.values[i]) &&
293 | this.less(this.values[right], this.values[left]))
294 | {
295 | swap(this.values, i, right);
296 | i = right;
297 | } else if (left < n &&
298 | this.less(this.values[left], this.values[i]))
299 | {
300 | swap(this.values, i, left);
301 | i = left;
302 | } else {
303 | return r;
304 | }
305 | }
306 | }
307 |
308 | enqueue(v: T) {
309 | var i = this.size;
310 | var parent = i >>> 1;
311 |
312 | this.values.push(v);
313 |
314 | while (i > 0 && this.less(this.values[i], this.values[parent])) {
315 | swap(this.values, i, parent);
316 | i = parent;
317 | parent = i >>> 1;
318 | }
319 | }
320 | }
321 | }
322 |
323 | module evreact {
324 | "use strict"
325 |
326 | var uid = 0;
327 |
328 | export interface IUniqueId {
329 | uid: number;
330 | }
331 |
332 | interface IPriority extends IUniqueId {
333 | priority: number;
334 | }
335 |
336 | function imul(a: number, b: number) {
337 | var ah = (a >>> 16) & 0xffff;
338 | var al = a & 0xffff;
339 | var bh = (b >>> 16) & 0xffff;
340 | var bl = b & 0xffff;
341 | // the shift by 0 fixes the sign on the high part
342 | // the final |0 converts the unsigned value into a signed value
343 | return ((al * bl) + (((ah * bl + al * bh) << 16) >>> 0)|0);
344 | }
345 |
346 | function hashInt(a: number) {
347 | var r = a ^ 2166136261;
348 | return imul(r, 16777619);
349 | }
350 |
351 | function hashUniqueId(a: IUniqueId) {
352 | return hashInt(a.uid);
353 | }
354 |
355 | function identicalEquals(a: T, b: T) {
356 | return a === b;
357 | }
358 |
359 | function comparePriority(a: IPriority, b: IPriority) {
360 | return a.priority < b.priority;
361 | }
362 |
363 |
364 | class PrioritySet {
365 | private queue = new collections.BinaryHeap(comparePriority);
366 | private set = new collections.Set(identicalEquals, hashUniqueId);
367 |
368 | get size() {
369 | return this.queue.size;
370 | }
371 |
372 | clear() {
373 | if (this.size !== 0)
374 | throw "Illegal state"
375 | this.set.clear();
376 | }
377 |
378 | dequeue() {
379 | return this.queue.dequeue();
380 | }
381 |
382 | enqueue(v: T) {
383 | if (!this.set.has(v)) {
384 | this.set.add(v);
385 | this.queue.enqueue(v);
386 | }
387 | }
388 | }
389 |
390 | export interface IDisposable {
391 | dispose(): void;
392 | }
393 |
394 | export interface IHandler extends IUniqueId {
395 | handleEvent(args: T): void;
396 | }
397 |
398 | export interface IEvent extends IUniqueId {
399 | addHandler(handler: IHandler): void;
400 | removeHandler(handler: IHandler): void;
401 | }
402 |
403 | export interface ITriggerableEvent extends IEvent {
404 | trigger(e: T): void;
405 | }
406 |
407 | export module event {
408 | class SingleEventTarget implements IEvent {
409 | public uid = uid++;
410 | private listeners = new collections.Set>(identicalEquals, hashUniqueId);
411 | private args: T;
412 |
413 | constructor(private name?: string) { }
414 |
415 | private triggerLoop(listener: IHandler) {
416 | listener.handleEvent(this.args);
417 | }
418 |
419 | trigger(e: T) {
420 | this.args = e;
421 | this.listeners.forEach(this.triggerLoop, this);
422 | this.args = null;
423 | }
424 |
425 | addHandler(handler: IHandler) {
426 | this.listeners.add(handler);
427 | }
428 |
429 | removeHandler(handler: IHandler) {
430 | this.listeners.delete(handler);
431 | }
432 |
433 | toString() {
434 | return this.name + "[" + this.uid + "]";
435 | }
436 | }
437 |
438 | // Workaround wrong EventTarget definition.
439 | // See https://typescript.codeplex.com/workitem/45
440 | export interface EventTarget {
441 | removeEventListener(type: string, listener: { handleEvent: Function; }, useCapture?: boolean): void;
442 | removeEventListener(type: string, listener: Function, useCapture?: boolean): void;
443 | addEventListener(type: string, listener: { handleEvent: Function; }, useCapture?: boolean): void;
444 | addEventListener(type: string, listener: Function, useCapture?: boolean): void;
445 | dispatchEvent(evt: Event): boolean;
446 | }
447 |
448 | class EventTargetWrapper implements IEvent {
449 | public uid = uid++;
450 | constructor(private target: EventTarget,
451 | private type: string) { }
452 |
453 | addHandler(handler: IHandler) {
454 | this.target.addEventListener(this.type, handler);
455 | }
456 |
457 | removeHandler(handler: IHandler) {
458 | this.target.removeEventListener(this.type, handler);
459 | }
460 | }
461 |
462 | export function create(name?: string) : ITriggerableEvent {
463 | return new SingleEventTarget(name);
464 | }
465 |
466 | export function wrap(target: EventTarget, type: string) : IEvent {
467 | return new EventTargetWrapper(target, type);
468 | }
469 | }
470 |
471 | interface INotifiable {
472 | notifyDeactivation(aux: number, args: T): void;
473 | notifyMatch(aux: number, args: T): void;
474 | notifyUnmatch(aux: number, args: T): void;
475 | }
476 |
477 | class SimpleNet implements IDisposable, IUniqueId {
478 | public uid = uid++;
479 |
480 | private matching = false;
481 |
482 | public parent: INotifiable;
483 | public aux = 0;
484 |
485 | constructor(public orch: SealedOrchestrator,
486 | public priority: number) { }
487 |
488 | setMatching(v: boolean, args:T) {
489 | if (v)
490 | this.parent.notifyMatch(this.aux, args);
491 | else if (this.matching)
492 | this.parent.notifyUnmatch(this.aux, args);
493 | this.matching = v;
494 | }
495 |
496 | start(args:T) {
497 | throw "Abstract method";
498 | }
499 |
500 | stop() {
501 | throw "Abstract method";
502 | }
503 |
504 | dispose() {
505 | this.stop();
506 | }
507 | }
508 |
509 | export interface Orchestrator {
510 | }
511 |
512 | export interface DebugOrchestrator extends Orchestrator {
513 | isEmpty: boolean;
514 | onEvent: IEvent>;
515 | onStepBegin: IEvent>;
516 | onStepEnd: IEvent>;
517 | }
518 |
519 | class SealedOrchestrator implements Orchestrator {
520 | private evaluating = false;
521 |
522 | private dispatchers = new collections.Map, Dispatcher>(identicalEquals, hashUniqueId);
523 | private muxers = new collections.Map>, Muxer>(collections.setContentEquals, collections.setHashFunction);
524 |
525 | private eventQueue = new collections.Queue>();
526 | private argsQueue = new collections.Queue()
527 | private args: T;
528 |
529 | private activeGroundTerms = new collections.Set>(identicalEquals, hashUniqueId);
530 | private activeOperators = new PrioritySet>();
531 | private disablingOperators = new PrioritySet>();
532 | private callbacks = new PrioritySet>();
533 |
534 | get isEmpty() {
535 | return this.dispatchers.size == 0 && this.muxers.size == 0;
536 | }
537 |
538 | enqueueGroundTerm(net: GroundTermNet) {
539 | this.activeGroundTerms.add(net);
540 | }
541 |
542 | enqueueOpEval(net: OperatorNet) {
543 | this.activeOperators.enqueue(net);
544 | }
545 |
546 | enqueueNotifyDisable(net: OperatorNet) {
547 | this.disablingOperators.enqueue(net);
548 | }
549 |
550 | enqueueCallback(net: CallbackNet) {
551 | this.callbacks.enqueue(net);
552 | }
553 |
554 | dispatcher(event: IEvent) {
555 | var d = this.dispatchers.get(event);
556 | if (d === undefined) {
557 | d = new Dispatcher(this, event);
558 | this.dispatchers.set(event, d);
559 | }
560 | return d;
561 | }
562 |
563 | private muxer(events: collections.Set>) {
564 | var m = this.muxers.get(events);
565 | if (m === undefined) {
566 | m = new Muxer(this, events);
567 | this.muxers.set(events, m);
568 | }
569 | return m;
570 | }
571 |
572 | subscribe(events: collections.Set>) {
573 | return new Subscription(this.muxer(events));
574 | }
575 |
576 | unsubscribeDispatcher(event: IEvent) {
577 | this.dispatchers.delete(event);
578 | }
579 |
580 | unsubscribeMuxer(events: collections.Set>) {
581 | this.muxers.delete(events);
582 | }
583 |
584 | enqueueEvent(event: IEvent, args: T) {
585 | if (this.evaluating) {
586 | this.eventQueue.enqueue(event);
587 | this.argsQueue.enqueue(args);
588 | } else {
589 | this.evaluating = true;
590 | while (true) {
591 | this.evalEvent(event, args);
592 | if (this.eventQueue.size === 0) {
593 | this.evaluating = false;
594 | return;
595 | }
596 | event = this.eventQueue.dequeue();
597 | args = this.argsQueue.dequeue();
598 | }
599 | }
600 | }
601 |
602 | private evalEventLoop(net: GroundTermNet) {
603 | net.eval(this.args);
604 | }
605 |
606 | evalEvent(event: IEvent, args: T) {
607 | if (event !== null)
608 | this.dispatchers.get(event).evalEvent(args);
609 |
610 | this.args = args;
611 | this.activeGroundTerms.forEach(this.evalEventLoop, this);
612 | this.activeGroundTerms.clear();
613 | this.args = null;
614 |
615 | while (this.activeOperators.size !== 0) {
616 | var net = this.activeOperators.dequeue();
617 | net.setMatching(net.isMatching(), args);
618 | }
619 | this.activeOperators.clear();
620 |
621 | while (this.disablingOperators.size !== 0) {
622 | var net = this.disablingOperators.dequeue();
623 | if (net.active.size === 0)
624 | net.parent.notifyDeactivation(net.aux, args);
625 | }
626 | this.disablingOperators.clear();
627 |
628 | while (this.callbacks.size !== 0) {
629 | var callbacknet = this.callbacks.dequeue();
630 | callbacknet.cb(args);
631 | }
632 | this.callbacks.clear();
633 | }
634 | }
635 |
636 | class IEventArgsPair {
637 | constructor(public event:IEvent,
638 | public args:T) { }
639 | }
640 |
641 | class SealedDebugOrchestrator extends SealedOrchestrator implements DebugOrchestrator {
642 | public onEvent = event.create>();
643 | public onStepBegin = event.create>();
644 | public onStepEnd = event.create>();
645 |
646 | enqueueEvent(event: IEvent, args: T) {
647 | this.onEvent.trigger(new IEventArgsPair(event, args));
648 | super.enqueueEvent(event, args);
649 | }
650 |
651 | evalEvent(event: IEvent, args: T) {
652 | this.onStepBegin.trigger(new IEventArgsPair(event, args));
653 | super.evalEvent(event, args);
654 | this.onStepEnd.trigger(new IEventArgsPair(event, args));
655 | }
656 | }
657 |
658 | class Dispatcher implements IUniqueId, IHandler {
659 | public uid = uid++;
660 |
661 | private active = new collections.Set>(identicalEquals, hashUniqueId);
662 | private inactive = new collections.Set>(identicalEquals, hashUniqueId);
663 | private deactivate: Muxer[];
664 | private args : T;
665 |
666 | constructor(private orch: SealedOrchestrator,
667 | private event: IEvent) { }
668 |
669 | handleEvent(args: T) {
670 | this.orch.enqueueEvent(this.event, args);
671 | }
672 |
673 | evalEventLoop(m: Muxer) {
674 | if (m.evalEvent(this, this.args))
675 | this.deactivate.push(m);
676 | }
677 |
678 | evalEvent(args: T) {
679 | this.args = args;
680 | this.deactivate = [];
681 | this.active.forEach(this.evalEventLoop, this);
682 | for (var i = 0; i < this.deactivate.length; i++) {
683 | this.active.delete(this.deactivate[i]);
684 | this.inactive.add(this.deactivate[i]);
685 | }
686 | this.deactivate = null;
687 | this.args = null;
688 | if (this.active.size === 0)
689 | this.event.removeHandler(this);
690 | }
691 |
692 | attach(mux: Muxer) {
693 | if (this.active.size === 0)
694 | this.event.addHandler(this);
695 | this.inactive.delete(mux);
696 | this.active.add(mux);
697 | }
698 |
699 | detach(mux: Muxer) {
700 | this.inactive.delete(mux);
701 | this.active.delete(mux);
702 | if (this.active.size === 0) {
703 | this.event.removeHandler(this);
704 | if (this.inactive.size === 0)
705 | this.orch.unsubscribeDispatcher(this.event);
706 | }
707 | }
708 |
709 | toString() {
710 | return this.event.toString();
711 | }
712 | }
713 |
714 | class Muxer implements IUniqueId {
715 | public uid = uid++;
716 |
717 | private activeSubscriptions = new collections.Set>(identicalEquals, hashUniqueId);
718 | private inactiveSubscriptions = new collections.Set>(identicalEquals, hashUniqueId);
719 |
720 | private enabledDispatchers = new collections.Set>(identicalEquals, hashUniqueId);
721 | private disabledDispatchers = new collections.Set>(identicalEquals, hashUniqueId);
722 |
723 | private args : T;
724 |
725 | private constructorLoop(e: IEvent) {
726 | this.disabledDispatchers.add(this.orch.dispatcher(e));
727 | }
728 |
729 | constructor(private orch: SealedOrchestrator,
730 | private events: collections.Set>) {
731 | this.events.forEach(this.constructorLoop, this);
732 | }
733 |
734 | private evalEventLoop(s: Subscription) {
735 | s.evalEventFun(s.evalEventObj, this.args);
736 | }
737 |
738 | evalEvent(dispatcher: Dispatcher, args: T) {
739 | var r = this.activeSubscriptions.size === 0;
740 | if (r) {
741 | this.enabledDispatchers.delete(dispatcher);
742 | this.disabledDispatchers.add(dispatcher);
743 | } else {
744 | this.args = args;
745 | this.activeSubscriptions.forEach(this.evalEventLoop, this);
746 | this.args = null;
747 | }
748 | return r;
749 | }
750 |
751 | private enableLoop(d: Dispatcher) {
752 | d.attach(this);
753 | this.enabledDispatchers.add(d);
754 | }
755 |
756 | enable(subscription: Subscription) {
757 | if (this.activeSubscriptions.size === 0) {
758 | this.disabledDispatchers.forEach(this.enableLoop, this);
759 | this.disabledDispatchers.clear();
760 | }
761 | this.inactiveSubscriptions.delete(subscription);
762 | this.activeSubscriptions.add(subscription);
763 | }
764 |
765 | disable(subscription: Subscription) {
766 | this.activeSubscriptions.delete(subscription);
767 | this.inactiveSubscriptions.add(subscription);
768 | }
769 |
770 | private unsubscribeLoop(d: Dispatcher) {
771 | d.detach(this);
772 | }
773 |
774 | unsubscribe(subscription: Subscription) {
775 | this.activeSubscriptions.delete(subscription);
776 | this.inactiveSubscriptions.delete(subscription);
777 | if (this.activeSubscriptions.size === 0 &&
778 | this.inactiveSubscriptions.size === 0)
779 | {
780 | this.enabledDispatchers.forEach(this.unsubscribeLoop, this);
781 | this.disabledDispatchers.forEach(this.unsubscribeLoop, this);
782 | this.orch.unsubscribeMuxer(this.events);
783 | }
784 | }
785 |
786 | toString() {
787 | return this.events.toString();
788 | }
789 | }
790 |
791 | class Subscription implements IUniqueId {
792 | public uid = uid++;
793 | public evalEventFun: (obj: any, e: T) => void; // should be (obj: GroundTermNet, e: T) => void
794 | public evalEventObj: GroundTermNet;
795 |
796 | constructor(private mux: Muxer) { }
797 |
798 | enable() {
799 | this.mux.enable(this);
800 | }
801 |
802 | disable() {
803 | this.mux.disable(this);
804 | }
805 |
806 | dispose() {
807 | this.mux.unsubscribe(this);
808 | }
809 |
810 | toString() {
811 | return this.mux.toString();
812 | }
813 | }
814 |
815 | class UnaryOperatorNet extends SimpleNet implements INotifiable {
816 | constructor(orch: SealedOrchestrator,
817 | public subnet: SimpleNet) {
818 | super(orch, 1 + subnet.priority);
819 |
820 | subnet.parent = this;
821 | }
822 |
823 | start(args: T) {
824 | this.subnet.start(args);
825 | }
826 |
827 | stop() {
828 | this.subnet.stop();
829 | }
830 |
831 | notifyDeactivation(aux: number, args: T) {
832 | this.parent.notifyDeactivation(this.aux, args);
833 | }
834 |
835 | notifyMatch (aux: number, args: T) {
836 | this.setMatching(true, args);
837 | }
838 |
839 | notifyUnmatch(aux: number, args: T) {
840 | this.setMatching(false, args);
841 | }
842 | }
843 |
844 | class CallbackNet extends UnaryOperatorNet {
845 | constructor(orch: SealedOrchestrator,
846 | subnet: SimpleNet,
847 | public cb: (e: T) => void) {
848 | super(orch, subnet);
849 | }
850 | }
851 |
852 | class ReactNet extends CallbackNet {
853 | constructor(orch: SealedOrchestrator,
854 | subnet: SimpleNet,
855 | cb: (e: T) => void) {
856 | super(orch, subnet, cb);
857 | }
858 |
859 | notifyMatch (aux: number, args: T) {
860 | this.orch.enqueueCallback(this);
861 | this.setMatching(true, args);
862 | }
863 |
864 | toString() {
865 | return "(" + this.subnet + ") |-> ...";
866 | }
867 | }
868 |
869 | class FinallyNet extends CallbackNet {
870 | constructor(orch: SealedOrchestrator,
871 | subnet: SimpleNet,
872 | cb: (e: T) => void) {
873 | super(orch, subnet, cb);
874 | }
875 |
876 | notifyDeactivation (aux: number, args: T) {
877 | this.orch.enqueueCallback(this);
878 | }
879 |
880 | toString() {
881 | return "(" + this.subnet + ") |=> ...";
882 | }
883 | }
884 |
885 | class IterNet extends UnaryOperatorNet {
886 | notifyMatch (aux: number, args: T) {
887 | this.start(args);
888 | this.setMatching(true, args);
889 | }
890 |
891 | toString() {
892 | return "+(" + this.subnet + ")";
893 | }
894 | }
895 |
896 | class GroundTermNet extends SimpleNet {
897 | private active = false;
898 | private successful = false;
899 |
900 | private pos : Subscription