Ported code to ClojureCLR. Moving to macro implementation of reactive.
This commit is contained in:
parent
d14d32f363
commit
f86b74beff
8 changed files with 356 additions and 37 deletions
2
src-clr/freactive/.gitignore
vendored
Normal file
2
src-clr/freactive/.gitignore
vendored
Normal file
|
@ -0,0 +1,2 @@
|
||||||
|
bin/
|
||||||
|
obj/
|
36
src-clr/freactive/Properties/AssemblyInfo.cs
Normal file
36
src-clr/freactive/Properties/AssemblyInfo.cs
Normal file
|
@ -0,0 +1,36 @@
|
||||||
|
using System.Reflection;
|
||||||
|
using System.Runtime.CompilerServices;
|
||||||
|
using System.Runtime.InteropServices;
|
||||||
|
|
||||||
|
// General Information about an assembly is controlled through the following
|
||||||
|
// set of attributes. Change these attribute values to modify the information
|
||||||
|
// associated with an assembly.
|
||||||
|
[assembly: AssemblyTitle("freactive")]
|
||||||
|
[assembly: AssemblyDescription("")]
|
||||||
|
[assembly: AssemblyConfiguration("")]
|
||||||
|
[assembly: AssemblyCompany("Microsoft")]
|
||||||
|
[assembly: AssemblyProduct("freactive")]
|
||||||
|
[assembly: AssemblyCopyright("Copyright © Microsoft 2014")]
|
||||||
|
[assembly: AssemblyTrademark("")]
|
||||||
|
[assembly: AssemblyCulture("")]
|
||||||
|
|
||||||
|
// Setting ComVisible to false makes the types in this assembly not visible
|
||||||
|
// to COM components. If you need to access a type in this assembly from
|
||||||
|
// COM, set the ComVisible attribute to true on that type.
|
||||||
|
[assembly: ComVisible(false)]
|
||||||
|
|
||||||
|
// The following GUID is for the ID of the typelib if this project is exposed to COM
|
||||||
|
[assembly: Guid("a1ded10c-a69d-44a7-8c43-619d9bcc10cc")]
|
||||||
|
|
||||||
|
// Version information for an assembly consists of the following four values:
|
||||||
|
//
|
||||||
|
// Major Version
|
||||||
|
// Minor Version
|
||||||
|
// Build Number
|
||||||
|
// Revision
|
||||||
|
//
|
||||||
|
// You can specify all the values or you can default the Build and Revision Numbers
|
||||||
|
// by using the '*' as shown below:
|
||||||
|
// [assembly: AssemblyVersion("1.0.*")]
|
||||||
|
[assembly: AssemblyVersion("1.0.0.0")]
|
||||||
|
[assembly: AssemblyFileVersion("1.0.0.0")]
|
115
src-clr/freactive/Reactive.cs
Normal file
115
src-clr/freactive/Reactive.cs
Normal file
|
@ -0,0 +1,115 @@
|
||||||
|
using System;
|
||||||
|
using clojure.lang;
|
||||||
|
|
||||||
|
namespace freactive
|
||||||
|
{
|
||||||
|
public class Reactive : ARef
|
||||||
|
{
|
||||||
|
private readonly AtomicBoolean dirty = new AtomicBoolean(true);
|
||||||
|
|
||||||
|
protected readonly AtomicReference<object> state = new AtomicReference<object>(null);
|
||||||
|
|
||||||
|
protected IFn func;
|
||||||
|
|
||||||
|
public Reactive(IFn func)
|
||||||
|
{
|
||||||
|
this.func = func;
|
||||||
|
sully = new Sully(this);
|
||||||
|
registerDepInst = new RegisterDep(this);
|
||||||
|
}
|
||||||
|
|
||||||
|
public static readonly Var REGISTER_DEP = Var.intern(Namespace.findOrCreate(Symbol.intern("freactive.core")),
|
||||||
|
Symbol.intern("*register-dep*"), null, false).setDynamic();
|
||||||
|
|
||||||
|
public static void registerDep(IRef aref)
|
||||||
|
{
|
||||||
|
var v = REGISTER_DEP.deref();
|
||||||
|
if(v != null)
|
||||||
|
{
|
||||||
|
((RegisterDep)v).register(aref);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
class RegisterDep : AFn
|
||||||
|
{
|
||||||
|
private readonly Reactive parent;
|
||||||
|
|
||||||
|
public RegisterDep(Reactive parent)
|
||||||
|
{
|
||||||
|
this.parent = parent;
|
||||||
|
}
|
||||||
|
|
||||||
|
public void register(IRef aref)
|
||||||
|
{
|
||||||
|
aref.addWatch(parent.sully, parent.sully);
|
||||||
|
}
|
||||||
|
|
||||||
|
public override object invoke(object obj)
|
||||||
|
{
|
||||||
|
var aref = obj as IRef;
|
||||||
|
if (aref == null) return null;
|
||||||
|
register(aref);
|
||||||
|
return null;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
private readonly RegisterDep registerDepInst;
|
||||||
|
|
||||||
|
class Sully : AFn
|
||||||
|
{
|
||||||
|
private readonly Reactive parent;
|
||||||
|
|
||||||
|
public Sully(Reactive parent)
|
||||||
|
{
|
||||||
|
this.parent = parent;
|
||||||
|
}
|
||||||
|
|
||||||
|
public override object invoke(object key, object aref, object oldVal, object newVal)
|
||||||
|
{
|
||||||
|
((IRef) aref).removeWatch(key);
|
||||||
|
if(parent.dirty.compareAndSet(false, true))
|
||||||
|
{
|
||||||
|
var cur = parent.state.Get();
|
||||||
|
parent.NotifyWatches(cur, cur);
|
||||||
|
}
|
||||||
|
return null;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
private readonly Sully sully;
|
||||||
|
|
||||||
|
protected object compute()
|
||||||
|
{
|
||||||
|
return func.invoke();
|
||||||
|
}
|
||||||
|
|
||||||
|
public override object deref()
|
||||||
|
{
|
||||||
|
registerDep(this);
|
||||||
|
|
||||||
|
if(!dirty.get())
|
||||||
|
return state.Get();
|
||||||
|
|
||||||
|
try
|
||||||
|
{
|
||||||
|
Var.pushThreadBindings(RT.map(REGISTER_DEP, registerDepInst));
|
||||||
|
for(;;)
|
||||||
|
{
|
||||||
|
dirty.set(false);
|
||||||
|
var v = state.Get();
|
||||||
|
var newv = compute();
|
||||||
|
Validate(newv);
|
||||||
|
if(state.CompareAndSet(v, newv))
|
||||||
|
{
|
||||||
|
NotifyWatches(v, newv);
|
||||||
|
return newv;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
finally
|
||||||
|
{
|
||||||
|
Var.popThreadBindings();
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
21
src-clr/freactive/ReactiveAtom.cs
Normal file
21
src-clr/freactive/ReactiveAtom.cs
Normal file
|
@ -0,0 +1,21 @@
|
||||||
|
using clojure.lang;
|
||||||
|
|
||||||
|
namespace freactive
|
||||||
|
{
|
||||||
|
public class ReactiveAtom : Atom
|
||||||
|
{
|
||||||
|
public ReactiveAtom(object state) : base(state)
|
||||||
|
{
|
||||||
|
}
|
||||||
|
|
||||||
|
public ReactiveAtom(object state, IPersistentMap meta) : base(state, meta)
|
||||||
|
{
|
||||||
|
}
|
||||||
|
|
||||||
|
public override object deref()
|
||||||
|
{
|
||||||
|
Reactive.registerDep(this);
|
||||||
|
return base.deref();
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
68
src-clr/freactive/core.clj
Normal file
68
src-clr/freactive/core.clj
Normal file
|
@ -0,0 +1,68 @@
|
||||||
|
(ns freactive.core
|
||||||
|
(:refer-clojure
|
||||||
|
:exclude [atom agent ref])
|
||||||
|
(:import [freactive ReactiveAtom Reactive]))
|
||||||
|
|
||||||
|
(defn atom
|
||||||
|
"Creates and returns an Atom with an initial value of x and zero or
|
||||||
|
more options (in any order):
|
||||||
|
|
||||||
|
:meta metadata-map
|
||||||
|
|
||||||
|
:validator validate-fn
|
||||||
|
|
||||||
|
If metadata-map is supplied, it will become the metadata on the
|
||||||
|
atom. validate-fn must be nil or a side-effect-free fn of one
|
||||||
|
argument, which will be passed the intended new state on any state
|
||||||
|
change. If the new state is unacceptable, the validate-fn should
|
||||||
|
return false or throw an exception."
|
||||||
|
{:added "1.0"
|
||||||
|
:static true}
|
||||||
|
([x] (new ReactiveAtom x))
|
||||||
|
([x & options] (#'clojure.core/setup-reference (atom x) options)))
|
||||||
|
|
||||||
|
(defn reactive [f & options]
|
||||||
|
(#'clojure.core/setup-reference (Reactive. f) options))
|
||||||
|
|
||||||
|
(import '(System.Timers Timer))
|
||||||
|
|
||||||
|
;; (defn test1 []
|
||||||
|
;; (let [a (atom 0)
|
||||||
|
;; b (atom 0)
|
||||||
|
;; c (reactive (fn [] (+ @a @b)))
|
||||||
|
;; d (atom 0)
|
||||||
|
;; e (reactive (fn [] (+ @c @d)))
|
||||||
|
;; f (reactive (fn [] (if (even? @a) @b @c)))
|
||||||
|
;; task (proxy [TimerTask] []
|
||||||
|
;; (run [] @f @e @c ))]
|
||||||
|
;; (. (new Timer ) (schedule task (long 1)))
|
||||||
|
;; (println "Reactive")
|
||||||
|
;; (time
|
||||||
|
;; (dotimes [i 2000000]
|
||||||
|
;; (swap! a inc)
|
||||||
|
;; (swap! b inc)
|
||||||
|
;; (swap! d inc)))
|
||||||
|
;; (assert (= (+ @a @b) @c)
|
||||||
|
;; (= (+ @c @d) @e))))
|
||||||
|
|
||||||
|
;; (test1)
|
||||||
|
|
||||||
|
;; (defn test2 []
|
||||||
|
;; (let [a (atom 0)
|
||||||
|
;; b (atom 0)
|
||||||
|
;; c (fn [] (+ @a @b))
|
||||||
|
;; d (atom 0)
|
||||||
|
;; e (fn [] (+ (c) @d))
|
||||||
|
;; f (fn [] (if (even? @a) @b (c)))
|
||||||
|
;; task (proxy [TimerTask] []
|
||||||
|
;; (run [] (f) (e) (c)))]
|
||||||
|
;; (. (new Timer) (schedule task (long 1)))
|
||||||
|
;; (println "Non-reactive")
|
||||||
|
;; (time
|
||||||
|
;; (dotimes [i 2000000]
|
||||||
|
;; (swap! a inc)
|
||||||
|
;; (swap! b inc)
|
||||||
|
;; (swap! d inc)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
73
src-clr/freactive/freactive.csproj
Normal file
73
src-clr/freactive/freactive.csproj
Normal file
|
@ -0,0 +1,73 @@
|
||||||
|
<?xml version="1.0" encoding="utf-8"?>
|
||||||
|
<Project ToolsVersion="4.0" DefaultTargets="Build" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||||
|
<PropertyGroup>
|
||||||
|
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
|
||||||
|
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
|
||||||
|
<ProductVersion>8.0.30703</ProductVersion>
|
||||||
|
<SchemaVersion>2.0</SchemaVersion>
|
||||||
|
<ProjectGuid>{3D2DAD67-DF11-4D96-BFB4-7BE568EBB704}</ProjectGuid>
|
||||||
|
<OutputType>Library</OutputType>
|
||||||
|
<AppDesignerFolder>Properties</AppDesignerFolder>
|
||||||
|
<RootNamespace>freactive</RootNamespace>
|
||||||
|
<AssemblyName>freactive</AssemblyName>
|
||||||
|
<TargetFrameworkVersion>v4.0</TargetFrameworkVersion>
|
||||||
|
<FileAlignment>512</FileAlignment>
|
||||||
|
<SolutionDir Condition="$(SolutionDir) == '' Or $(SolutionDir) == '*Undefined*'">..\..\..\..\</SolutionDir>
|
||||||
|
<RestorePackages>true</RestorePackages>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
|
||||||
|
<DebugSymbols>true</DebugSymbols>
|
||||||
|
<DebugType>full</DebugType>
|
||||||
|
<Optimize>false</Optimize>
|
||||||
|
<OutputPath>bin\Debug\</OutputPath>
|
||||||
|
<DefineConstants>DEBUG;TRACE</DefineConstants>
|
||||||
|
<ErrorReport>prompt</ErrorReport>
|
||||||
|
<WarningLevel>4</WarningLevel>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
|
||||||
|
<DebugType>pdbonly</DebugType>
|
||||||
|
<Optimize>true</Optimize>
|
||||||
|
<OutputPath>bin\Release\</OutputPath>
|
||||||
|
<DefineConstants>TRACE</DefineConstants>
|
||||||
|
<ErrorReport>prompt</ErrorReport>
|
||||||
|
<WarningLevel>4</WarningLevel>
|
||||||
|
</PropertyGroup>
|
||||||
|
<ItemGroup>
|
||||||
|
<Reference Include="Clojure">
|
||||||
|
<HintPath>..\..\..\..\packages\Clojure.1.5.0-ARC1\lib\net40\Clojure.dll</HintPath>
|
||||||
|
</Reference>
|
||||||
|
<Reference Include="Microsoft.Dynamic">
|
||||||
|
<HintPath>..\..\..\..\packages\Clojure.1.5.0-ARC1\lib\net40\Microsoft.Dynamic.dll</HintPath>
|
||||||
|
</Reference>
|
||||||
|
<Reference Include="Microsoft.Scripting">
|
||||||
|
<HintPath>..\..\..\..\packages\Clojure.1.5.0-ARC1\lib\net40\Microsoft.Scripting.dll</HintPath>
|
||||||
|
</Reference>
|
||||||
|
<Reference Include="Microsoft.Scripting.Metadata">
|
||||||
|
<HintPath>..\..\..\..\packages\Clojure.1.5.0-ARC1\lib\net40\Microsoft.Scripting.Metadata.dll</HintPath>
|
||||||
|
</Reference>
|
||||||
|
<Reference Include="System" />
|
||||||
|
<Reference Include="System.Core" />
|
||||||
|
<Reference Include="System.Xml.Linq" />
|
||||||
|
<Reference Include="System.Data.DataSetExtensions" />
|
||||||
|
<Reference Include="Microsoft.CSharp" />
|
||||||
|
<Reference Include="System.Data" />
|
||||||
|
<Reference Include="System.Xml" />
|
||||||
|
</ItemGroup>
|
||||||
|
<ItemGroup>
|
||||||
|
<Compile Include="Properties\AssemblyInfo.cs" />
|
||||||
|
<Compile Include="Reactive.cs" />
|
||||||
|
<Compile Include="ReactiveAtom.cs" />
|
||||||
|
</ItemGroup>
|
||||||
|
<ItemGroup>
|
||||||
|
<EmbeddedResource Include="core.clj" />
|
||||||
|
</ItemGroup>
|
||||||
|
<Import Project="$(MSBuildToolsPath)\Microsoft.CSharp.targets" />
|
||||||
|
<Import Project="$(SolutionDir)\.nuget\NuGet.targets" Condition="Exists('$(SolutionDir)\.nuget\NuGet.targets')" />
|
||||||
|
<!-- To modify your build process, add your task inside one of the targets below and uncomment it.
|
||||||
|
Other similar extension points exist, see Microsoft.Common.targets.
|
||||||
|
<Target Name="BeforeBuild">
|
||||||
|
</Target>
|
||||||
|
<Target Name="AfterBuild">
|
||||||
|
</Target>
|
||||||
|
-->
|
||||||
|
</Project>
|
4
src-clr/freactive/packages.config
Normal file
4
src-clr/freactive/packages.config
Normal file
|
@ -0,0 +1,4 @@
|
||||||
|
<?xml version="1.0" encoding="utf-8"?>
|
||||||
|
<packages>
|
||||||
|
<package id="Clojure" version="1.5.0.2" targetFramework="net40" />
|
||||||
|
</packages>
|
|
@ -56,44 +56,44 @@ current value. Returns newval."
|
||||||
(defn stateful-reactive [init-state f & options]
|
(defn stateful-reactive [init-state f & options]
|
||||||
(#'clojure.core/setup-reference (StatefulReactive. init-state f) options))
|
(#'clojure.core/setup-reference (StatefulReactive. init-state f) options))
|
||||||
|
|
||||||
(import '(java.util TimerTask Timer))
|
;; (import '(java.util TimerTask Timer))
|
||||||
|
|
||||||
(defn test1 []
|
;; (defn test1 []
|
||||||
(let [a (atom 0)
|
;; (let [a (atom 0)
|
||||||
b (atom 0)
|
;; b (atom 0)
|
||||||
c (reactive (fn [] (+ @a @b)))
|
;; c (reactive (fn [] (+ @a @b)))
|
||||||
d (atom 0)
|
;; d (atom 0)
|
||||||
e (reactive (fn [] (+ @c @d)))
|
;; e (reactive (fn [] (+ @c @d)))
|
||||||
f (reactive (fn [] (if (even? @a) @b @c)))
|
;; f (reactive (fn [] (if (even? @a) @b @c)))
|
||||||
task (proxy [TimerTask] []
|
;; task (proxy [TimerTask] []
|
||||||
(run [] @f @e @c ))]
|
;; (run [] @f @e @c ))]
|
||||||
(. (new Timer) (schedule task (long 1)))
|
;; (. (new Timer) (schedule task (long 1)))
|
||||||
(println "Reactive")
|
;; (println "Reactive")
|
||||||
(time
|
;; (time
|
||||||
(dotimes [i 2000000]
|
;; (dotimes [i 2000000]
|
||||||
(swap! a inc)
|
;; (swap! a inc)
|
||||||
(swap! b inc)
|
;; (swap! b inc)
|
||||||
(swap! d inc)))
|
;; (swap! d inc)))
|
||||||
(assert (= (+ @a @b) @c)
|
;; (assert (= (+ @a @b) @c)
|
||||||
(= (+ @c @d) @e))))
|
;; (= (+ @c @d) @e))))
|
||||||
|
|
||||||
(test1)
|
;; (test1)
|
||||||
|
|
||||||
(defn test2 []
|
;; (defn test2 []
|
||||||
(let [a (atom 0)
|
;; (let [a (atom 0)
|
||||||
b (atom 0)
|
;; b (atom 0)
|
||||||
c (fn [] (+ @a @b))
|
;; c (fn [] (+ @a @b))
|
||||||
d (atom 0)
|
;; d (atom 0)
|
||||||
e (fn [] (+ (c) @d))
|
;; e (fn [] (+ (c) @d))
|
||||||
f (fn [] (if (even? @a) @b (c)))
|
;; f (fn [] (if (even? @a) @b (c)))
|
||||||
task (proxy [TimerTask] []
|
;; task (proxy [TimerTask] []
|
||||||
(run [] (f) (e) (c)))]
|
;; (run [] (f) (e) (c)))]
|
||||||
(. (new Timer) (schedule task (long 1)))
|
;; (. (new Timer) (schedule task (long 1)))
|
||||||
(println "Non-reactive")
|
;; (println "Non-reactive")
|
||||||
(time
|
;; (time
|
||||||
(dotimes [i 2000000]
|
;; (dotimes [i 2000000]
|
||||||
(swap! a inc)
|
;; (swap! a inc)
|
||||||
(swap! b inc)
|
;; (swap! b inc)
|
||||||
(swap! d inc)))))
|
;; (swap! d inc)))))
|
||||||
|
|
||||||
(test2)
|
;; (test2)
|
||||||
|
|
Loading…
Reference in a new issue