////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////// /// /// Mycelium Scenes Library /// ----------------------- /// /// (c)2007-2020 Michael Schimmel /// Ehrenhainstr 40 /// 42329 Wuppertal / Germany /// info@mycelium.net /// /// All rights reserved. /// ////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////// unit Myc; interface uses {$ifdef FullDebugMode}FastMM5, {$endif} System.SysUtils, System.TypInfo, System.Generics.Collections, System.Generics.Defaults; {$minenumsize 4} type {$message hint 'Debug-Code! Const Params?'} TMyc3Combiner = reference to function( const Values: TArray ): T; TMyc3Interpolator = reference to function( Delta: Double; const StartValue: T; out Value: T ): Boolean; TMyc3TargetInterpolator = reference to function( Delta: Double; const StartValue, TargetValue: T; out Value: T ): Boolean; EMycInvalidParameter = class( Exception ) end; EMycInvalidOperation = class( Exception ) end; TConstFunc = reference to function( const aa: A ): T; TConstFunc = reference to function( const aa: A; const bb: B ): T; TConstFunc = reference to function( const aa: A; const bb: B; const cc: C ): T; TConstFunc = reference to function( const aa: A; const bb: B; const cc: C ; const dd: D ): T; TConstFunc = reference to function( const aa: A; const bb: B; const cc: C ; const dd: D; const ee: E ): T; TConstProc = reference to procedure( const aa: A ); TConstProc = reference to procedure( const aa: A; const bb: B ); TConstProc = reference to procedure( const aa: A; const bb: B; const cc: C ); TCompareValues = reference to function( const A, B: T ): Boolean; ///////////////////////////////////////////////////////////////////////////// IMycEnumerator = interface function GetCurrent: T; function MoveNext: Boolean; procedure Reset; property Current: T read GetCurrent; end; IMyc2Enumerable = interface function GetEnumerator: IMycEnumerator; end; IMycCountable = interface {$region 'property access'} function GetCount: Integer; function GetItems( Idx: Integer ): T; {$endregion} property Count: Integer read GetCount; property Items[Idx: Integer]: T read GetItems; default; end; ///////////////////////////////////////////////////////////////////////////// IAtomicStack = interface function Pop: T; function TryPop( out Item: T ): Boolean; procedure Push( const Data: T ); end; TAtomicStack = record class function Create: IAtomicStack; static; end; TProtected = record private [volatile] FItem: T; public constructor Create( const AItem: T ); function Exchange( const Value: T ): T; class operator Implicit( const Value: T ): TProtected; end; ///////////////////////////////////////////////////////////////////////////// IMyc2Sink = interface function Notify: Boolean; end; IMyc2Flag = interface( IMyc2Sink ) function Reset: Boolean; end; {$message hint 'Replace TSignalTag by IMycDeletable? '} TSignalTag = NativeInt; IMyc2Signal = interface function Advise( const Sink: IMyc2Sink ): TSignalTag; procedure Unadvise( Tag: TSignalTag ); end; IMyc2Notifier = interface( IMyc2Sink ) {$region 'property access'} function GetSignal: IMyc2Signal; {$endregion} property Signal: IMyc2Signal read GetSignal; end; IMyc2State = interface( IMyc2Signal ) {$region 'property access'} function GetIsSet: Boolean; {$endregion} property IsSet: Boolean read GetIsSet; end; IMyc2Condition = interface( IMyc2Sink ) {$region 'property access'} function GetState: IMyc2State; {$endregion} property State: IMyc2State read GetState; end; IMyc2Event = interface( IMyc2Condition ) function Reset: Boolean; end; IMycObserver = interface function GetItem: T; property Item: T read GetItem; end; IMycNotifyObserver = IMycObserver; IMycEventObserver = IMycObserver; TMycStateQueue = record private FStack: IAtomicStack; public constructor Create(const AStack: IAtomicStack); overload; class function Create: TMycStateQueue; overload; static; procedure Add( const S: IMyc2State ); procedure WaitFor; end; Signals = record private class function GetNull: IMyc2Condition; static; public class function CreateCounter( Count: Integer ): IMyc2Condition; static; class function CreateEvent( Init: Boolean = false ): IMyc2Event; overload; static; class function CreateNotifier: IMyc2Notifier; overload; static; class function CreateSink(Once: Boolean; const Proc: TProc): IMyc2Sink; overload; static; deprecated; class function CreateSink(const Proc: TProc): IMyc2Sink; overload; static; class function CreateFlag(Init: Boolean): IMyc2Flag; static; class function CreateObserver( const Signals: array of IMyc2Signal; const Sink: T ): IMycObserver; static; class function CreateNotifyObserver( const Signals: array of IMyc2Signal ): IMycNotifyObserver; overload; static; class function CreateEventObserver( const Signals: array of IMyc2Signal ): IMycEventObserver; overload; static; class function CreateNotifyObserver( const Signals: IMycCountable ): IMycNotifyObserver; overload; static; class function CreateEventObserver( const Signals: IMycCountable ): IMycEventObserver; overload; static; class function Concat( const States: array of IMyc2State ): IMyc2State; static; class function Union( const Sigs: array of IMyc2Signal ): IMyc2Signal; static; class function IsStatic( const Signal: IMyc2Signal ): Boolean; static; inline; class function MakeValid( const Signal: IMyc2Signal ): IMyc2Signal; overload; static; inline; class function MakeValid( const Signals: array of IMyc2Signal ): TArray; overload; static; class property Null: IMyc2Condition read GetNull; end; ///////////////////////////////////////////////////////////////////////////// IMyc3Value = interface {$region 'property access'} function GetValue: T; {$endregion} property Value: T read GetValue; end; TImmutable = record private FThis: IMyc3Value; function GetValue: T; inline; function GetHasValue: Boolean; inline; class function GetNull: TImmutable; static; inline; public constructor Create(const AValue: T); overload; class operator NotEqual(ALeft, ARight: TImmutable): Boolean; class operator Equal(ALeft, ARight: TImmutable): Boolean; property Value: T read GetValue; property HasValue: Boolean read GetHasValue; class property Null: TImmutable read GetNull; end; // IDEA: // Mutable objects represent exactly *one* property of a dynamic system. // As such, they provide a change signal and an immutable value // that is *replaced*, when they change. // Q: How do you maintain thread safety with such an object? // A: Reading a mutable object needs locking. There's no way around it. // But picking up a reference to an immutable can be done with almost no // overhead using atomic operations. // Given the nature of mutable objects, they should only be used within // the scope of a single thread (which does not have to be the main thread!) // Q: Is it getting any better this way? // A: mmmh... at least it offloads the application from doing this kinda stuff. // And it ensures separating data from logic. // Q: Shouldn't IMutable then be derived from IValue or from ISignal? // A: To be considered. Given that IMutable is *not* the value itself, because // IValue is immutable by definition, it seems to make more sense to derive // it from ISignal. OTOH, it isn't a signal either. Maybe it should really // stand for it's own. // Mutable objects may change over time. IMyc3Mutable = interface {$region 'property access'} function GetChanged: IMyc2Signal; {$endregion} property Changed: IMyc2Signal read GetChanged; end; // The Values of typed mutable objects are typed immutables. (And thus should // be IValue instead of T, see idea above). IMyc3Mutable = interface( IMyc3Mutable ) {$region 'property access'} function GetValue: T; {$endregion} property Value: T read GetValue; end; IMyc3ObjectLink = interface {$region 'property access'} function GetMutable: IMyc3Mutable; {$endregion} procedure Destroyed; property Mutable: IMyc3Mutable read GetMutable; end; IMyc3Validatable = interface {$region 'property access'} function GetInvalidate: IMyc2Signal; {$endregion} function Validate: Boolean; property Invalidate: IMyc2Signal read GetInvalidate; end; IMyc3Validatable = interface( IMyc3Validatable ) {$region 'property access'} function GetValue: T; {$endregion} property Value: T read GetValue; end; TValidatable = record class function FromSignal(const Signal: IMyc2Signal): IMyc3Validatable; static; end; // This is the generic base interface for futures. Futures are used to initialize // and hold immutable data. // // After the initialization is finished, the future and its value are considered // to be immutable, which means statically constant and accessing them is always // thread-safe and non-blocking. // // Reading the data before initialization is finished is not allowed! Other // threads have to wait for the initialization signal before accessing the value. // This can be done explicitly by waiting or by pipelining other futures. IMyc3Future = interface {$region 'property access'} function GetInitialized: IMyc2State; function GetValue: T; {$endregion} // Wait until initialization is finished. Being a blocking operation, this is only // allowed from the main thread. {$message hint 'Sollte nichts zurückgeben, damit es nicht in Conditionals verwendet wird!'} function WaitFor: T; // Initialization state. This state is set exactly once in the lifetime of the // future. It can be used to pipeline other futures. // property Initialized: IMyc2State read GetInitialized; // Reading the value is NOT ALLOWED until the initialization is finished, // otherwise an exception is raised. // // Use [WaitFor] to block execution until the value is ready. property Value: T read GetValue; end; IMyc3Changeable = interface {$region 'property access'} function GetMutable: IMyc3Mutable; {$endregion} procedure SetChanged; property Mutable: IMyc3Mutable read GetMutable; end; IMyc3Generic = interface( IMyc3Changeable ) {$region 'property access'} function GetFunc: TFunc; procedure SetFunc(const Value: TFunc); {$endregion} property Func: TFunc read GetFunc write SetFunc; end; IMyc3Writeable = interface( IMyc3Changeable ) function SetValue(const Value: T): Boolean; end; IMyc3ValidateMutable = interface( IMyc3Mutable ) procedure Validate; end; IMyc3Property = interface( IMyc3Mutable ) procedure Delete; overload; procedure Delete( const DefaultValue: T ); overload; end; IMyc3MutableProperty = interface( IMyc3Mutable ) {$region 'property access'} procedure SetMutable( const Value: IMyc3Mutable ); {$endregion} property Mutable: IMyc3Mutable write SetMutable; end; IMyc3MutablePropertyEx = interface( IMyc3Mutable ) procedure Invalidate; end; IMyc3Animator = interface procedure Tick( const Ticks: Int64 ); end; IMyc3Animator = interface( IMyc3Animator ) function GetCurrent: IMyc3Mutable; property Current: IMyc3Mutable read GetCurrent; end; IMycDeletable = interface procedure Delete; end; IMycArray = interface( IMyc2Enumerable ) {$region 'property access'} function GetCount: Integer; function GetItems( Idx: Integer ): T; {$endregion} function ToArray: TArray; function Sort( const Comparer: IComparer = nil; First: Integer = 0; Count: Integer = -1 ): TArray; function Divide( const Comparer: IComparer ): TArray>; function Divide1( const Comparer: IComparer ): TArray>; function Range( First: Integer; Count: Integer ): IMycArray; function Rearrange( const Indices: TArray ): IMycArray; property Count: Integer read GetCount; property Items[Idx: Integer]: T read GetItems; default; end; IMycChain = interface( IMyc2Enumerable ) {$region 'property access'} function GetChanged: IMyc2Signal; {$endregion} function AddFirst( const Item: T ): IMycDeletable; function AddLast( const Item: T ): IMycDeletable; function ToArray: TArray; property Changed: IMyc2Signal read GetChanged; end; TChain = record public class function Create: IMycChain; static; end; TMycArray = class {helper for TArray} public class function Create( const Arr: array of T ): IMycArray; overload; static; class function Create( Count: Integer; const Getter: TFunc ): IMycArray; overload; static; class function Create(const Src: IMyc2Enumerable): IMycArray; overload; static; class function Create( const Src: IMycArray; const Converter: TConstFunc ): IMycArray; overload; static; class procedure Divide1( const Src: IMycArray>; out Keys: TArray; out Values: TArray>; const Comparer: IComparer ); overload; static; class function Divide( const Src: IMycArray>; const Comparer: IComparer ): TArray>>; overload; static; class function Divide( const Src: TArray; const Comparer: IComparer ): TArray>; overload; static; class function Divide( const Src: TArray>; const Comparer: IComparer ): TArray>>; overload; static; class function GetKeys( const Arr: TArray> ): TArray; static; class function CreateConvert( const Enum: IMyc2Enumerable; const Conv: TConstFunc ): IMyc2Enumerable; end; IMyc3Set = interface( IMyc3Mutable ) function Add( const Item: S ): Integer; procedure Remove( const Item: S ); procedure Delete( Idx: Integer ); procedure Clear; end; IMycEnumerable = interface( IMyc3Mutable> ) {$region 'property access'} function GetCount: Integer; {$endregion} function GetEnumerator: IMycEnumerator; property Count: Integer read GetCount; end; IMycSetItem = interface( IMycDeletable ) {$region 'property access'} function GetValue: T; {$endregion} property Value: T read GetValue; end; IMycSet = interface( IMycEnumerable ) function Add( const Value: T ): IMycSetItem; function Pop: T; procedure Clear; end; IMycEnumArray = interface( IMycEnumerable ) {$region 'property access'} function GetItems( Idx: Integer ): T; {$endregion} function Sort( const Comparer: IComparer = nil; First: Integer = 0; Count: Integer = -1 ): IMycArray; property Items[Idx: Integer]: T read GetItems; default; end; TSet = record public class function Create: IMycSet; overload; static; class function Create( const Arr: IMyc3Mutable> ): IMycEnumArray; overload; static; class function CreateEx( const Arr: TArray ): IMycEnumArray; overload; static; end; IMycAssembly = interface( IMycSet>> ) {$region 'property access'} function GetItems: IMyc3Mutable>; {$endregion} function Add( const Value: T ): IMycDeletable; overload; function Add( const Values: array of T ): IMycDeletable; overload; property Items: IMyc3Mutable> read GetItems; end deprecated; TAssembly = record class function Create: IMycAssembly; static; end deprecated; IMycStack = interface {$region 'property access'} function GetCount: Integer; {$endregion} procedure Push( const Value: T ); function Pop: T; procedure Clear; function ToArray: TArray; property Count: Integer read GetCount; end; Stack = record class function Create: IMycStack; static; end; TFunc = reference to function( P1: U; P2: V; P3: W; P4: X; P5: Y ): T; TFunc = reference to function( P1: U; P2: V; P3: W; P4: X; P5: Y; P6: Z ): T; ///////////////////////////////////////////////////////////////////////////// // TValue // TValue = class type TCalculator = reference to procedure( var Value: T ); class var FDefaultMutable: IMyc3Mutable; FDefaultMutableFuture: IMyc3Mutable>; class constructor CreateClass; class function GetDefaultFuture: IMyc3Future; static; public class function AsImmutable( const Value: T ): IMyc3Value; overload; static; class function CreateLazy(const Func: TFunc): IMyc3Value; static; // Create a constant future. class function AsFuture( const Value: T ): IMyc3Future; static; // Create a generic future. Its fully up to the calculator to handle // synchronization. class function CreateFuture( const StartSignal: IMyc2Signal; const Calculator: TFunc ): IMyc3Future; overload; static; class function CreateFuture( const StartSignal: IMyc2Signal; const Calculator: TFunc < IMyc3Future < T >> ) : IMyc3Future; overload; static; class function CreateFutureArray( Count: Integer; const Calculator: TFunc ): IMyc3Future>; overload; static; class function CreateFutureArray( const StartSignal: IMyc2Signal; Count: Integer; const Calculator: TFunc ): IMyc3Future>; overload; static; class function CreateFutures( Count: Integer; const Src: IMyc3Future < TArray < T >> ): TArray>; overload; static; // Create a generic immutable class function CreateFuture( const Calculator: TFunc ): IMyc3Future; overload; static; class function Convert( P: IMyc3Future; const Converter: TFunc ): IMyc3Future; static; // Create an immutable from one other immutables. class function CreateFuture( P: IMyc3Future; Calculator: TFunc ): IMyc3Future; overload; static; class function CreateFuture( P: IMyc3Future; Calculator: TFunc < U, IMyc3Future < T >> ): IMyc3Future; overload; static; class function CreateFuture( P1: IMyc3Future; P2: IMyc3Future; Calculator: TFunc ): IMyc3Future; overload; static; class function CreateFuture( P1: IMyc3Future; P2: IMyc3Future; Calculator: TFunc < U, V, IMyc3Future < T >> ) : IMyc3Future; overload; static; class function CreateFuture( P1: IMyc3Future; P2: IMyc3Future; P3: IMyc3Future; Calculator: TFunc ): IMyc3Future; overload; static; // Create an immutable array from an array of immutables. class function CreateFuture( const Values: TArray < IMyc3Future < T >> ): IMyc3Future>; overload; static; class function CreateFuture( const Values: TArray>; const Calculator: TFunc ): IMyc3Future>; overload; static; // Calculate an immutable from a set of other immutables. This is a convenient // function that passes the parameter Values as typed array to the calculator. class function CreateFuture( const Params: TArray>; Calculator: TFunc, T> ): IMyc3Future; overload; static; // Create a future from the value of another future. class function CreateFuture( Future: IMyc3Future; Creator: TFunc> ): IMyc3Future; overload; static; // Execute on future init. class function Execute( Future: IMyc3Future; Proc: TConstFunc ): IMyc2State; // Get value, if future is initialized. class function TryGetValue( const Future: IMyc3Future; out Value: T ): Boolean; static; // Create a mutable from a constant value. The resulting mutable never changes. class function AsConst( const Value: T ): IMyc3Mutable; overload; static; deprecated 'use TMutable()'; class function CreateMutable( const Value: T ): IMyc3Mutable; overload; static; deprecated 'use TMutable()'; class function CreateMutable( Calculator: TFunc ): IMyc3Mutable; overload; static; experimental; class function CreateMutable( const Changed: array of IMyc2Signal; const Calculator: TFunc ): IMyc3Mutable; overload; static; deprecated 'use TMutable.FromSignals()'; class function CreateMutable(const Changed: array of IMyc2Signal; const Calculator: TFunc>): IMyc3Mutable; overload; static; deprecated 'use TMutable.FromSignals()'; // Extend a mutable by a set of signals. class function CreateMutable( const Changed: array of IMyc2Signal; const Mutable: IMyc3Mutable ): IMyc3Mutable; overload; static; class function CreateMutable( const Event: IMycEventObserver; const Calculator: TFunc ): IMyc3Mutable; overload; static; // Futures as mutables class function AsMutable( const Value: IMyc3Mutable> ): IMyc3Mutable; overload; static; class function AsMutable( const Value: IMyc3Mutable> ): IMyc3Mutable; overload; static; class function AsMutable(const Value: IMyc3Future): IMyc3Mutable; overload; static; class function AsMutable(const Value: IMyc3Mutable>): IMyc3Mutable; overload; static; // Operators class function CreateMutable( P: IMyc3Mutable; Calculator: TFunc ): IMyc3Mutable; overload; static; class function CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; Calculator: TFunc ) : IMyc3Mutable; overload; static; class function CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; P3: IMyc3Mutable; Calculator: TFunc ): IMyc3Mutable; overload; static; class function CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; P3: IMyc3Mutable; P4: IMyc3Mutable; Calculator: TFunc ): IMyc3Mutable; overload; static; class function CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; P3: IMyc3Mutable; P4: IMyc3Mutable; P5: IMyc3Mutable; Calculator: TFunc ): IMyc3Mutable; overload; static; class function CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; P3: IMyc3Mutable; P4: IMyc3Mutable; P5: IMyc3Mutable; P6: IMyc3Mutable; Calculator: TFunc ): IMyc3Mutable; overload; static; // Mutable arrays class function CreateMutable( const Arr: TArray < IMyc3Mutable < T >> ): IMyc3Mutable>; overload; static; deprecated 'Mutable.CreateArray'; class function CreateMutable( const Arr: TArray>; Calculator: TFunc ): IMyc3Mutable>; overload; static; class function CreateMutableEx( Params: TArray>; Calculator: TFunc, T> ): IMyc3Mutable; overload; static; experimental; {$message hint 'Debug-Code! Eigentlich ist das hier das wahre Lazy-Mutable'} class function CreateGeneric(const Calculator: TFunc = nil): IMyc3Generic; // Create a mutable, that supports direct changes to it's value. class function CreateWriteable: IMyc3Writeable; overload; static; class function CreateWriteable( const InitValue: T ): IMyc3Writeable; overload; static; class function CreateWriteable( const InitValue: T; const EqualityComparison: TEqualityComparison ): IMyc3Writeable; overload; static; class function CreateValidate( const Calculator: TFunc ): IMyc3ValidateMutable; static; class function CreateMutableProperty(const InitValue: IMyc3Mutable = nil): IMyc3MutableProperty; overload; static; experimental; class function CreateProperty( const Creator: TFunc < IMyc3Mutable < T >> ): IMyc3MutablePropertyEx; overload; static; experimental; class function CreatePropertyEx( const Decorated: IMyc3Mutable ): IMyc3Property; overload; static; // Combining values class function Combine( Values: TArray; Combiner: TMyc3Combiner ): IMyc3Future; overload; static; class function Combine(const Values: TArray>; Combiner: TMyc3Combiner): IMyc3Mutable; overload; static; class function Combine( const Values: TArray>; Combiner: TMyc3Combiner ): IMyc3Future; overload; static; class function CreateSet: IMycSet; overload; static; class function WaitFor( Future: IMyc3Future ): T; overload; static; class procedure WaitFor( const Futures: TArray>; Exec: TProc ); overload; static; class function Capture( const Src: TArray ): TArray; experimental; class function CreateAnimator( const Target: IMyc3Mutable; const Interpolator: TMyc3TargetInterpolator ) : IMyc3Animator; overload; static; class function CreateAnimator( const Init: T; const ChangeSignal: IMyc2Signal; const Interpolator: TMyc3Interpolator ) : IMyc3Animator; overload; static; class function MakeValid( const Value: IMyc3Future ): IMyc3Future; overload; static; inline; class function MakeValid( const Value: IMyc3Mutable ): IMyc3Mutable; overload; static; inline; class property DefaultFuture: IMyc3Future read GetDefaultFuture; class property DefaultMutable: IMyc3Mutable read FDefaultMutable; class property DefaultMutableFuture: IMyc3Mutable> read FDefaultMutableFuture; end; TMutableFuture = record private class var FNull: IMyc3Mutable>; class function GetNull: IMyc3Mutable>; static; class constructor CreateClass; public class function Create( const P: IMyc3Mutable>; Calc: TFunc ): IMyc3Mutable>; static; class property Null: IMyc3Mutable> read GetNull; end; IMyc3MutableCache = interface( IMyc3Mutable ) {$region 'property access'} function GetCount: Integer; {$endregion} function Add( const Value: IMyc3Mutable ): IMyc3Mutable; procedure Clear; procedure Validate; function GetEnumerator: IMycEnumerator>; property Count: Integer read GetCount; end; IMyc3MutableTable = interface procedure Clear; end; IMyc3MutableTable = interface( IMyc3MutableTable ) function Add( const Value: T ): IMyc3Mutable; end; TMutableCache = record private FThis: IMyc3MutableTable; function GetItem(const Value: T): IMyc3Mutable; public constructor Create( const AThis: IMyc3MutableTable ); procedure Clear; property Item[const Value: T]: IMyc3Mutable read GetItem; default; end; TMutable = record private FThis: IMyc3Mutable; public class function FromSignals(const Changed: array of IMyc2Signal; const Calculator: TFunc): IMyc3Mutable; overload; static; class function FromSignals(const Changed: array of IMyc2Signal; const Calculator: TFunc>): IMyc3Mutable; overload; static; class function From(const Value: IMyc3Mutable; const Conv: TFunc>): TMutable; overload; static; class operator Explicit(const Value: T): TMutable; class operator Implicit(const Item: IMyc3Mutable): TMutable; class operator Implicit(const Item: TMutable): IMyc3Mutable; end; TMutableFuture = record // Arrays class function FromArray(const Value: TArray>>): IMyc3Mutable>>; overload; static; end; TFuture = record class function From(const Value: IMyc3Future; const Conv: TFunc): IMyc3Future; overload; static; class function From(const Value: IMyc3Future; const Conv: TFunc>): IMyc3Future; overload; static; class function FromArray(const Value: TArray>): IMyc3Future>; overload; static; class function Combine( const Value: TArray>; const Calculator: TFunc, T> ): IMyc3Future; overload; static; class function Merge(const Parts: TArray>): TArray; overload; static; class function Merge(const Parts: TArray>>): IMyc3Future>; overload; static; end; Mutable = record // convert class function Convert(const Value: IMyc3Mutable; const Conv: TFunc): IMyc3Mutable; overload; static; class function Convert(const Value: IMyc3Mutable>; const Conv: TFunc): IMyc3Mutable>; overload; static; class function Convert(const Value: IMyc3Mutable>; const Conv: TFunc>): IMyc3Mutable>; overload; static; // enclose class function From(const Value: T): IMyc3Mutable; overload; static; class function From(const Value: IMyc3Mutable; const Conv: TFunc>): IMyc3Mutable; overload; static; class function From(const ValueR: IMyc3Mutable; const ValueS: IMyc3Mutable; const Conv: TFunc>): IMyc3Mutable; overload; static; // Arrays class function FromArray(const Value: TArray>): IMyc3Mutable>; overload; static; class function FromArray(const Value: IMyc3Mutable>; const Conv: TFunc): IMyc3Mutable>; overload; static; class function FromArray(const Value: IMyc3Mutable>; const Conv: TFunc>): IMyc3Mutable>; overload; static; class function FilterArray(const Values: IMyc3Mutable>; const FilterFunc: TConstFunc>): IMyc3Mutable>; static; class function SortArray(const Values: IMyc3Mutable>; const Comparer: IComparer): IMyc3Mutable>; static; class function TrimArray(const Values: IMyc3Mutable>): IMyc3Mutable>; static; // bool class function Create( Value: Boolean ): IMyc3Mutable; overload; static; class function True: IMyc3Mutable; overload; static; deprecated 'use TMutableBool'; class function False: IMyc3Mutable; overload; static; deprecated 'use TMutableBool'; class function OpOR(const Arr: TArray>): IMyc3Mutable; static; deprecated 'use TMutableBool'; class function OpAND(const Arr: TArray>): IMyc3Mutable; static; deprecated 'use TMutableBool'; class function OpNOR(const Arr: TArray>): IMyc3Mutable; static; deprecated 'use TMutableBool'; class function OpNAND(const Arr: TArray>): IMyc3Mutable; static; deprecated 'use TMutableBool'; class function OpNOT(const A: IMyc3Mutable): IMyc3Mutable; static; deprecated 'use TMutableBool'; class function IfThen(const Condition: IMyc3Mutable; const TrueValue: IMyc3Mutable): IMyc3Mutable; overload; static; class function IfThen(const Condition: IMyc3Mutable; const TrueValue: IMyc3Mutable>): IMyc3Mutable>; overload; static; class function IfNotThen(const Condition: IMyc3Mutable; const FalseValue: IMyc3Mutable): IMyc3Mutable; static; class function IfThenElse(const Condition: IMyc3Mutable; const TrueValue, FalseValue: IMyc3Mutable): IMyc3Mutable; static; class function CreateOverride(const Value, Ovrride: IMyc3Mutable>): IMyc3Mutable>; overload; static; class function FromSignal(const Signal: IMyc2Signal): IMyc3Mutable; static; class function FromState(const State: IMyc2State): IMyc3Mutable; static; class function CreateValidator( const Comparer: IComparer = nil ): IMyc3MutableCache; static; class function CreateCache( const Comparer: IComparer = nil ): TMutableCache; static; class function CreateEventObserver(const Mutables: TArray>): IMycEventObserver; static; class function CreateNotifyObserver(const Mutables: TArray>): IMycNotifyObserver; static; class function ExtractSignals(const Mutables: TArray>): IMyc2Signal; static; class function CreateAssembly(const Arr: IMyc3Mutable>>): IMyc3Mutable>; overload; static; class function CreateAssembly(const Arr: IMyc3Mutable>>>): IMyc3Mutable>>; overload; static; class function CreateAssembly(const Arr: IMyc3Mutable>>; const Creator: TFunc, T>): IMyc3Mutable; overload; static; class function CreateAssembly(const Arr: IMyc3Mutable>>>; const Creator: TFunc, T>): IMyc3Mutable>; overload; static; class function CreateAssembly(const Arr: IMyc3Mutable>>; const Creator: TFunc, S>): IMyc3Mutable; overload; static; class function CreateAssembly(const Arr: IMyc3Mutable>>>; const Creator: TFunc, S>): IMyc3Mutable>; overload; static; class function ConvertSet(const Arr: IMyc3Mutable>>; const Converter: TFunc): IMyc3Mutable>>; overload; static; class function ConvertSet(const Arr: IMyc3Mutable>>>; const Converter: TFunc): IMyc3Mutable< TArray< IMyc3Mutable>>>; overload; static; class function Merge(const Parts: IMyc3Mutable>>): IMyc3Mutable>; overload; static; class function Merge(const Parts: IMyc3Mutable>>>): IMyc3Mutable>>; overload; static; class function CreateObjectLink(Obj: T): IMyc3ObjectLink; static; class function CreateNullable: IMyc3Writeable>; static; end; TMutableBool = record private FThis: IMyc3Mutable; class function GetDefaults(Value: Boolean): IMyc3Mutable; static; inline; public constructor Create(const AThis: IMyc3Mutable); class operator LogicalNot(const Value: TMutableBool): TMutableBool; class operator LogicalAnd(const A, B: TMutableBool): TMutableBool; class operator LogicalOr(const A, B: TMutableBool): TMutableBool; class operator Equal(const A, B: TMutableBool): TMutableBool; class operator NotEqual(const A, B: TMutableBool): TMutableBool; class operator Implicit(const Value: IMyc3Mutable): TMutableBool; inline; class operator Implicit(const Value: TMutableBool): IMyc3Mutable; inline; class property Defaults[Value: Boolean]: IMyc3Mutable read GetDefaults; class function True: IMyc3Mutable; static; inline; class function False: IMyc3Mutable; static; inline; property This: IMyc3Mutable read FThis; end; Mutable = class private class function GetComparer: IComparer>; static; inline; public class function Default: IMyc3Mutable; static; inline; class function IfThen( const Condition: IMyc3Mutable; const TrueValue: IMyc3Mutable ): IMyc3Mutable; static; deprecated; class function IfNotThen( const Condition: IMyc3Mutable; const FalseValue: IMyc3Mutable ): IMyc3Mutable; static; deprecated; class function IfThenElse( const Condition: IMyc3Mutable; const TrueValue, FalseValue: IMyc3Mutable ): IMyc3Mutable; static; deprecated; class function CreateArray( const Arr: TArray> ): IMyc3Mutable>; overload; static; class function CreateArray( const Arr: IMyc3Mutable>; Calculator: TFunc ): IMyc3Mutable>; overload; static; class property Comparer: IComparer> read GetComparer; end; TMyc2ComputeProperty = record private FDone: IMyc2State; FValue: T; public constructor Create( const StartSignal: IMyc2Signal; const Creator: TFunc ); function Value: T; inline; procedure Terminate; inline; property Done: IMyc2State read FDone; end; ///////////////////////////////////////////////////////////////////////////// // IMyc2TaskFactory // IMyc2TaskFactory = interface {$region 'property access'} function GetThreadCount: Integer; {$endregion} function CreateThread( const Proc: TProc ): IMyc2State; function InMainThread: Boolean; function InWorkerThread: Boolean; function Run( StartCount: Integer; Proc: TProc ): IMyc2Sink; procedure Teardown; procedure WaitFor( State: IMyc2State ); property ThreadCount: Integer read GetThreadCount; end; TMyc3Tasks = class( TObject ) private FApi: IMyc2TaskFactory; FEnabled: Boolean; function GetInMainThread: Boolean; function GetThreadCount: Integer; procedure SetEnabled( const Value: Boolean ); procedure Run( const StartSignal: IMyc2Signal; const Proc: TProc ); overload; procedure Run( const Proc: TProc ); overload; public constructor Create( const AApi: IMyc2TaskFactory ); destructor Destroy; override; function CreateThread( const Proc: TProc ): IMyc2State; procedure ExpectSignaled( State: IMyc2State; const Msg: String = 'Expected state to be already set' ); function LoopUntil( const DoneSignal: IMyc2Signal; const Proc: TFunc ): IMyc2State; function ParallelFor(const StartSignal: IMyc2Signal; LowVal, HighVal, Slice: Integer; const Proc: TProc): IMyc2State; overload; procedure ParallelFor(LowVal, HighVal, Slice: Integer; const Proc: TProc); overload; function Start( const StartSignal: IMyc2Signal; const Proc: TFunc ): IMyc2State; overload; function Start( const StartSignal: IMyc2Signal; Proc: TProc ): IMyc2State; overload; function Start( const StartSignal: IMyc2Signal; P1: T1; Proc: TProc ): IMyc2State; overload; function Start( const StartSignal: IMyc2Signal; P1: T1; P2: T2; Proc: TProc ): IMyc2State; overload; function Start( const Proc: TFunc ): IMyc2State; overload; function Start( const Proc: TProc ): IMyc2State; overload; function Enqueue( var Queue: IMyc2State; const Proc: TFunc ): IMyc2State; overload; function Enqueue( var Queue: IMyc2State; const Proc: TProc ): IMyc2State; overload; function Capture( P: T; Proc: TProc ): TProc; overload; function Capture( P1: T; P2: R; Proc: TProc ): TProc; overload; function Capture( P1: T; P2: R; P3: U; Proc: TProc ): TProc; overload; function Capture( P: T; Proc: TFunc ): TFunc; overload; function Capture( P: T; Proc: TFunc ): TFunc; overload; function Capture( P: T; Proc: TFunc ): TFunc; overload; procedure WaitFor( const State: IMyc2State ); property InMainThread: Boolean read GetInMainThread; property ThreadCount: Integer read GetThreadCount; property Enabled: Boolean write SetEnabled; end; TTag = record strict private FManaged: IInterface; FOrdinal: Int64; {$ifdef DEBUG} FTypeInfo: PTypeInfo; {$endif} public class function From(const Data: T): TTag; static; function AsType: T; end; // Parameters TParameterValue = record strict private FMutable: IMyc3Mutable; {$ifdef DEBUG} FTypeInfo: PTypeInfo; procedure CheckType(TI: PTypeInfo); {$endif} public constructor Create( ATypeInfo: PTypeInfo; const AMutable: IMyc3Mutable ); overload; function Get: T; class function Create( const Intf: T ): TParameterValue; overload; static; class function Create( const Intf: IMyc3Mutable ): TParameterValue; overload; static; class function Compare( const A, B: TParameterValue ): Integer; static; class function FromArray( const Values: TArray ): TArray>; overload; static; class function FromVarRec( const VarRec: TVarRec ): TParameterValue; static; constructor Assign( const Src: TParameterValue ); function AsType: IMyc3Mutable; property Mutable: IMyc3Mutable read FMutable; end; TFieldID = Integer; TParameterField = record private FID: TFieldID; FValue: TParameterValue; public constructor Create( AID: TFieldID; const AValue: TParameterValue ); overload; class function Create( ID: TFieldID; const Intf: T ): TParameterField; overload; static; class function Create( ID: TFieldID; const Intf: IMyc3Mutable ): TParameterField; overload; static; property ID: TFieldID read FID; property Value: TParameterValue read FValue write FValue; end; IMycParameterRecordDefinition = interface {$region 'property access'} function GetByName(const Caption: String): Integer; function GetCount: Integer; function GetFields( Idx: Integer ): TFieldID; function GetIdx: Integer; {$endregion} function IndexOf( Field: TFieldID ): Integer; property ByName[const Caption: String]: Integer read GetByName; property Count: Integer read GetCount; property Fields[Idx: Integer]: TFieldID read GetFields; property Idx: Integer read GetIdx; end; IMyc3ParameterRecord = interface {$region 'property access'} function GetByName(const Caption: String): TParameterValue; function GetDef: IMycParameterRecordDefinition; function GetValues(ID: TFieldID): TParameterValue; {$endregion} function GetEnumerator: TEnumerator; property ByName[const Caption: String]: TParameterValue read GetByName; property Def: IMycParameterRecordDefinition read GetDef; property Values[ID: TFieldID]: TParameterValue read GetValues; default; end; TParameterRecord = record private FThis: IMyc3ParameterRecord; function GetValues(ID: TFieldID): TParameterValue; inline; function GetByName( const Caption: String ): TParameterValue; inline; function GetDef: IMycParameterRecordDefinition; inline; public constructor Create( const AThis: IMyc3ParameterRecord ); function AsType( ID: TFieldID ): IMyc3Mutable; inline; function Get(ID: TFieldID): T; inline; class operator Implicit(const Item: IMyc3ParameterRecord): TParameterRecord; class operator Implicit(const Item: TParameterRecord): IMyc3ParameterRecord; property Def: IMycParameterRecordDefinition read GetDef; property Values[ID: TFieldID]: TParameterValue read GetValues; default; property ByName[const Caption: String]: TParameterValue read GetByName; end; IMycParameterSpace = interface {$region 'property access'} function GetFieldCount: Integer; function GetDefaultValues( FieldID: TFieldID ): TParameterValue; function GetCaptions( FieldID: TFieldID ): String; function GetComparer( FieldID: TFieldID ): IComparer; function GetByName(const Caption: String): TFieldID; {$endregion} function AddField( TypInfo: PTypeInfo; const Caption: String; const DefaultValue: IMyc3Mutable; const Comparer: IComparer ): TFieldID; function CompareValues( FieldID: TFieldID; const A, B: TParameterValue ): Integer; function CreateRecord(const Fields: TArray): IMyc3ParameterRecord; function CreateDef(const Fields: TArray): IMycParameterRecordDefinition; property DefaultValues[FieldID: TFieldID]: TParameterValue read GetDefaultValues; property Captions[FieldID: TFieldID]: String read GetCaptions; property Comparer[FieldID: TFieldID]: IComparer read GetComparer; property ByName[const Caption: String]: TFieldID read GetByName; property FieldCount: Integer read GetFieldCount; end; TParameterSpace = record private FThis: IMycParameterSpace; function GetFieldCount: Integer; inline; function GetDefaultValues( FieldID: TFieldID ): TParameterValue; inline; function GetCaptions( FieldID: TFieldID ): String; inline; function GetComparer( FieldID: TFieldID ): IComparer; inline; public constructor Create( const AThis: IMycParameterSpace ); overload; class function Create: TParameterSpace; overload; static; { TODO : ->Factory (mit D11 managed records) } function AddField(const Caption: String; const DefaultValue: T; const Comparer: IComparer = nil): TFieldID; function CompareValues( FieldID: TFieldID; const A, B: TParameterValue ): Integer; function CreateRecord( const Fields: TArray ): TParameterRecord; function CreateDef(const Fields: TArray): IMycParameterRecordDefinition; class operator Implicit( const Item: TParameterSpace ): IMycParameterSpace; class operator Implicit( const Item: IMycParameterSpace ): TParameterSpace; property FieldCount: Integer read GetFieldCount; property DefaultValues[FieldID: TFieldID]: TParameterValue read GetDefaultValues; property Captions[FieldID: TFieldID]: String read GetCaptions; property Comparer[FieldID: TFieldID]: IComparer read GetComparer; end; type TStackTrace = record const Len = 64; var Msg: String; StackTrace: array [0..Len-1] of NativeUInt; constructor Create(ASkipFrames: Cardinal; const AMsg: String = ''); function ToText: String; end; var Tasks: TMyc3Tasks; procedure RaiseInvalidParameter( const Msg: String = '' ); procedure RaiseNullPointer; procedure RaiseInvalidOperation( const Msg: String = '' ); overload; procedure RaiseInvalidOperation( const Msg: String; const Args: array of const ); overload; procedure ForEach( Count: Integer; Exec: TProc ); overload; procedure ForEach( Count1, Count2: Integer; Exec: TProc ); overload; procedure ForEach( Count1, Count2, Count3: Integer; Exec: TProc ); overload; procedure ForEach( LowIdx, HighIdx: Integer; Exec: TProc ); overload; implementation uses System.Classes, System.SyncObjs, System.SysConst, System.Math, Myc.Signals, Myc.Tasks, Myc.Values, Myc.Values.Sets, Myc.Values.Validate, Myc.Values.Properties, Myc.Values.Bool, Myc.Atomic, Myc.Future.Arrays, Myc.Values.Parameter; procedure RaiseInvalidParameter( const Msg: String = '' ); var Str: String; begin Str := 'Invalid parameter'; if Msg <> '' then Str := Str + ' (' + Msg + ')'; raise EMycInvalidParameter.Create( Str ); end; procedure RaiseNullPointer; begin RaiseInvalidParameter( 'null pointer' ); end; procedure RaiseInvalidOperation( const Msg: String ); overload; begin RaiseInvalidOperation( Msg, [] ); end; procedure RaiseInvalidOperation( const Msg: String; const Args: array of const ); overload; begin if Msg = '' then raise EMycInvalidOperation.Create( 'Invalid operation' ) else raise EMycInvalidOperation.CreateFmt( 'Invalid operation: ' + Msg, Args ) end; procedure ForEach( Count: Integer; Exec: TProc ); var i: Integer; begin for i := 0 to Count - 1 do Exec( i ); end; procedure ForEach( Count1, Count2: Integer; Exec: TProc ); var i, j: Integer; begin for i := 0 to Count1 - 1 do for j := 0 to Count2 - 1 do Exec( i, j ); end; procedure ForEach( Count1, Count2, Count3: Integer; Exec: TProc ); var i, j, k: Integer; begin for i := 0 to Count1 - 1 do for j := 0 to Count2 - 1 do for k := 0 to Count3 - 1 do Exec( i, j, k ); end; procedure ForEach( LowIdx, HighIdx: Integer; Exec: TProc ); overload; var i: Integer; begin for i := LowIdx to HighIdx do Exec( i ); end; { TMyc3Tasks } constructor TMyc3Tasks.Create( const AApi: IMyc2TaskFactory ); begin inherited Create; FApi := AApi; FEnabled := True; end; destructor TMyc3Tasks.Destroy; begin FApi.Teardown; inherited; end; function TMyc3Tasks.Capture( P1: T; P2: R; P3: U; Proc: TProc ): TProc; begin Result := procedure begin Proc( P1, P2, P3 ); end; end; function TMyc3Tasks.Capture( P: T; Proc: TFunc ): TFunc; begin Result := function: R begin Result := Proc( P ); end; end; function TMyc3Tasks.Capture( P1: T; P2: R; Proc: TProc ): TProc; begin Result := procedure begin Proc( P1, P2 ); end; end; function TMyc3Tasks.Capture( P: T; Proc: TFunc ): TFunc; begin Result := function( Q: U ): R begin Result := Proc( P, Q ); end; end; function TMyc3Tasks.Capture( P: T; Proc: TFunc ): TFunc; begin Result := function( Q: U; R: V ): R begin Result := Proc( P, Q, R ); end; end; function TMyc3Tasks.Capture( P: T; Proc: TProc ): TProc; begin Result := procedure begin Proc( P ); end; end; function TMyc3Tasks.CreateThread( const Proc: TProc ): IMyc2State; begin Result := FApi.CreateThread( Proc ); end; { TSet } class function TSet.Create: IMycSet; begin Result := TMycSet.Create; end; class function TSet.CreateEx( const Arr: TArray ): IMycEnumArray; begin Result := TMycEnumArray.CreateStatic( Arr ); end; class function TSet.Create( const Arr: IMyc3Mutable> ): IMycEnumArray; begin Result := TMycEnumArray.CreateMutable( Arr ); end; { TFuture } class function TFuture.From(const Value: IMyc3Future; const Conv: TFunc): IMyc3Future; begin Result := TMyc3Future.CreateFuture( Value.Initialized, function: T begin Result := Conv( Value.Value ); end ); end; class function TFuture.Combine(const Value: TArray>; const Calculator: TFunc, T>): IMyc3Future; begin Result := TValue.CreateFuture( Value, Calculator ); end; class function TFuture.From(const Value: IMyc3Future; const Conv: TFunc>): IMyc3Future; begin Result := TMyc3Future.CreateFuture( Value.Initialized, function: IMyc3Future begin Result := Conv( Value.Value ); end ); end; class function TFuture.FromArray(const Value: TArray>): IMyc3Future>; begin Result := TMyc3FutureArrayEx.Create( Value ); end; class function TFuture.Merge(const Parts: TArray>): TArray; var i, j, n: Integer; begin n := 0; for i := 0 to High(Parts) do inc( n, Length(Parts[i]) ); SetLength( Result, n ); n := 0; for i := 0 to High(Parts) do begin for j := 0 to High(Parts[i]) do begin Result[n] := Parts[i,j]; inc(n); end; end; end; class function TFuture.Merge(const Parts: TArray>>): IMyc3Future>; begin if Length(Parts) = 0 then Result := TValue>.DefaultFuture else if Length(Parts) = 1 then Result := Parts[0] else Result := TValue>.CreateFuture>>( TValue>.CreateFuture( Parts ), function( Parts: TArray> ): TArray begin Result := Merge( Parts ); end ); end; { TMutableFuture } class constructor TMutableFuture.CreateClass; begin FNull := TValue>.CreateMutable( TValue.DefaultFuture ); end; class function TMutableFuture.Create( const P: IMyc3Mutable>; Calc: TFunc ): IMyc3Mutable>; begin Result := TValue>.CreateMutable>( P, function( P: IMyc3Future ): IMyc3Future begin Result := TValue.CreateFuture( P, function( P: T ): S begin Result := Calc( P ); end ); end ); end; class function TMutableFuture.GetNull: IMyc3Mutable>; begin Result := FNull; end; { TImmutable } constructor TImmutable.Create(const AValue: T); begin FThis := TMyc3Value.Create( AValue ); end; function TImmutable.GetValue: T; begin if FThis<>nil then Result := FThis.Value else Result := Default(T); end; function TImmutable.GetHasValue: Boolean; begin Result := FThis<>nil; end; class function TImmutable.GetNull: TImmutable; begin Result := Default(TImmutable); end; class operator TImmutable.Equal(ALeft, ARight: TImmutable): Boolean; begin if ALeft.HasValue and ARight.HasValue then Result := TEqualityComparer.Default.Equals(ALeft.Value, ARight.Value) else Result := ALeft.HasValue = ARight.HasValue; end; class operator TImmutable.NotEqual(ALeft, ARight: TImmutable): Boolean; begin if ALeft.HasValue and ARight.HasValue then Result := not TEqualityComparer.Default.Equals(ALeft.Value, ARight.Value) else Result := ALeft.HasValue <> ARight.HasValue; end; { TMyc3Tasks } function TMyc3Tasks.Enqueue( var Queue: IMyc2State; const Proc: TFunc ): IMyc2State; var Exec: IMyc2Condition; [unsafe] Q: IMyc2State; begin Exec := Signals.CreateCounter( 1 ); Result := Exec.State; Result._AddRef; Pointer( Q ) := TInterlocked.Exchange( Pointer( Queue ), Pointer( Result ) ); try Start( Q, Proc ).Advise( Exec ); finally Q._Release; end; end; function TMyc3Tasks.Enqueue( var Queue: IMyc2State; const Proc: TProc ): IMyc2State; var Exec: IMyc2Condition; [unsafe] Q: IMyc2State; begin Exec := Signals.CreateCounter( 1 ); Result := Exec.State; Result._AddRef; Pointer( Q ) := TInterlocked.Exchange( Pointer( Queue ), Pointer( Result ) ); try Start( Q, Proc ).Advise( Exec ); finally Q._Release; end; end; procedure TMyc3Tasks.ExpectSignaled( State: IMyc2State; const Msg: String = 'Expected state to be already set' ); begin System.Assert( Signals.IsStatic( State ) or State.IsSet, Msg ); end; function TMyc3Tasks.GetInMainThread: Boolean; begin Result := FApi.InMainThread; end; function TMyc3Tasks.GetThreadCount: Integer; begin Result := FApi.ThreadCount; end; function TMyc3Tasks.LoopUntil( const DoneSignal: IMyc2Signal; const Proc: TFunc ): IMyc2State; var Done: IMyc2Event; CapturedProc: TFunc; begin if Signals.IsStatic( DoneSignal ) then exit( Signals.Null.State ); DoneSignal._AddRef; try Done := Signals.CreateEvent( false ); DoneSignal.Advise( Done ); CapturedProc := Proc; Result := FApi.CreateThread( procedure begin try while not Done.State.IsSet do WaitFor( CapturedProc ); finally CapturedProc := nil; end; end ); finally DoneSignal._Release; end; end; function TMyc3Tasks.ParallelFor(const StartSignal: IMyc2Signal; LowVal, HighVal, Slice: Integer; const Proc: TProc): IMyc2State; function CallFunc( f, l: Integer; Proc: TProc ): IMyc2State; begin Result := Start( StartSignal, procedure begin Proc( f, l ); end ); end; var l, f, n: Integer; Counter: IMyc2Condition; begin if not Assigned( Proc ) or ( LowVal > HighVal ) then exit; if Slice <= 0 then Slice := max( 1, (HighVal-LowVal+1) div ThreadCount ); n := 0; f := LowVal; while f <= HighVal do begin inc( f, Slice ); inc( n ); end; if n=0 then exit; Counter := Signals.CreateCounter( n ); f := LowVal; while f <= HighVal do begin l := f + Slice - 1; if l > HighVal then l := HighVal; CallFunc( f, l, Proc ).Advise( Counter ); f := l + 1; end; Result := Counter.State; end; procedure TMyc3Tasks.ParallelFor(LowVal, HighVal, Slice: Integer; const Proc: TProc); begin if Slice <= 0 then Slice := max( 1, (HighVal-LowVal+1) div ThreadCount ); if HighVal - LowVal >= Slice then WaitFor( ParallelFor( nil, LowVal, HighVal, Slice, Proc ) ) else Proc( LowVal, HighVal ); end; procedure TMyc3Tasks.Run( const StartSignal: IMyc2Signal; const Proc: TProc ); begin if not Signals.IsStatic( StartSignal ) then begin if FEnabled then StartSignal.Advise( FApi.Run( 1, Proc ) ) else StartSignal.Advise( Signals.CreateSink( True, Proc ) ); end else Run( Proc ); end; procedure TMyc3Tasks.Run( const Proc: TProc ); begin if FEnabled then FApi.Run( 0, Proc ) else Proc( ); end; procedure TMyc3Tasks.SetEnabled( const Value: Boolean ); begin {$ifndef DisableThreading} FEnabled := Value; {$endif} end; function TMyc3Tasks.Start( const StartSignal: IMyc2Signal; const Proc: TFunc ): IMyc2State; var Done: IMyc2Condition; CapturedProc: TFunc; begin if not Assigned( Proc ) then exit( Signals.Null.State ); Done := Signals.CreateCounter( 1 ); CapturedProc := Proc; Run( StartSignal, procedure var Sig: IMyc2Signal; begin try Sig := CapturedProc( ); finally CapturedProc := nil; if not Signals.IsStatic( Sig ) then Sig.Advise( Done ) else Done.Notify; end; end ); exit( Done.State ); end; function TMyc3Tasks.Start( const StartSignal: IMyc2Signal; Proc: TProc ): IMyc2State; var Done: IMyc2Condition; begin Assert( Assigned( Proc ) ); Done := Signals.CreateCounter( 1 ); Run( StartSignal, procedure begin try Proc; finally Done.Notify; end; end ); exit( Done.State ); end; function TMyc3Tasks.Start( const Proc: TFunc ): IMyc2State; begin Result := Start( nil, Proc ); end; function TMyc3Tasks.Start( const Proc: TProc ): IMyc2State; begin Result := Start( nil, Proc ); end; function TMyc3Tasks.Start( const StartSignal: IMyc2Signal; P1: T1; P2: T2; Proc: TProc ): IMyc2State; begin Result := Start( StartSignal, procedure begin Proc( P1, P2 ); end ); end; function TMyc3Tasks.Start( const StartSignal: IMyc2Signal; P1: T1; Proc: TProc ): IMyc2State; begin Result := Start( StartSignal, procedure begin Proc( P1 ); end ); end; procedure TMyc3Tasks.WaitFor( const State: IMyc2State ); begin FApi.WaitFor( State ); end; { TValue } class constructor TValue.CreateClass; begin FDefaultMutable := TMyc3ConstantMutable.Create( Default(T) ); FDefaultMutableFuture := TMyc3ConstantMutable>.Create( TMyc3ConstantFuture.Create( Default(T) ) ); end; class function TValue.Capture( const Src: TArray ): TArray; var i: Integer; begin SetLength( Result, Length( Src ) ); for i := 0 to High( Src ) do Result[i] := Src[i]; end; class function TValue.CreateFuture( Future: IMyc3Future; Creator: TFunc < T, IMyc3Future < T >> ): IMyc3Future; begin Result := TMyc3Future.CreateFuture( Future.Initialized, function: IMyc3Future begin Result := Creator( Future.Value ); end ); end; class function TValue.CreateFuture( const StartSignal: IMyc2Signal; const Calculator: TFunc < IMyc3Future < T >> ) : IMyc3Future; begin Result := TMyc3Future.CreateFuture( StartSignal, function: IMyc3Future begin Result := Calculator( ); end ); end; class function TValue.Combine( const Values: TArray>; Combiner: TMyc3Combiner ): IMyc3Future; begin if Values=nil then exit( DefaultFuture ); Result := CreateFuture( Values, function( Arr: TArray ): T begin Result := Combiner( Arr ); end ); end; class function TValue.Combine( Values: TArray; Combiner: TMyc3Combiner ): IMyc3Future; begin if Values=nil then exit( DefaultFuture ); Result := TValue.CreateFuture( function: T begin Result := Combiner( Values ); end ); end; class function TValue.Combine(const Values: TArray>; Combiner: TMyc3Combiner): IMyc3Mutable; var Chg: TArray; i: Integer; begin Result := Mutable.Convert, T>( TValue.CreateMutable(Values), function( Values: TArray ): T begin if not Assigned( Combiner ) then exit( Default( T ) ); Result := Combiner( Values ); end ); end; class function TValue.CreateAnimator( const Target: IMyc3Mutable; const Interpolator: TMyc3TargetInterpolator ) : IMyc3Animator; begin Result := CreateAnimator( Target.Value, Target.Changed, function( Delta: Double; const StartValue: T; out Value: T ): Boolean begin Result := Interpolator( Delta, StartValue, Target.Value, Value ); if not Result then Value := Target.Value; end ); end; class function TValue.CreateAnimator( const Init: T; const ChangeSignal: IMyc2Signal; const Interpolator: TMyc3Interpolator ): IMyc3Animator; begin Result := TMyc3Animator.Create( Init, ChangeSignal, Interpolator ); end; class function TValue.AsFuture( const Value: T ): IMyc3Future; begin Result := TMyc3ConstantFuture.Create( Value ); end; class function TValue.CreateFuture( const StartSignal: IMyc2Signal; const Calculator: TFunc ): IMyc3Future; begin Result := TMyc3Future.CreateFuture( StartSignal, Calculator ); end; class function TValue.CreateFuture( const Calculator: TFunc ): IMyc3Future; begin Result := TMyc3Future.CreateFuture( Calculator ); end; class function TValue.CreateFuture( const Params: TArray>; Calculator: TFunc, T> ): IMyc3Future; var Counter: IMyc2Condition; i: Integer; Arr: TArray>; begin Counter := Signals.CreateCounter( Length( Params ) ); SetLength( Arr, Length( Params ) ); for i := 0 to High( Params ) do begin if Params[i]<>nil then begin Arr[i] := Params[i]; Arr[i].Initialized.Advise( Counter ); end else Counter.Notify; end; Result := TMyc3Future.CreateFuture( Counter.State, function: T var Values: TArray; i: Integer; begin SetLength( Values, Length( Arr ) ); for i := 0 to High( Values ) do if Arr[i]<>nil then Values[i] := Arr[i].Value; Result := Calculator( Values ); end ); end; class function TValue.CreateFuture( P1: IMyc3Future; P2: IMyc3Future; Calculator: TFunc ): IMyc3Future; var Counter: IMyc2Condition; begin Assert( Assigned( P1 ) and Assigned( P2 ) ); Counter := Signals.CreateCounter( 2 ); P1.Initialized.Advise( Counter ); P2.Initialized.Advise( Counter ); Result := CreateFuture( Counter.State, function: T begin Result := Calculator( P1.Value, P2.Value ); end ); end; class function TValue.CreateFuture( P1: IMyc3Future; P2: IMyc3Future; Calculator: TFunc < U, V, IMyc3Future < T >> ): IMyc3Future; var Counter: IMyc2Condition; begin Assert( Assigned( P1 ) and Assigned( P2 ) ); Counter := Signals.CreateCounter( 2 ); P1.Initialized.Advise( Counter ); P2.Initialized.Advise( Counter ); Result := CreateFuture( Counter.State, function: IMyc3Future begin Result := Calculator( P1.Value, P2.Value ); end ); end; class function TValue.CreateFuture( P: IMyc3Future; Calculator: TFunc ): IMyc3Future; begin Assert( Assigned( P ) ); Result := CreateFuture( P.Initialized, function: T begin Result := Calculator( P.Value ); end ); end; class function TValue.CreateFuture( P: IMyc3Future; Calculator: TFunc < U, IMyc3Future < T >> ): IMyc3Future; begin Assert( Assigned( P ) ); Result := CreateFuture( P.Initialized, function: IMyc3Future begin Result := Calculator( P.Value ); end ); end; class function TValue.AsImmutable( const Value: T ): IMyc3Value; begin Result := TMyc3Value.Create( Value ); end; class function TValue.CreateLazy(const Func: TFunc): IMyc3Value; begin Result := TMyc3Lazy.Create( Func ); end; class function TValue.CreateFuture( const Values: TArray < IMyc3Future < T >> ): IMyc3Future>; begin Result := TMyc3FutureArrayEx.Create( Values ); end; class function TValue.CreateFuture( const Values: TArray>; const Calculator: TFunc ): IMyc3Future>; begin Result := TMyc3FutureArrayConvert.Create( Values, Calculator ); end; class function TValue.CreateFuture( P1: IMyc3Future; P2: IMyc3Future; P3: IMyc3Future; Calculator: TFunc ): IMyc3Future; var Counter: IMyc2Condition; begin Assert( Assigned( P1 ) and Assigned( P2 ) and Assigned( P3 ) ); Counter := Signals.CreateCounter( 3 ); P1.Initialized.Advise( Counter ); P2.Initialized.Advise( Counter ); P3.Initialized.Advise( Counter ); Result := CreateFuture( Counter.State, function: T begin Result := Calculator( P1.Value, P2.Value, P3.Value ); end ); end; class function TValue.CreateFutures( Count: Integer; const Src: IMyc3Future < TArray < T >> ): TArray>; begin Result := TMyc3FutureArray.CreateFutures( Count, Src ); end; class function TValue.CreateMutable( const Value: T ): IMyc3Mutable; begin Result := AsConst( Value ); end; class function TValue.CreateMutable( const Changed: array of IMyc2Signal; const Calculator: TFunc ): IMyc3Mutable; begin Result := TMyc3Mutable.CreateMutable( Changed, Calculator ); end; class function TValue.AsMutable( const Value: IMyc3Mutable> ): IMyc3Mutable; begin Result := TMyc3EnclosedMutable.Create( Value ); end; class function TValue.AsMutable( const Value: IMyc3Mutable> ): IMyc3Mutable; begin Result := TValue.CreateMutable>( Value, function( Immutable: IMyc3Value ): T begin if Immutable<>nil then Result := Immutable.Value else Result := default ( T ); end ); end; class function TValue.AsConst( const Value: T ): IMyc3Mutable; begin Result := TMyc3ConstantMutable.Create( Value ); end; class function TValue.AsMutable(const Value: IMyc3Future): IMyc3Mutable; begin Result := TMyc3FutureAsMutable.CreateFutureAsMutable( Value ) end; class function TValue.AsMutable(const Value: IMyc3Mutable>): IMyc3Mutable; begin Result := TMyc3EnclosedMutable.Create( TMyc3Mutable>.CreateMutable( Value.Changed, function: IMyc3Mutable begin Result := AsMutable( Value.Value ); end ) ); end; class function TValue.Convert( P: IMyc3Future; const Converter: TFunc ): IMyc3Future; begin if P.Initialized.IsSet then Result := AsFuture( Converter( P.Value ) ) else Result := CreateFuture( P, Converter ); end; class function TValue.CreateGeneric(const Calculator: TFunc): IMyc3Generic; begin Result := TMyc3Changeable.CreateGeneric( Calculator ); end; class function TValue.CreateFutureArray( const StartSignal: IMyc2Signal; Count: Integer; const Calculator: TFunc ): IMyc3Future>; var Init: IMyc2State; Arr: TArray; Calc: TFunc; begin SetLength( Arr, Count ); Calc := Calculator; Init := Tasks.ParallelFor( StartSignal, 0, Count-1, 1, procedure( A, B: Integer ) var i: Integer; begin for i := A to B do Calc( i ) end ); Result := TMyc3Future>.CreateFuture( Init, Arr ); end; class function TValue.CreateFutureArray( Count: Integer; const Calculator: TFunc ): IMyc3Future>; begin Result := CreateFutureArray( Signals.Null.State, Count, Calculator ); end; class function TValue.CreateValidate( const Calculator: TFunc ): IMyc3ValidateMutable; begin Result := TMyc3ValidateMutable.Create( Calculator ); end; class function TValue.CreateMutable( const Arr: TArray < IMyc3Mutable < T >> ): IMyc3Mutable>; begin Result := TMyc3Mutable.CreateArray( Arr ); end; class function TValue.CreateMutable( Calculator: TFunc ): IMyc3Mutable; begin Result := CreateMutable( [], Calculator ); end; class function TValue.CreateMutable( const Event: IMycEventObserver; const Calculator: TFunc ): IMyc3Mutable; begin Result := TMyc3Mutable.CreateMutable( Event, Calculator ); end; class function TValue.CreateMutable( const Changed: array of IMyc2Signal; const Mutable: IMyc3Mutable ): IMyc3Mutable; var Notifier: IMyc2Notifier; i: Integer; begin Notifier := Signals.CreateNotifier; Mutable.Changed.Advise( Notifier ); for i := 0 to High( Changed ) do Changed[i].Advise( Notifier ); Result := TMyc3Mutable.CreateMutable( Notifier.Signal, function: T begin Result := Mutable.Value; end ); end; class function TValue.CreateMutable(const Changed: array of IMyc2Signal; const Calculator: TFunc>): IMyc3Mutable; begin Result := TMyc3EnclosedMutable.Create( TMyc3Mutable>.CreateMutable( Changed, Calculator ) ); end; class function TValue.CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; P3: IMyc3Mutable; Calculator: TFunc ): IMyc3Mutable; begin Assert( Assigned( P1 ) and Assigned( P2 ) and Assigned( P3 ) ); if not Signals.IsStatic(P1.Changed) or not Signals.IsStatic(P2.Changed) or not Signals.IsStatic(P3.Changed) then begin Result := TMyc3Mutable.CreateMutable( [P1.Changed, P2.Changed, P3.Changed], function: T begin Result := Calculator( P1.Value, P2.Value, P3.Value ); end ); end else Result := TMyc3ConstantMutable.Create( Calculator( P1.Value, P2.Value, P3.Value ) ); end; class function TValue.CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; P3: IMyc3Mutable; P4: IMyc3Mutable; Calculator: TFunc ): IMyc3Mutable; begin Assert( Assigned( P1 ) and Assigned( P2 ) and Assigned( P3 ) and Assigned( P4 ) ); if not Signals.IsStatic(P1.Changed) or not Signals.IsStatic(P2.Changed) or not Signals.IsStatic(P3.Changed) or not Signals.IsStatic(P4.Changed) then begin Result := TMyc3Mutable.CreateMutable( [P1.Changed, P2.Changed, P3.Changed, P4.Changed], function: T begin Result := Calculator( P1.Value, P2.Value, P3.Value, P4.Value ); end ); end else Result := TMyc3ConstantMutable.Create( Calculator( P1.Value, P2.Value, P3.Value, P4.Value ) ); end; class function TValue.CreateMutableEx( Params: TArray>; Calculator: TFunc, T> ): IMyc3Mutable; var i: Integer; Sigs: TArray; begin case Length( Params ) of 0: Result := CreateMutable( function: T begin Result := Calculator( [] ); end ); 1: Result := CreateMutable( Params[0], function( P: S ): T begin Result := Calculator( [P] ); end ); 2: Result := CreateMutable( Params[0], Params[1], function( P1, P2: S ): T begin Result := Calculator( [P1, P2] ); end ); 3: Result := CreateMutable( Params[0], Params[1], Params[2], function( P1, P2, P3: S ): T begin Result := Calculator( [P1, P2, P3] ); end ); 4: Result := CreateMutable( Params[0], Params[1], Params[2], Params[3], function( P1, P2, P3, P4: S ): T begin Result := Calculator( [P1, P2, P3, P4] ); end ); else begin SetLength( Sigs, Length( Params ) ); for i := 0 to High( Sigs ) do begin Assert( Assigned( Params[i] ) ); Sigs[i] := Params[i].Changed; end; Result := TMyc3Mutable.CreateMutable( Sigs, function: T var Values: TArray; Init: IMyc2Signal; i: Integer; begin SetLength( Values, Length( Params ) ); for i := 0 to High( Values ) do Values[i] := Params[i].Value; Result := Calculator( Values ); end ); end; end; end; class function TValue.CreateMutable( const Arr: TArray>; Calculator: TFunc ): IMyc3Mutable>; begin Result := TMyc3MutableArray.Create( Arr, Calculator ); end; class function TValue.CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; P3: IMyc3Mutable; P4: IMyc3Mutable; P5: IMyc3Mutable; P6: IMyc3Mutable; Calculator: TFunc ): IMyc3Mutable; begin Assert( Assigned( P1 ) and Assigned( P2 ) and Assigned( P3 ) and Assigned( P4 ) and Assigned( P5 ) and Assigned( P6 ) ); if not Signals.IsStatic(P1.Changed) or not Signals.IsStatic(P2.Changed) or not Signals.IsStatic(P3.Changed) or not Signals.IsStatic(P4.Changed) or not Signals.IsStatic(P5.Changed) or not Signals.IsStatic(P6.Changed) then begin Result := TMyc3Mutable.CreateMutable( [P1.Changed, P2.Changed, P3.Changed, P4.Changed, P5.Changed, P6.Changed], function: T begin Result := Calculator( P1.Value, P2.Value, P3.Value, P4.Value, P5.Value, P6.Value ); end ); end else Result := TMyc3ConstantMutable.Create( Calculator( P1.Value, P2.Value, P3.Value, P4.Value, P5.Value, P6.Value ) ); end; class function TValue.CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; P3: IMyc3Mutable; P4: IMyc3Mutable; P5: IMyc3Mutable; Calculator: TFunc ): IMyc3Mutable; begin Assert( Assigned( P1 ) and Assigned( P2 ) and Assigned( P3 ) and Assigned( P4 ) and Assigned( P5 ) ); if not Signals.IsStatic(P1.Changed) or not Signals.IsStatic(P2.Changed) or not Signals.IsStatic(P3.Changed) or not Signals.IsStatic(P4.Changed) or not Signals.IsStatic(P5.Changed) then begin Result := TMyc3Mutable.CreateMutable( [P1.Changed, P2.Changed, P3.Changed, P4.Changed, P5.Changed], function: T begin Result := Calculator( P1.Value, P2.Value, P3.Value, P4.Value, P5.Value ); end ); end else Result := TMyc3ConstantMutable.Create( Calculator( P1.Value, P2.Value, P3.Value, P4.Value, P5.Value ) ); end; class function TValue.CreateMutable( P1: IMyc3Mutable; P2: IMyc3Mutable; Calculator: TFunc ) : IMyc3Mutable; begin Assert( Assigned( P1 ) and Assigned( P1 ) ); if not Signals.IsStatic(P1.Changed) or not Signals.IsStatic(P2.Changed) then begin Result := TMyc3Mutable.CreateMutable( [P1.Changed, P2.Changed], function: T begin Result := Calculator( P1.Value, P2.Value ); end ); end else Result := TMyc3ConstantMutable.Create( Calculator( P1.Value, P2.Value ) ); end; class function TValue.CreateMutable( P: IMyc3Mutable; Calculator: TFunc ): IMyc3Mutable; begin Assert( Assigned( P ) ); if not Signals.IsStatic(P.Changed) then begin Result := TMyc3Mutable.CreateMutable( P.Changed, function: T begin Result := Calculator( P.Value ); end ); end else Result := TMyc3ConstantMutable.Create( Calculator( P.Value ) ); end; class function TValue.CreateWriteable( const InitValue: T ): IMyc3Writeable; begin Result := TMyc3Writeable.CreateWriteable( InitValue ); end; class function TValue.CreatePropertyEx( const Decorated: IMyc3Mutable ): IMyc3Property; begin Result := TMycProperty.CreateProperty( Decorated ); end; class function TValue.CreateProperty( const Creator: TFunc < IMyc3Mutable < T >> ): IMyc3MutablePropertyEx; begin Result := TMyc3MutablePropertyEx.Create( Creator ); end; class function TValue.CreateMutableProperty(const InitValue: IMyc3Mutable): IMyc3MutableProperty; begin Result := TMyc3MutableProperty.Create( InitValue ); end; class function TValue.CreateSet: IMycSet; begin Result := TMycSet.Create; end; class function TValue.CreateWriteable( const InitValue: T; const EqualityComparison: TEqualityComparison ) : IMyc3Writeable; begin Result := TMyc3Writeable.CreateWriteable( InitValue, EqualityComparison ); end; class function TValue.CreateWriteable: IMyc3Writeable; begin Result := CreateWriteable( Default(T) ); end; class function TValue.Execute( Future: IMyc3Future; Proc: TConstFunc ): IMyc2State; begin Result := Tasks.Start( Future.Initialized, function: IMyc2Signal begin Result := Proc( Future.Value ); end ); end; class function TValue.GetDefaultFuture: IMyc3Future; begin Result := TMyc3Future.DefaultFuture; end; class function TValue.MakeValid( const Value: IMyc3Future ): IMyc3Future; begin Result := Value; if Result = nil then Result := DefaultFuture; end; class function TValue.MakeValid( const Value: IMyc3Mutable ): IMyc3Mutable; begin Result := Value; if Result = nil then Result := DefaultMutable; end; class function TValue.TryGetValue( const Future: IMyc3Future; out Value: T ): Boolean; begin Result := Future <> nil; if Result then begin Result := Future.Initialized = Signals.Null.State; if Result then begin Result := Future.Initialized.IsSet; if Result then Value := Future.Value; end; end; end; class function TValue.WaitFor( Future: IMyc3Future ): T; begin Tasks.WaitFor( Future.Initialized ); exit( Future.Value ); end; class procedure TValue.WaitFor( const Futures: TArray>; Exec: TProc ); var i: Integer; Arr: TArray>; begin SetLength( Arr, Length( Futures ) ); for i := 0 to High( Futures ) do if Futures[i].Initialized.IsSet then Exec( i, Futures[i].Value ) else Arr[i] := Futures[i]; for i := 0 to High( Arr ) do if Arr[i] <> nil then Exec( i, WaitFor( Futures[i] ) ); end; { TMyc2ComputeProperty } constructor TMyc2ComputeProperty.Create( const StartSignal: IMyc2Signal; const Creator: TFunc ); var P: ^T; begin FValue := default ( T ); P := @FValue; FDone := Tasks.Start( StartSignal, procedure begin P^ := Creator( ); end ); end; procedure TMyc2ComputeProperty.Terminate; begin if FDone <> Signals.Null.State then begin Tasks.WaitFor( FDone ); FDone := Signals.Null.State; end; end; function TMyc2ComputeProperty.Value: T; begin Terminate; Result := FValue; end; { Signals } class function Signals.CreateCounter( Count: Integer ): IMyc2Condition; begin Result := TMyc2Signal.CreateCounter( Count ) end; class function Signals.CreateEvent( Init: Boolean = false ): IMyc2Event; begin Result := TMyc2Signal.CreateEvent( Init ); end; class function Signals.CreateNotifier: IMyc2Notifier; begin Result := TMyc2Signal.CreateNotifier; end; class function Signals.CreateSink(Once: Boolean; const Proc: TProc): IMyc2Sink; begin Result := TMyc2SinkProc.CreateSink( Once, Proc ); end; class function Signals.Concat( const States: array of IMyc2State ): IMyc2State; begin Result := TMyc2Signal.CreateConcat( States ); end; class function Signals.CreateObserver( const Signals: array of IMyc2Signal; const Sink: T ): IMycObserver; begin Result := TMycObserver.CreateObserver( Signals, Sink ); end; class function Signals.CreateEventObserver( const Signals: array of IMyc2Signal ): IMycEventObserver; begin Result := CreateObserver( Signals, CreateEvent( True ) ); end; class function Signals.CreateNotifyObserver( const Signals: array of IMyc2Signal ): IMycNotifyObserver; begin Result := CreateObserver( Signals, CreateNotifier ); end; class function Signals.CreateNotifyObserver( const Signals: IMycCountable ): IMycNotifyObserver; var Arr: TArray; i: Integer; begin SetLength( Arr, Signals.Count ); for i := 0 to High( Arr ) do Arr[i] := Signals[i]; Result := CreateNotifyObserver( Arr ); end; class function Signals.CreateEventObserver( const Signals: IMycCountable ): IMycEventObserver; var Arr: TArray; i: Integer; begin SetLength( Arr, Signals.Count ); for i := 0 to High( Arr ) do Arr[i] := Signals[i]; Result := CreateEventObserver( Arr ); end; class function Signals.CreateFlag(Init: Boolean): IMyc2Flag; begin Result := TMyc2Flag.Create( Init ); end; class function Signals.CreateSink(const Proc: TProc): IMyc2Sink; begin Result := TMyc2SinkProc.CreateSink( false, Proc ); end; class function Signals.GetNull: IMyc2Condition; begin exit( TMyc2Signal.Null ); end; class function Signals.IsStatic( const Signal: IMyc2Signal ): Boolean; begin Result := ( Signal = nil ) or ( Signal = Null.State ); end; class function Signals.MakeValid( const Signal: IMyc2Signal ): IMyc2Signal; begin if IsStatic( Signal ) then exit( Null.State ) else exit( Signal ); end; class function Signals.MakeValid( const Signals: array of IMyc2Signal ): TArray; begin Result := TMyc2Signal.MakeValid( Signals ); end; class function Signals.Union( const Sigs: array of IMyc2Signal ): IMyc2Signal; begin Result := TMyc2Signal.CreateUnion( Sigs ); end; { TState } class function TAtomicStack.Create: IAtomicStack; begin Result := TMycAtomicStack.Create; end; { TProtected } constructor TProtected.Create( const AItem: T ); begin FItem := AItem; end; function TProtected.Exchange( const Value: T ): T; begin if Value <> nil then Value._AddRef; PPointer( @Result )^ := TInterlocked.Exchange( PPointer( @FItem )^, PPointer( @Value )^ ); end; class operator TProtected.Implicit( const Value: T ): TProtected; begin Result.Create( Value ); end; { Mutable } class function Mutable.ConvertSet(const Arr: IMyc3Mutable>>; const Converter: TFunc): IMyc3Mutable< TArray< IMyc3Mutable>>; begin Result := TValue>>.CreateMutable>>( Arr, function( Arr: TArray> ): TArray> var i: Integer; begin SetLength( Result, Length(Arr) ); for i := 0 to High(Result) do begin Assert( Arr[i] <> nil ); Result[i] := TValue.CreateMutable( Arr[i], Converter ); end; end ); end; class function Mutable.ConvertSet(const Arr: IMyc3Mutable>>>; const Converter: TFunc): IMyc3Mutable>>>; begin Result := ConvertSet, IMyc3Future>( Arr, function( Item: IMyc3Future ): IMyc3Future begin Assert( Item <> nil ); Result := TValue.CreateFuture( Item, Converter ); end ); end; class function Mutable.Create( Value: Boolean ): IMyc3Mutable; begin Result := TMycMutableBoolean.CreateBoolean( Value ); end; class function Mutable.CreateAssembly(const Arr: IMyc3Mutable>>): IMyc3Mutable>; begin Result := Mutable.From>, TArray>( Arr, function( Arr: TArray> ): IMyc3Mutable> begin Result := TValue.CreateMutable( Arr ); end ); end; class function Mutable.CreateAssembly(const Arr: IMyc3Mutable>>>): IMyc3Mutable>>; begin Result := Mutable.From>>, IMyc3Future>>( Arr, function( Arr: TArray>> ): IMyc3Mutable>> begin Result := TMutableFuture.FromArray( Arr ); end ); end; class function Mutable.CreateAssembly(const Arr: IMyc3Mutable>>; const Creator: TFunc, T>): IMyc3Mutable; begin Result := TValue.AsMutable( TValue>.CreateMutable>>( Arr, function( Arr: TArray> ): IMyc3Mutable begin Result := TValue.CreateMutable>( TValue.CreateMutable( Arr ), Creator ) ; end ) ); end; class function Mutable.CreateAssembly( const Arr: IMyc3Mutable>>>; const Creator: TFunc, S>): IMyc3Mutable>; begin Result := CreateAssembly, IMyc3Future>( Arr, function( Arr: TArray> ): IMyc3Future begin Result := TValue.CreateFuture>( TValue.CreateFuture( Arr ), Creator ); end ); end; class function Mutable.CreateAssembly(const Arr: IMyc3Mutable>>; const Creator: TFunc, S>): IMyc3Mutable; begin Result := TValue.AsMutable( TValue>.CreateMutable>>( Arr, function( Arr: TArray> ): IMyc3Mutable begin Result := TValue.CreateMutable>( TValue.CreateMutable( Arr ), Creator ) ; end ) ); end; class function Mutable.CreateAssembly(const Arr: IMyc3Mutable>>>; const Creator: TFunc, T>) : IMyc3Mutable>; begin Result := CreateAssembly>( Arr, function( Arr: TArray> ): IMyc3Future begin Result := TValue.CreateFuture>( TValue.CreateFuture( Arr ), Creator ); end ); end; class function Mutable.FromSignal(const Signal: IMyc2Signal): IMyc3Mutable; begin Result := TMycMutableSignal.Create( Signal ); end; class function Mutable.CreateOverride(const Value, Ovrride: IMyc3Mutable>): IMyc3Mutable>; begin Result := TValue>.CreateMutable, TImmutable>( Value, Ovrride, function( Value, Ovrride: TImmutable ): TImmutable begin if not Ovrride.HasValue then Result := Value else Result := Ovrride; end ); end; class function Mutable.CreateCache( const Comparer: IComparer = nil ): TMutableCache; begin Result.Create( TMycMutableTable.Create( Comparer ) ); end; class function Mutable.CreateNotifyObserver(const Mutables: TArray>): IMycNotifyObserver; var Sigs: TArray; i: Integer; begin SetLength( Sigs, Length(Mutables) ); for i := 0 to High(Sigs) do Sigs[i] := Mutables[i].Changed; Result := Signals.CreateNotifyObserver(Sigs); end; class function Mutable.CreateEventObserver(const Mutables: TArray>): IMycEventObserver; var Sigs: TArray; i: Integer; begin SetLength( Sigs, Length(Mutables) ); for i := 0 to High(Sigs) do Sigs[i] := Mutables[i].Changed; Result := Signals.CreateEventObserver(Sigs); end; class function Mutable.CreateValidator( const Comparer: IComparer = nil ): IMyc3MutableCache; begin Result := TMycMutableCache.CreateCache( Comparer ); end; class function Mutable.ExtractSignals(const Mutables: TArray>): IMyc2Signal; var i: Integer; Arr: TArray; begin SetLength( Arr, Length(Mutables) ); for i := 0 to High(Arr) do Arr[i] := Mutables[i].Changed; Result := Signals.Union( Arr ); end; class function Mutable.False: IMyc3Mutable; begin Result := TMycMutableBoolean.CreateBoolean( System.False ); end; class function Mutable.From(const Value: IMyc3Mutable; const Conv: TFunc>): IMyc3Mutable; begin Result := TMyc3EnclosedMutable.Create( TValue>.CreateMutable( Value, Conv ) ); end; class function Mutable.Convert(const Value: IMyc3Mutable; const Conv: TFunc): IMyc3Mutable; begin Result := TValue.CreateMutable( Value, Conv ); end; class function Mutable.Convert(const Value: IMyc3Mutable>; const Conv: TFunc): IMyc3Mutable>; begin Result := Convert, IMyc3Future>( Value, function( Value: IMyc3Future ): IMyc3Future begin Result := TFuture.From( Value, Conv ) end ); end; class function Mutable.Convert(const Value: IMyc3Mutable>; const Conv: TFunc>): IMyc3Mutable>; begin Result := Convert, IMyc3Future>( Value, function( Value: IMyc3Future ): IMyc3Future begin Result := TFuture.From( Value, Conv ) end ); end; class function Mutable.CreateNullable: IMyc3Writeable>; begin Result := TValue>.CreateWriteable( TImmutable.Null ); end; class function Mutable.CreateObjectLink(Obj: T): IMyc3ObjectLink; begin Result := TMyc3ObjectLink.Create( Obj ); end; class function Mutable.TrimArray(const Values: IMyc3Mutable>): IMyc3Mutable>; begin Result := TValue>.CreateMutable>( Values, function( Values: TArray ): TArray var i, n: Integer; begin n := 0; for i := 0 to High(Values) do if Assigned(Values[i]) then inc(n); SetLength( Result, n ); n := 0; for i := 0 to High(Values) do begin Result[n] := Values[i]; inc(n); end; end ); end; class function Mutable.FilterArray(const Values: IMyc3Mutable>; const FilterFunc: TConstFunc>): IMyc3Mutable>; var Sieve: IMyc3Mutable>>; begin Sieve := TValue>>.CreateMutable>( Values, function( Values: TArray ): TArray> var i: Integer; begin SetLength( Result, Length( Values ) ); for i := 0 to High(Values) do Result[i] := FilterFunc( Values[i] ); end ); Result := TValue>.CreateMutable, TArray>( Mutable.CreateAssembly( Sieve ), Values, function( Sieve: TArray; GeoArr: TArray ): TArray var i, n: Integer; begin n := 0; for i := 0 to High(GeoArr) do if Sieve[i] then inc( n ); SetLength( Result, n ); n := 0; for i := 0 to High(GeoArr) do if Sieve[i] then begin Result[n] := GeoArr[i]; inc(n); end; end ); end; class function Mutable.From(const ValueR: IMyc3Mutable; const ValueS: IMyc3Mutable; const Conv: TFunc>): IMyc3Mutable; begin Result := TMyc3EnclosedMutable.Create( TValue>.CreateMutable( ValueR, ValueS, Conv ) ); end; class function Mutable.From(const Value: T): IMyc3Mutable; begin Result := TMyc3ConstantMutable.Create( Value ); end; class function Mutable.FromArray(const Value: IMyc3Mutable>; const Conv: TFunc): IMyc3Mutable>; begin Result := Convert, TArray>( Value, function( Arr: TArray ): TArray var i: Integer; begin SetLength( Result, Length(Arr) ); for i := 0 to High(Arr) do Result[i] := Conv( Arr[i] ); end ); end; class function Mutable.FromArray(const Value: IMyc3Mutable>; const Conv: TFunc>): IMyc3Mutable>; begin Result := CreateAssembly( FromArray>( Value, Conv ) ); end; class function Mutable.FromArray(const Value: TArray>): IMyc3Mutable>; begin Result := TMyc3MutableArray.Create( Value, function( Idx: Integer; Val: T ): T begin Result := Val; end ); end; class function Mutable.FromState(const State: IMyc2State): IMyc3Mutable; begin Result := TMycMutableState.Create( State ); end; class function Mutable.IfNotThen(const Condition: IMyc3Mutable; const FalseValue: IMyc3Mutable): IMyc3Mutable; begin Assert( Assigned( Condition ) and Assigned( FalseValue ) ); if Signals.IsStatic(Condition.Changed) then begin if Condition.Value then exit( TValue.DefaultMutable ) else exit( FalseValue ); end; Result := TMyc3Mutable.CreateMutable( [Condition.Changed, FalseValue.Changed], function: T begin if Condition.Value then Result := System.Default( T ) else Result := FalseValue.Value; end ); end; class function Mutable.IfThen(const Condition: IMyc3Mutable; const TrueValue: IMyc3Mutable): IMyc3Mutable; begin Assert( Assigned( Condition ) and Assigned( TrueValue ) ); if Signals.IsStatic(Condition.Changed) then begin if Condition.Value then exit( TrueValue ) else exit( TValue.DefaultMutable ); end; Result := TMyc3Mutable.CreateMutable( [Condition.Changed, TrueValue.Changed], function: T begin if Condition.Value then Result := TrueValue.Value else Result := System.Default( T ); end ); end; class function Mutable.IfThen(const Condition: IMyc3Mutable; const TrueValue: IMyc3Mutable>): IMyc3Mutable< IMyc3Future>; begin Result := IfThenElse>( Condition, TrueValue, TValue.DefaultMutableFuture ); end; class function Mutable.IfThenElse(const Condition: IMyc3Mutable; const TrueValue, FalseValue: IMyc3Mutable): IMyc3Mutable; begin Assert( Assigned( Condition ) and Assigned( TrueValue ) and Assigned( FalseValue ) ); Result := TMyc3Mutable.CreateMutable( [Condition.Changed, TrueValue.Changed, FalseValue.Changed], function: T begin if Condition.Value then Result := TrueValue.Value else Result := FalseValue.Value; end ); end; class function Mutable.Merge(const Parts: IMyc3Mutable>>): IMyc3Mutable>; begin Result := TValue>.CreateMutable>>( Parts, function( Parts: TArray> ): TArray begin Result := TFuture.Merge( Parts ); end ); end; class function Mutable.Merge(const Parts: IMyc3Mutable>>>): IMyc3Mutable>>; begin Result := TValue>>.CreateMutable>>>( Parts, function( Parts: TArray>> ): IMyc3Future> begin Result := TFuture.Merge( Parts ); end ); end; class function Mutable.OpAND(const Arr: TArray>): IMyc3Mutable; begin if Length(Arr)=2 then Result := TValue.CreateMutable( Arr[0], Arr[1], function( A, B: Boolean ): Boolean begin Result := A and B; end ) else if Length(Arr)=1 then Result := Arr[0] else Result := TValue.CreateMutable>( TValue.CreateMutable(Arr), function( Arr: TArray ): Boolean var i: Integer; begin for i := 0 to High(Arr) do if not Arr[i] then exit( System.False ); exit( System.true ); end ); end; class function Mutable.OpNOT(const A: IMyc3Mutable): IMyc3Mutable; begin Result := TValue.CreateMutable( A, function( A: Boolean ): Boolean begin Result := not A; end ); end; class function Mutable.OpNOR(const Arr: TArray>): IMyc3Mutable; begin if Length(Arr)=2 then Result := TValue.CreateMutable( Arr[0], Arr[1], function( A, B: Boolean ): Boolean begin Result := not (A or B); end ) else if Length(Arr)=1 then Result := OpNOT( Arr[0] ) else Result := TValue.CreateMutable>( TValue.CreateMutable(Arr), function( Arr: TArray ): Boolean var i: Integer; begin for i := 0 to High(Arr) do if not Arr[i] then exit( System.true ); exit( System.False ); end ); end; class function Mutable.OpNAND(const Arr: TArray>): IMyc3Mutable; begin if Length(Arr)=2 then Result := TValue.CreateMutable( Arr[0], Arr[1], function( A, B: Boolean ): Boolean begin Result := not (A and B); end ) else if Length(Arr)=1 then Result := OpNOT( Arr[0] ) else Result := TValue.CreateMutable>( TValue.CreateMutable(Arr), function( Arr: TArray ): Boolean var i: Integer; begin for i := 0 to High(Arr) do if not Arr[i] then exit( System.true ); exit( System.False ); end ); end; class function Mutable.OpOR(const Arr: TArray>): IMyc3Mutable; begin if Length(Arr)=2 then Result := TValue.CreateMutable( Arr[0], Arr[1], function( A, B: Boolean ): Boolean begin Result := A or B; end ) else if Length(Arr)=1 then Result := Arr[0] else Result := TValue.CreateMutable>( TValue.CreateMutable(Arr), function( Arr: TArray ): Boolean var i: Integer; begin for i := 0 to High(Arr) do if Arr[i] then exit( System.true ); exit( System.False ); end ); end; class function Mutable.SortArray(const Values: IMyc3Mutable>; const Comparer: IComparer): IMyc3Mutable>; var Cmp: IComparer; begin Cmp := Comparer; if not Assigned(Cmp) then Cmp := TComparer.Default; Result := TValue>.CreateMutable>( Values, function( Values: TArray ): TArray begin SetLength( Result, Length(Values) ); TArray.Copy( Values, Result, Length(Values) ); TArray.Sort( Result, Cmp ); end ); end; class function Mutable.True: IMyc3Mutable; begin Result := TMycMutableBoolean.CreateBoolean( System.True ); end; class function Mutable.GetComparer: IComparer>; begin Result := TMyc3Mutable.Comparer; end; class function Mutable.CreateArray( const Arr: TArray> ): IMyc3Mutable>; begin Result := TMyc3Mutable.CreateArray( Arr ); end; class function Mutable.CreateArray( const Arr: IMyc3Mutable>; Calculator: TFunc ): IMyc3Mutable>; begin Result := TMyc3Mutable>.CreateMutable( [Arr.Changed], function: TArray var i: Integer; begin SetLength( Result, Length( Arr.Value ) ); for i := 0 to High( Arr.Value ) do Result[i] := Calculator( Arr.Value[i] ); end ); end; class function Mutable.Default: IMyc3Mutable; begin Result := TValue.DefaultMutable; end; class function Mutable.IfThen( const Condition: IMyc3Mutable; const TrueValue: IMyc3Mutable ): IMyc3Mutable; begin Assert( Assigned( Condition ) and Assigned( TrueValue ) ); if Condition = Mutable.True then exit( TrueValue ) else if Condition = Mutable.False then exit( default ); Result := TMyc3Mutable.CreateMutable( [Condition.Changed, TrueValue.Changed], function: T begin if Condition.Value then Result := TrueValue.Value else Result := System.Default( T ); end ); end; class function Mutable.IfNotThen( const Condition: IMyc3Mutable; const FalseValue: IMyc3Mutable ): IMyc3Mutable; begin Assert( Assigned( Condition ) and Assigned( FalseValue ) ); if Condition = Mutable.True then exit( default ) else if Condition = Mutable.False then exit( FalseValue ); Result := TMyc3Mutable.CreateMutable( [Condition.Changed, FalseValue.Changed], function: T begin if Condition.Value then Result := System.Default( T ) else Result := FalseValue.Value; end ); end; class function Mutable.IfThenElse( const Condition: IMyc3Mutable; const TrueValue, FalseValue: IMyc3Mutable ): IMyc3Mutable; begin Assert( Assigned( Condition ) and Assigned( TrueValue ) and Assigned( FalseValue ) ); if Condition = Mutable.True then exit( TrueValue ); if Condition = Mutable.False then exit( FalseValue ); if TrueValue = default then exit( IfNotThen( Condition, FalseValue ) ); if FalseValue = default then exit( IfThen( Condition, TrueValue ) ); Result := TMyc3Mutable.CreateMutable( [Condition.Changed, TrueValue.Changed, FalseValue.Changed], function: T begin if Condition.Value then Result := TrueValue.Value else Result := FalseValue.Value; end ); end; { TMutableBool } constructor TMutableBool.Create(const AThis: IMyc3Mutable); begin FThis := AThis; end; class function TMutableBool.GetDefaults(Value: Boolean): IMyc3Mutable; begin Result := TMycMutableBoolean.CreateBoolean( Value ); end; class function TMutableBool.True: IMyc3Mutable; begin Result := TMycMutableBoolean.CreateBoolean( System.true ); end; class function TMutableBool.False: IMyc3Mutable; begin Result := TMycMutableBoolean.CreateBoolean( System.false ); end; class operator TMutableBool.Equal(const A, B: TMutableBool): TMutableBool; begin Result := TValue.CreateMutable( A, B, function( A, B: Boolean ): Boolean begin Result := A = B; end ); end; class operator TMutableBool.Implicit(const Value: IMyc3Mutable): TMutableBool; begin Result.Create( Value ); end; class operator TMutableBool.Implicit(const Value: TMutableBool): IMyc3Mutable; begin Result := Value.This; end; class operator TMutableBool.LogicalAnd(const A, B: TMutableBool): TMutableBool; begin Result := TValue.CreateMutable( A, B, function( A, B: Boolean ): Boolean begin Result := A and B; end ); end; class operator TMutableBool.LogicalNot(const Value: TMutableBool): TMutableBool; begin Result := TValue.CreateMutable( Value, function( Value: Boolean ): Boolean begin Result := not Value; end ); end; class operator TMutableBool.LogicalOr(const A, B: TMutableBool): TMutableBool; begin Result := TValue.CreateMutable( A, B, function( A, B: Boolean ): Boolean begin Result := A or B; end ); end; class operator TMutableBool.NotEqual(const A, B: TMutableBool): TMutableBool; begin Result := TValue.CreateMutable( A, B, function( A, B: Boolean ): Boolean begin Result := A <> B; end ); end; { TAssembly } class function TAssembly.Create: IMycAssembly; begin Result := TMycAssembly.Create; end; { TMycArray } class function TMycArray.Create( const Arr: array of T ): IMycArray; begin Result := TMycCustomArray.CreateArray( Arr ); end; class function TMycArray.Create( Count: Integer; const Getter: TFunc ): IMycArray; begin Result := TMycGenericArray.Create( Count, Getter ); end; class function TMycArray.Create( const Src: IMycArray; const Converter: TConstFunc ): IMycArray; begin Result := TMycCustomArray.CreateConvert( Src, Converter ); end; class function TMycArray.Create(const Src: IMyc2Enumerable): IMycArray; var n: Integer; E: IMycEnumerator; Vals: TArray; begin E := Src.GetEnumerator; n := 0; while E.MoveNext do inc( n ); SetLength( Vals, n ); E.Reset; n := 0; while E.MoveNext do begin Vals[n] := E.Current; inc(n); end; Result := TMycCustomArray.CreateArray( Vals ); end; class function TMycArray.CreateConvert( const Enum: IMyc2Enumerable; const Conv: TConstFunc ): IMyc2Enumerable; begin Result := TMyc2ConvertEnumerable.Create( Enum, Conv ); end; class function TMycArray.Divide( const Src: TArray; const Comparer: IComparer ): TArray>; var i: Integer; Arr: TArray>; begin Arr := Create( Src ).Divide( Comparer ); SetLength( Result, Length( Arr ) ); for i := 0 to High( Result ) do Result[i] := Arr[i].ToArray; end; class procedure TMycArray.Divide1( const Src: IMycArray>; out Keys: TArray; out Values: TArray>; const Comparer: IComparer ); var Arr: TArray>>; i: Integer; begin Arr := Src.Divide( TComparer>.Construct( function( const A, B: TPair ): Integer begin Result := Comparer.Compare( A.Key, B.Key ); end ) ); SetLength( Keys, Length( Arr ) ); SetLength( Values, Length( Arr ) ); for i := 0 to High( Arr ) do begin Keys[i] := Arr[i][0].Key; Values[i] := TMycCustomArray.CreateConvert>( Arr[i], function( const P: TPair ): TValue begin Result := P.Value; end ); end; end; class function TMycArray.Divide( const Src: TArray>; const Comparer: IComparer ): TArray>>; var i, j: Integer; Arr: TArray>>; begin Arr := Create>( Src ).Divide( TComparer>.Construct( function( const A, B: TPair ): Integer begin Result := Comparer.Compare( A.Key, B.Key ); end ) ); SetLength( Result, Length( Arr ) ); for i := 0 to High( Result ) do begin Result[i].Key := Arr[i][0].Key; SetLength( Result[i].Value, Arr[i].Count ); for j := 0 to High( Result[i].Value ) do Result[i].Value[j] := Arr[i][j].Value; end; end; class function TMycArray.Divide( const Src: IMycArray>; const Comparer: IComparer ): TArray>>; var Arr: TArray>>; i: Integer; begin Arr := Src.Divide( TComparer>.Construct( function( const A, B: TPair ): Integer begin Result := Comparer.Compare( A.Key, B.Key ); end ) ); SetLength( Result, Length( Arr ) ); for i := 0 to High( Result ) do begin Result[i] := TPair>.Create( Arr[i][0].Key, TMycCustomArray.CreateConvert>( Arr[i], function( const P: TPair ): TValue begin Result := P.Value; end ) ); end; end; class function TMycArray.GetKeys( const Arr: TArray> ): TArray; var i: Integer; begin SetLength( Result, Length( Arr ) ); for i := 0 to High( Arr ) do Result[i] := Arr[i].Key; end; class function TChain.Create: IMycChain; begin Result := TMycChain.Create; end; { TMutableCache } constructor TMutableCache.Create( const AThis: IMyc3MutableTable ); begin FThis := AThis; end; function TMutableCache.GetItem(const Value: T): IMyc3Mutable; begin Result := FThis.Add( Value ); end; procedure TMutableCache.Clear; begin FThis.Clear; end; class function Stack.Create: IMycStack; begin Result := TMycStack.Create; end; { TTag } class function TTag.From(const Data: T): TTag; begin {$ifdef DEBUG} Result.FTypeInfo := TypeInfo(T); Assert( (Result.FTypeInfo<>nil) and (Result.FTypeInfo.Name <> 'TTag'), 'Recursive tag declaration' ); {$endif} case PTypeInfo(TypeInfo(T)).Kind of tkInteger: begin case PTypeInfo(TypeInfo(T)).TypeData.OrdType of otSByte: PShortInt(@Result.FOrdinal)^ := PShortInt(@Data)^; otUByte: PByte(@Result.FOrdinal)^ := PByte(@Data)^; otSWord: PSmallInt(@Result.FOrdinal)^ := PSmallInt(@Data)^; otUWord: PWord(@Result.FOrdinal)^ := PWord(@Data)^; otSLong: PInteger(@Result.FOrdinal)^ := PInteger(@Data)^; otULong: PLongword(@Result.FOrdinal)^ := PLongword(@Data)^; end; end; tkInt64: begin Result.FOrdinal := PInt64(@Data)^; end; tkFloat: begin case PTypeInfo(TypeInfo(T)).TypeData.FloatType of ftSingle: PSingle(@Result.FOrdinal)^ := PSingle(@Data)^; ftDouble: PDouble(@Result.FOrdinal)^ := PDouble(@Data)^; else begin Result.FOrdinal := 0; Result.FManaged := TMyc3Value.Create(Data); end; end; end; {$IFNDEF AUTOREFCOUNT} tkClass, {$ENDIF} tkPointer: begin PPointer(@Result.FOrdinal)^ := PPointer(@Data)^; end; tkInterface: begin Result.FOrdinal := 0; Result.FManaged := IInterface(PPointer(@Data)^); end; else begin Result.FOrdinal := 0; Result.FManaged := TMyc3Value.Create(Data); end; end; end; function TTag.AsType: T; begin {$ifdef DEBUG} if FTypeInfo=nil then RaiseInvalidOperation( 'TTag not initialized, value of type %s expected', [PTypeInfo(TypeInfo(T)).Name] ); if FTypeInfo <> TypeInfo(T) then RaiseInvalidOperation( 'TTag<%s> can''t cast to %s', [FTypeInfo.Name, PTypeInfo(TypeInfo(T)).Name] ); {$endif} case PTypeInfo(TypeInfo(T)).Kind of tkInteger: begin case PTypeInfo(TypeInfo(T)).TypeData.OrdType of otSByte: PShortInt(@Result)^ := PShortInt(@FOrdinal)^; otUByte: PByte(@Result)^ := PByte(@FOrdinal)^; otSWord: PSmallInt(@Result)^ := PSmallInt(@FOrdinal)^; otUWord: PWord(@Result)^ := PWord(@FOrdinal)^; otSLong: PInteger(@Result)^ := PInteger(@FOrdinal)^; otULong: PLongword(@Result)^ := PLongword(@FOrdinal)^; end; end; tkInt64: begin PInt64(@Result)^ := FOrdinal; end; tkFloat: begin case PTypeInfo(TypeInfo(T)).TypeData.FloatType of ftSingle: PSingle(@Result)^ := PSingle(@FOrdinal)^; ftDouble: PDouble(@Result)^ := PDouble(@FOrdinal)^; else Result := IMyc3Value( FManaged ).Value; end; end; {$IFNDEF AUTOREFCOUNT} tkClass, {$ENDIF} tkPointer: begin PPointer(@Result)^ := PPointer(@FOrdinal)^; end; tkInterface: begin IInterface(PPointer(@Result)^) := FManaged; end; else begin Result := IMyc3Value( FManaged ).Value; end; end; end; { TMycStateQueue } constructor TMycStateQueue.Create(const AStack: IAtomicStack); begin FStack := AStack; end; procedure TMycStateQueue.Add(const S: IMyc2State); begin FStack.Push( S ); end; class function TMycStateQueue.Create: TMycStateQueue; begin Result.Create( TAtomicStack.Create ); end; procedure TMycStateQueue.WaitFor; var S: IMyc2State; begin S := FStack.Pop; while S<>nil do begin Tasks.WaitFor( S ); S := FStack.Pop; end; end; { TMutable } class function TMutable.FromSignals(const Changed: array of IMyc2Signal; const Calculator: TFunc): IMyc3Mutable; begin Result := TMyc3Mutable.CreateMutable( Changed, Calculator ); end; class function TMutable.FromSignals(const Changed: array of IMyc2Signal; const Calculator: TFunc>): IMyc3Mutable; begin Result := TMyc3EnclosedMutable.Create( TMyc3Mutable>.CreateMutable( Changed, Calculator ) ); end; class function TMutable.From(const Value: IMyc3Mutable; const Conv: TFunc>): TMutable; begin Result := TMyc3EnclosedMutable.Create( TValue>.CreateMutable( Value, Conv ) ); end; class operator TMutable.Explicit(const Value: T): TMutable; begin Result.FThis := TMyc3ConstantMutable.Create( Value ); end; class operator TMutable.Implicit( const Item: TMutable): IMyc3Mutable; begin Result := Item.FThis; end; class operator TMutable.Implicit( const Item: IMyc3Mutable): TMutable; begin Result.FThis := Item; end; { TParameterValue } constructor TParameterValue.Create( ATypeInfo: PTypeInfo; const AMutable: IMyc3Mutable ); begin FMutable := AMutable; {$ifdef DEBUG} FTypeInfo := ATypeInfo; {$endif} end; function TParameterValue.Get: T; begin Assert( FMutable<>nil, 'Value is NULL' ); Result := AsType.Value; end; function TParameterValue.AsType: IMyc3Mutable; begin {$ifdef DEBUG} CheckType( TypeInfo( T ) ); {$endif} Result := IMyc3Mutable( FMutable ); end; class function TParameterValue.Compare( const A, B: TParameterValue ): Integer; begin Result := CompareValue( NativeInt( A.Mutable ), NativeInt( B.Mutable ) ); end; class function TParameterValue.FromArray( const Values: TArray ): TArray>; var i: Integer; begin SetLength( Result, Length( Values ) ); for i := 0 to High( Result ) do Result[i] := Values[i].AsType; end; class function TParameterValue.Create( const Intf: T ): TParameterValue; begin Result.Create( TypeInfo( T ), TValue.CreateMutable( Intf ) ); end; class function TParameterValue.Create( const Intf: IMyc3Mutable ): TParameterValue; begin Result.Create( TypeInfo( T ), Intf ); end; constructor TParameterValue.Assign( const Src: TParameterValue ); begin {$ifdef DEBUG} CheckType( Src.FTypeInfo ); {$endif} FMutable := Src.FMutable; end; {$ifdef DEBUG} procedure TParameterValue.CheckType(TI: PTypeInfo); begin Assert( FTypeInfo = TI, Format( 'Type mismatch (casting param %s to %s)', [FTypeInfo.Name, TI.Name] ) ); end; {$endif} class function TParameterValue.FromVarRec( const VarRec: TVarRec ): TParameterValue; begin case VarRec.VType of vtInteger: Result := TParameterValue.Create( VarRec.VInteger ); vtBoolean: Result := TParameterValue.Create( VarRec.VBoolean ); vtWideChar: Result := TParameterValue.Create( VarRec.VWideChar ); vtInt64: Result := TParameterValue.Create( VarRec.VInt64^ ); vtChar: Result := TParameterValue.Create( String( VarRec.VChar ) ); vtPChar: Result := TParameterValue.Create( String( VarRec.VPChar ) ); vtPWideChar: Result := TParameterValue.Create( String( VarRec.VPWideChar ) ); vtString: Result := TParameterValue.Create( String( VarRec.VString^ ) ); vtWideString: Result := TParameterValue.Create( String( VarRec.VWideString ) ); vtAnsiString: Result := TParameterValue.Create( String( VarRec.VAnsiString ) ); vtUnicodeString: Result := TParameterValue.Create( String( VarRec.VUnicodeString ) ); vtObject: Result := TParameterValue.Create( TObject( VarRec.VObject ) ); vtClass: Result := TParameterValue.Create( VarRec.VClass ); vtVariant: Result := TParameterValue.Create( VarRec.VVariant^ ); vtPointer: Result := TParameterValue.Create( VarRec.VPointer ); vtExtended: Result := TParameterValue.Create( VarRec.VExtended^ ); vtCurrency: Result := TParameterValue.Create( VarRec.VCurrency^ ); vtInterface: Result := TParameterValue.Create( IInterface( VarRec.VInterface ) ); end; end; { TParameterField } constructor TParameterField.Create( AID: TFieldID; const AValue: TParameterValue ); begin FID := AID; FValue := AValue; end; class function TParameterField.Create( ID: TFieldID; const Intf: IMyc3Mutable ): TParameterField; begin Result := TParameterField.Create( ID, TParameterValue.Create( Intf ) ); end; class function TParameterField.Create( ID: TFieldID; const Intf: T ): TParameterField; begin Result := TParameterField.Create( ID, TParameterValue.Create( Intf ) ); end; { TParameterRecord } constructor TParameterRecord.Create( const AThis: IMyc3ParameterRecord ); begin FThis := AThis; end; function TParameterRecord.AsType( ID: TFieldID ): IMyc3Mutable; begin Result := GetValues( ID ).AsType; end; function TParameterRecord.Get(ID: TFieldID): T; begin Result := GetValues( ID ).Get; end; function TParameterRecord.GetByName( const Caption: String ): TParameterValue; begin Result := FThis.ByName[Caption]; end; function TParameterRecord.GetDef: IMycParameterRecordDefinition; begin Result := FThis.Def; end; function TParameterRecord.GetValues(ID: TFieldID): TParameterValue; begin Result := FThis.Values[ID]; end; class operator TParameterRecord.Implicit(const Item: IMyc3ParameterRecord): TParameterRecord; begin Result.Create( Item ); end; class operator TParameterRecord.Implicit(const Item: TParameterRecord): IMyc3ParameterRecord; begin Result := Item.FThis; end; { TParameterSpace } constructor TParameterSpace.Create( const AThis: IMycParameterSpace ); begin FThis := AThis; end; function TParameterSpace.CompareValues( FieldID: TFieldID; const A, B: TParameterValue ): Integer; begin Result := FThis.CompareValues( FieldID, A, B ); end; class function TParameterSpace.Create: TParameterSpace; begin Result.Create( TMycParameterSpace.Create ); end; function TParameterSpace.CreateRecord( const Fields: TArray ): TParameterRecord; begin Result.Create( FThis.CreateRecord( Fields ) ); end; function TParameterSpace.GetCaptions( FieldID: TFieldID ): String; begin Result := FThis.Captions[FieldID]; end; function TParameterSpace.GetComparer( FieldID: TFieldID ): IComparer; begin Result := FThis.Comparer[FieldID]; end; function TParameterSpace.GetDefaultValues( FieldID: TFieldID ): TParameterValue; begin Result := FThis.DefaultValues[FieldID]; end; function TParameterSpace.GetFieldCount: Integer; begin Result := FThis.FieldCount; end; function TParameterSpace.AddField(const Caption: String; const DefaultValue: T; const Comparer: IComparer = nil): TFieldID; var ValueComparer: IComparer; Comp: IComparer; begin ValueComparer := Comparer; if ValueComparer=nil then ValueComparer := TComparer.Default; Comp := TComparer.Construct( function( const A, B: TParameterValue ): Integer begin if ( A.Mutable <> nil ) and ( B.Mutable<>nil ) then Result := ValueComparer.Compare( A.AsType.Value, B.AsType.Value ) else if A.Mutable <> nil then Result := 1 else if B.Mutable <> nil then Result := -1 else Result := 0; end ); Result := FThis.AddField( TypeInfo( T ), Caption, TValue.CreateMutable( DefaultValue ), Comp ); end; function TParameterSpace.CreateDef(const Fields: TArray): IMycParameterRecordDefinition; begin Result := FThis.CreateDef( Fields ); end; class operator TParameterSpace.Implicit( const Item: TParameterSpace ): IMycParameterSpace; begin Result := Item.FThis; end; class operator TParameterSpace.Implicit( const Item: IMycParameterSpace ): TParameterSpace; begin Result.Create( Item ); end; { TMutableFuture } class function TMutableFuture.FromArray(const Value: TArray>>): IMyc3Mutable>>; begin Result := Mutable.Convert>, IMyc3Future>>( Mutable.FromArray>( Value ), function( Value: TArray> ): IMyc3Future> begin Result := TFuture.FromArray( Value ); end ); end; constructor TStackTrace.Create(ASkipFrames: Cardinal; const AMsg: String = ''); begin Msg := AMsg; {$ifdef FullDebugMode} FastMM_EnterDebugMode; FastMM_GetStackTrace(@StackTrace, Length(StackTrace), 0); {$endif} end; function TStackTrace.ToText: String; {$ifdef FullDebugMode} var LStackTraceBuffer: array[0..Len * 160] of WideChar; {$endif} begin Result := Msg; if Result<>'' then Result := Result + #13#10; {$ifdef FullDebugMode} FastMM_ConvertStackTraceToText( @StackTrace, Length(StackTrace), @LStackTraceBuffer, @LStackTraceBuffer[High(LStackTraceBuffer)]); Result := Result + LStackTraceBuffer; {$else} Result := Result + 'StackTrace: FullDebugMode not enabled'; {$endif} end; class function TValidatable.FromSignal(const Signal: IMyc2Signal): IMyc3Validatable; begin Result := TMyc3ValidatableSignal.Create(Signal); end; initialization Tasks := TMyc3Tasks.Create( TMyc2TaskFactory.Create ); finalization FreeAndNil( Tasks ); end.