unit ASExpression;
{$WARN SYMBOL_PLATFORM OFF}
{$WARN DUPLICATE_CTOR_DTOR OFF}
interface
uses
SysUtils, Types, Classes, ASNum, ASTree, ASKernelDefs, ASObjects, ASObjStore,
ASStructs, Generics.Defaults, Generics.Collections, ASExecutionContext,
ASPixmap, ASSounds, ASTable, ASColors, GenHelpers, Math, Graphics,
SyncObjs;
type
TASExprNode = class;
TASExprNodeClass = class of TASExprNode;
TASFunction = class;
TASFunctionClass = class of TASFunction;
TResumeAction = (raResume, raAbort);
TASExpression = class(TTree)
strict private
function GetExprRoot: TASExprNode; inline;
protected
procedure DoCreateRoot(ARootNodeClass: TTreeNodeClass); override;
public
function ToString: string; override;
type
TNodeMapping = TDictionary<TASExprNode, TASExprNode>;
var
Context: TExecutionContextRef;
constructor Create(ARootNodeClass: TASExprNodeClass); overload;
constructor Create(ALiteralValue: TAlgosimObject); overload;
constructor Create(const AText: string); overload;
property Root: TASExprNode read GetExprRoot;
procedure Evaluate; inline;
procedure Reset; inline;
function Clone(ANodeMapping: TNodeMapping = nil): TASExpression; overload;
end;
TASExprNode = class abstract(TTreeNode)
strict private
function GetExpression: TASExpression; inline;
function GetContext: TExecutionContextRef; inline;
function GetExprParent: TASExprNode; inline;
function GetExprChild(AIndex: Integer): TASExprNode; inline;
strict protected
procedure QuitPauseCheck;
protected
procedure ValidateParent(ATree: TTree; AParent: TTreeNode); override;
function DoAddChild(ANodeClass: TTreeNodeClass): TTreeNode; override;
public
Value: TAlgosimObject;
Tag: Integer;
Depth: Integer;
procedure ManualAbort;
function DoPause(AResumeEvent, AAbortEvent: TEvent): TResumeAction;
function AddChild(ANodeClass: TASExprNodeClass): TASExprNode; overload; inline;
function AddChild(ALiteralValue: TAlgosimObject): TASExprNode; overload;
function AddChild(const AText: string): TASExprNode; overload;
procedure Evaluate; virtual; abstract;
function EvalChild(AIndex: Integer): Boolean; inline;
function EvalChildCtrl(AIndex: Integer): Boolean; inline;
function EvalChildren(AFrom: Integer = 0): Boolean; inline;
procedure Reset;
destructor Destroy; override;
procedure Clear; override;
procedure Assign(const ASource: TASExprNode;
ANodeMapping: TASExpression.TNodeMapping = nil); virtual;
function SubtreeAsString(ALevel: Integer = 0): string; overload;
function SubtreeAsString(const AArgs: TTable<TASExprNode>;
ALevel: Integer = 0): string; overload;
function ToString: string; override;
property Parent: TASExprNode read GetExprParent;
property Children[Index: Integer]: TASExprNode read GetExprChild;
property Expression: TASExpression read GetExpression;
property Context: TExecutionContextRef read GetContext;
function ExprNodeClassType: TASExprNodeClass; inline;
function ExpressionRootedHere: TASExpression;
function LValuePart: Boolean; virtual;
function BuildLValue(LValueData: TLValueData): Boolean; virtual;
class function NodeName: string; virtual;
end;
TASArgExprNode = class(TASExprNode)
procedure Evaluate; override;
procedure Assign(const ASource: TASExprNode;
ANodeMapping: TASExpression.TNodeMapping = nil); override;
class function NodeName: string; override;
end;
TAlgosimFunctionObject = class;
TFieldNumber = record
case Complex: Boolean of
True: (z: TASC);
False: (x: TASR)
end;
TArgumentExtractor = record
strict private
procedure TooFewArgs(const AMissingType: string);
function NextArg: TArgumentExtractor; inline;
private
Fcn: TASFunction;
Index: Integer;
public
type
TRestrictionDummy = (restr);
TDefValueDummy = (defval);
function ArgExists: Boolean; inline;
function Count: Integer; inline;
function PeekAt(const AIndex: Integer): TAlgosimObject; inline;
function Skip: TArgumentExtractor; inline;
function Extract<T: TAlgosimObject>(out Obj: T): TArgumentExtractor; overload;
function TryExtract<T: TAlgosimObject>(out Obj: T): Boolean;
function Extract(out Obj: TAlgosimObject): TArgumentExtractor; overload; inline;
function Extract(out Obj: TAlgosimObject; Def: TAlgosimObject): TArgumentExtractor; overload; inline;
function Extract(out NumericEntity: TAlgosimNumericEntity): TArgumentExtractor; overload; inline;
function Extract(out Number: TAlgosimNumber): TArgumentExtractor; overload; inline;
function Extract(out Integer: TAlgosimInteger): TArgumentExtractor; overload; inline;
function Extract(out RealNumber: TAlgosimRealNumber): TArgumentExtractor; overload; inline;
function Extract(out ComplexNumber: TAlgosimComplexNumber): TArgumentExtractor; overload; inline;
function Extract(out Vector: TAlgosimVector): TArgumentExtractor; overload; inline;
function Extract(out RealVector: TAlgosimRealVector): TArgumentExtractor; overload; inline;
function Extract(out ComplexVector: TAlgosimComplexVector): TArgumentExtractor; overload; inline;
function Extract(out Matrix: TAlgosimMatrix): TArgumentExtractor; overload; inline;
function Extract(out RealMatrix: TAlgosimRealMatrix): TArgumentExtractor; overload; inline;
function Extract(out ComplexMatrix: TAlgosimComplexMatrix): TArgumentExtractor; overload; inline;
function Extract(out Str: TAlgosimString): TArgumentExtractor; overload; inline;
function Extract(out Bool: TAlgosimBoolean): TArgumentExtractor; overload; inline;
function Extract(out List: TAlgosimArray): TArgumentExtractor; overload; inline;
function Extract(out List: TAlgosimArray; UseDefVal: TDefValueDummy;
Def: TAlgosimArray): TArgumentExtractor; overload; inline;
function Extract(out List: TAlgosimArray; UseRestriction: TRestrictionDummy;
ElementClass: TAlgosimObjectClass): TArgumentExtractor; overload; inline;
function Extract(out List: TAlgosimArray; UseRestriction: TRestrictionDummy;
ElementClass: TAlgosimObjectClass; UseDefVal: TDefValueDummy;
Def: TAlgosimArray): TArgumentExtractor; overload; inline;
function Extract(out Struct: TAlgosimStructure): TArgumentExtractor; overload; inline;
function Extract(out TypedStruct: TAlgosimTypedStructure): TArgumentExtractor; overload; inline;
function Extract(out StructType: TAlgosimStructureType): TArgumentExtractor; overload; inline;
function Extract(out ASSet: TAlgosimSet): TArgumentExtractor; overload; inline;
function Extract(out Pixmap: TAlgosimPixmap): TArgumentExtractor; overload; inline;
function Extract(out Table: TAlgosimTable): TArgumentExtractor; overload; inline;
function Extract(out Sound: TAlgosimSound): TArgumentExtractor; overload; inline;
function Extract(out Color: TAlgosimColor): TArgumentExtractor; overload; inline;
function Extract(out BinData: TAlgosimBinaryData): TArgumentExtractor; overload; inline;
function Extract(out FcnObj: TAlgosimFunctionObject): TArgumentExtractor; overload; inline;
function Extract(out FcnObj: TAlgosimFunctionObject;
const Def: TAlgosimFunctionObject): TArgumentExtractor; overload; inline;
function Extract(out Integer: TASI): TArgumentExtractor; overload; inline;
function Extract(out Integer: TASI; const Def: TASI): TArgumentExtractor; overload;
function ExtractNonNeg(out Integer: TASI): TArgumentExtractor; overload; inline;
function ExtractNonNeg(out Integer: TASI; const Def: TASI): TArgumentExtractor; overload;
function ExtractPos(out Integer: TASI): TArgumentExtractor; overload; inline;
function ExtractPos(out Integer: TASI; const Def: TASI): TArgumentExtractor; overload;
function Extract(out Integer: Integer): TArgumentExtractor; overload; inline;
function Extract(out Integer: Integer; const Def: Integer): TArgumentExtractor; overload;
function ExtractNonNeg(out Integer: Integer): TArgumentExtractor; overload; inline;
function ExtractNonNeg(out Integer: Integer; const Def: Integer): TArgumentExtractor; overload;
function ExtractPos(out Integer: Integer): TArgumentExtractor; overload; inline;
function ExtractPos(out Integer: Integer; const Def: Integer): TArgumentExtractor; overload;
function Extract(out RealNumber: TASR): TArgumentExtractor; overload; inline;
function Extract(out RealNumber: TASR; const [Ref] Def: TASR): TArgumentExtractor; overload;
function ExtractNonNeg(out RealNumber: TASR): TArgumentExtractor; overload; inline;
function ExtractNonNeg(out RealNumber: TASR; const Def: TASR): TArgumentExtractor; overload;
function ExtractPos(out RealNumber: TASR): TArgumentExtractor; overload; inline;
function ExtractPos(out RealNumber: TASR; const Def: TASR): TArgumentExtractor; overload;
function Extract(out ComplexNumber: TASC): TArgumentExtractor; overload; inline;
function Extract(out ComplexNumber: TASC; const Def: TASC): TArgumentExtractor; overload;
function Extract(out FieldNum: TFieldNumber): TArgumentExtractor; overload;
function Extract(out FieldNum: TFieldNumber; const Def: TASR): TArgumentExtractor; overload;
function Extract(out FieldNum: TFieldNumber; const Def: TASC): TArgumentExtractor; overload;
function Extract(out RealVector: TRealVector): TArgumentExtractor; overload; inline;
function Extract(out RealVector: TRealVector; const Def: TRealVector): TArgumentExtractor; overload;
function Extract(out ComplexVector: TComplexVector): TArgumentExtractor; overload; inline;
function Extract(out ComplexVector: TComplexVector; const Def: TComplexVector): TArgumentExtractor; overload;
function Extract(out RealMatrix: TRealMatrix): TArgumentExtractor; overload; inline;
function Extract(out RealMatrix: TRealMatrix; const Def: TRealMatrix): TArgumentExtractor; overload;
function Extract(out ComplexMatrix: TComplexMatrix): TArgumentExtractor; overload; inline;
function Extract(out ComplexMatrix: TComplexMatrix; const Def: TComplexMatrix): TArgumentExtractor; overload;
function Extract(out Str: string): TArgumentExtractor; overload; inline;
function Extract(out Str: string; const AAllowedStrs: array of string): TArgumentExtractor; overload;
function Extract(out Str: string; const Def: string): TArgumentExtractor; overload;
function Extract(out Str: string; const AAllowedStrs: array of string;
const Def: string): TArgumentExtractor; overload;
function Extract(out Bool: Boolean): TArgumentExtractor; overload; inline;
function Extract(out Bool: Boolean; const Def: Boolean): TArgumentExtractor; overload;
function Extract(out Pixmap: TASPixmap): TArgumentExtractor; overload; inline;
function Extract(out Pixmap: TASPixmap; const Def: TASPixmap): TArgumentExtractor; overload;
function Extract(out Table: TASTable): TArgumentExtractor; overload; inline;
function Extract(out Table: TASTable; const Def: TASTable): TArgumentExtractor; overload;
function Extract(out Sound: TASSound): TArgumentExtractor; overload; inline;
function Extract(out Sound: TASSound; const Def: TASSound): TArgumentExtractor; overload;
function Extract(out Color: TRGB): TArgumentExtractor; overload; inline;
function Extract(out Color: TRGB; const Def: TRGB): TArgumentExtractor; overload;
function Extract(out Date: TDate): TArgumentExtractor; overload;
function Extract(out Date: TDate; const Def: TDate): TArgumentExtractor; overload;
function Extract(out Time: TTime): TArgumentExtractor; overload;
function Extract(out Time: TTime; const Def: TTime): TArgumentExtractor; overload;
function Extract(out DateTime: TDateTime): TArgumentExtractor; overload;
function Extract(out DateTime: TDateTime; const Def: TDateTime): TArgumentExtractor; overload;
function Extract(out GUID: TGUID): TArgumentExtractor; overload;
function Extract(out Chr: Char): TArgumentExtractor; overload;
function Extract(out Chr: Char; const Def: Char): TArgumentExtractor; overload;
function Extract(out Chr: Char; const AAllowedChars: array of Char): TArgumentExtractor; overload;
function Extract(out Chr: Char; const AAllowedChars: array of Char;
const Def: Char): TArgumentExtractor; overload;
function Extract(out ChrSet: TSysCharSet): TArgumentExtractor; overload;
function Extract(out ChrSet: TSysCharSet; UseRestriction: TRestrictionDummy;
const AAllowedChars: TSysCharSet): TArgumentExtractor; overload;
function Extract(out ChrSet: TSysCharSet; UseDefVal: TDefValueDummy;
const Def: TSysCharSet): TArgumentExtractor; overload;
function Extract(out ChrSet: TSysCharSet; UseRestriction: TRestrictionDummy;
const AAllowedChars: TSysCharSet; UseDefVal: TDefValueDummy;
const Def: TSysCharSet): TArgumentExtractor; overload;
function Extract(out AStruct: TAlgosimTypedStructure;
AStructType: TStructType): TArgumentExtractor; overload;
function Extract(out AStruct: TAlgosimTypedStructure;
AStructType: TAlgosimStructureType): TArgumentExtractor; overload;
function Extract(out Strings: TArray<string>): TArgumentExtractor; overload;
function Extract(out Points: TArray<TPoint>): TArgumentExtractor; overload;
function Extract(out IntRangeArr: TArray<TRange>): TArgumentExtractor; overload;
function Extract(out Sounds: TArray<TASSound>): TArgumentExtractor; overload;
function MoveObject(out Dest: TAlgosimObject): TArgumentExtractor; overload; inline;
function MoveObject<T: TAlgosimObject>(out Dest: TAlgosimObject): TArgumentExtractor; overload; inline;
function MoveObject<T: TAlgosimObject>(out Dest: TAlgosimObject; out Ref: T): TArgumentExtractor; overload; inline;
function MoveObject(out Dest: TAlgosimTypedStructure; AStructType: TStructType): TArgumentExtractor; overload; inline;
procedure Close; inline;
function ExtractInt64s: TArray<Int64>;
function ExtractRealNumbers: TArray<TASR>;
function ExtractComplexNumbers: TArray<TASC>;
function ExtractRealVectors: TArray<TRealVector>;
function ExtractComplexVectors: TArray<TComplexVector>;
function ExtractRealMatrices: TArray<TRealMatrix>;
function ExtractComplexMatrices: TArray<TComplexMatrix>;
function ExtractStrings: TArray<string>;
function ExtractArray: TArray<TAlgosimObject>;
procedure ExtractPointListRn(out List: TArray<Double>; var Dimension: Integer);
function ExtractPointsR2: TArray<TASR2>;
function ExtractPointsR3: TArray<TASR3>;
procedure ExtractPointsR2orR3(out L2: TArray<TASR2>; out L3: TArray<TASR3>);
function ExtractStruct: TAlgosimStructure;
function ExtractSymbol(out ASymbol: string): TArgumentExtractor;
end;
TASFunction = class abstract(TASExprNode)
strict private
procedure CheckArgFailed(AIndex: Integer; AClass: TAlgosimObjectClass); overload;
procedure CheckArgFailed(AStructType: TStructType; AIndex: Integer); overload;
protected
procedure DoExecute; virtual; abstract;
procedure CheckNumArgs(AExpected: Integer); overload; inline;
procedure CheckNumArgs(const AExpected: array of Integer); overload;
procedure CheckNumArgsAtLeast(AMinCount: Integer); inline;
procedure CheckArg(AIndex: Integer; AClass: TAlgosimObjectClass); overload; inline;
procedure CheckArg(AIndex: Integer; AStructType: TStructType); overload; inline;
procedure CheckSymbol(AIndex: Integer);
procedure Extract<T: TAlgosimObject>(AIndex: Integer; out AArg: T); overload; inline;
function ExtractRef<T: TAlgosimObject>(AIndex: Integer; out AArg: T): Boolean; overload;
function ExtractRef(AIndex: Integer; out AArg: TAlgosimObject): Boolean; overload;
function ExtractStoreRef<T: TAlgosimObject>(AIndex: Integer): T; overload;
function ExtractStoreRef(AIndex: Integer): TAlgosimObject; overload;
function TryExtractStoreRef(AIndex: Integer; out ARef: TAlgosimObject): Boolean;
function TryGetAssignmentListLength(out ALength: Integer): Boolean;
function Args(AStartAt: Integer = 0): TArgumentExtractor; inline;
function TryLValueFetch: Boolean;
function HasComplexArg: Boolean; inline;
property Result: TAlgosimObject read Value write Value;
public
procedure Evaluate; override; final;
class function NodeName: string; override;
end;
TASFuncExprNode = TASFunction;
TASLiteralExprNode = class(TASExprNode)
Literal: TAlgosimObject;
procedure Evaluate; override;
destructor Destroy; override;
procedure Clear; override;
procedure Assign(const ASource: TASExprNode;
ANodeMapping: TASExpression.TNodeMapping = nil); override;
function ToString: string; override;
class function NodeName: string; override;
end;
TASSymbolExprNode = class(TASExprNode)
Symbol: string;
Preloaded: TAlgosimObject;
procedure Evaluate; override;
procedure Clear; override;
procedure Assign(const ASource: TASExprNode;
ANodeMapping: TASExpression.TNodeMapping = nil); override;
public
function BuildLValue(LValueData: TLValueData): Boolean; override;
function LValuePart: Boolean; override;
function ToString: string; override;
class function NodeName: string; override;
destructor Destroy; override;
end;
TASSimpleFunction = class abstract(TASFunction)
protected
procedure DoExecute; override; final;
procedure SimpleFunction; virtual; abstract;
end;
TASSimpleFunctionNum = class abstract(TASSimpleFunction)
protected
var
rfcn: TRealFunction;
cfcn: TComplexFunction;
procedure SimpleFunction; override;
end;
TASSimpleFunctionNumDom = class abstract(TASSimpleFunctionNum)
protected
var
rdom: TSimpleDomainDescription;
procedure SimpleFunction; override;
end;
TASSimpleFunctionReal = class abstract(TASSimpleFunction)
protected
var
rfcn: TRealFunction;
procedure SimpleFunction; override;
end;
TASCustomFunction = class(TASSimpleFunction)
strict private
fo: TAlgosimFunctionObject;
protected
procedure SimpleFunction; override;
public
property FunctionObject: TAlgosimFunctionObject read fo write fo;
end;
[AlgosimObject('function', [])]
TAlgosimFunctionObject = class abstract(TAlgosimObject)
public
function GetAsSingleLineText(const AOptions: TFormatOptions): string; override;
function Execute(AContext: TExecutionContextRef;
AArgs: TASExprNode): TAlgosimObject; overload; virtual; abstract;
function Execute(AContext: TExecutionContextRef;
const AArgs: array of TAlgosimObject;
AOwnsArgs: Boolean): TAlgosimObject; overload; virtual; abstract;
end;
[AlgosimObject('kernel function', [])]
TKernelFunctionObj = class(TAlgosimFunctionObject)
protected
FFuncClass: TASFunctionClass;
public
constructor Create(AObject: TAlgosimObject); override;
constructor Create(AFuncClass: TASFunctionClass); overload;
function Equals(Obj: TObject): Boolean; override;
function ToString: string; override;
property FuncClass: TASFunctionClass read FFuncClass write FFuncClass;
function Execute(AContext: TExecutionContextRef;
AArgs: TASExprNode): TAlgosimObject; overload; override;
function Execute(AContext: TExecutionContextRef;
const AArgs: array of TAlgosimObject;
AOwnsArgs: Boolean): TAlgosimObject; overload; override;
end;
[AlgosimObject('custom function', [])]
TCustomFunctionObj = class(TAlgosimFunctionObject)
public
Expression: TASExpression;
Arguments: TTable<TASExprNode>;
constructor Create(AObject: TAlgosimObject); override;
destructor Destroy; override;
function Equals(Obj: TObject): Boolean; override;
function Execute(AContext: TExecutionContextRef;
AArgs: TASExprNode): TAlgosimObject; overload; override;
function Execute(AContext: TExecutionContextRef;
const AArgs: array of TAlgosimObject;
AOwnsArgs: Boolean): TAlgosimObject; overload; override;
function ExprAsStr(AStrict: Boolean): string;
end;
TASListExprNode = class(TASSimpleFunction)
protected
procedure SimpleFunction; override;
public
class function NodeName: string; override;
end;
function IsSymbol(ANode: TASExprNode): Boolean; overload; inline;
function IsSymbol(ANode: TASExprNode; const ASymbol: string): Boolean; overload; inline;
function IsSymbolAny(ANode: TASExprNode; const ASymbols: array of string): Boolean;
function IsBifurcation(ANode: TASExprNode): Boolean; inline;
procedure FindSymbols(ARoot: TASExprNode; const ASymbol: string;
AList: TList<TASExprNode>);
procedure PopulateSymbols(ASymbols: TList<TASExprNode>; AValue: TAlgosimObject);
function GetLValue(ANode: TASExprNode; out LValueData: TLValueData): Boolean;
function NodeName(ANode: TClass): string;
function NodeNames(const ANodes: array of TClass): TArray<string>; overload;
procedure CheckFailure(AObj: TAlgosimObject); inline;
implementation
uses
ASFunctions, DateUtils, StrUtils, ASFcnMgr;
procedure TASSimpleFunction.DoExecute;
begin
if not EvalChildren then Exit;
SimpleFunction;
end;
procedure TASFunction.Evaluate;
begin
Expression.Context.EnterFcn;
FreeAndNil(Value);
try
QuitPauseCheck;
if Expression.Context.RecursionDepth > 512 then
raise ETooDeepRecursion.Create(STooDeepRecursion);
var OldYieldProc := GTYieldProc;
GTYieldProc := QuitPauseCheck;
try
DoExecute;
finally
GTYieldProc := OldYieldProc;
end;
except
on E: Exception do
begin
FreeAndNil(Value);
Value := ASO(failure, E.Message);
if (E is ERuntimeException) and Assigned(ERuntimeException(E).Source) and (Value is TAlgosimFailure) then
TAlgosimFailure(Value).Source.AddRange(ERuntimeException(E).Source);
end;
end;
Expression.Context.LeaveFcn;
if IsFailure(Value) then
TAlgosimFailure(Value).Source.Add(ClassType);
if not Assigned(Value) then
Value := ASO(null);
end;
procedure TASFunction.CheckArgFailed(AStructType: TStructType; AIndex: Integer);
begin
if Assigned(Children[AIndex].Value) then
raise EInvArgs.CreateFmt(SInvArgClass, [AStructType.Name, AIndex + 1, Children[AIndex].Value.TypeName])
else
raise EInvArgs.CreateFmt(SInvArgClass, [AStructType.Name, AIndex + 1, 'nil pointer']);
end;
procedure TASFunction.CheckArgFailed(AIndex: Integer; AClass: TAlgosimObjectClass);
begin
if Assigned(Children[AIndex].Value) then
raise EInvArgs.CreateFmt(SInvArgClass, [AClass.ClassTypeName, AIndex + 1, Children[AIndex].Value.TypeName])
else
raise EInvArgs.CreateFmt(SInvArgClass, [AClass.ClassTypeName, AIndex + 1, 'nil pointer']);
end;
function TASFunction.HasComplexArg: Boolean;
var
i: Integer;
begin
for i := 0 to ChildCount - 1 do
if Children[i].Value.IsComplex then
Exit(True);
Result := False;
end;
class function TASFunction.NodeName: string;
var
FcnNames: TArray<string>;
begin
if TFunctionMgr.Names.TryGetValue(Self, FcnNames) and (Length(FcnNames) > 0) then
Result := FcnNames[0]
else
Result := inherited;
end;
function TASFunction.TryExtractStoreRef(AIndex: Integer;
out ARef: TAlgosimObject): Boolean;
var
LValueData: TLValueData;
begin
Result := GetLValue(Children[AIndex], LValueData);
if Result then
try
Context.GetObjRef(LValueData, ARef);
finally
LValueData.Free;
end
else
ARef := nil;
end;
function TASFunction.TryGetAssignmentListLength(out ALength: Integer): Boolean;
begin
Result := (Parent is TASListExprNode) and
(Parent.Parent is FCN_Assign) and
(Parent.Parent.ChildCount = 2) and
(Parent.Parent.Children[0] is TASListExprNode);
if Result then
ALength := Parent.Parent.Children[0].ChildCount;
end;
function TASFunction.TryLValueFetch: Boolean;
var
LValueData: TLValueData;
begin
Result := GetLValue(Self, LValueData);
if Result then
try
Context.GetValue(LValueData, Value);
if Value = nil then
Exit(False);
finally
LValueData.Free;
end
end;
procedure TASFunction.CheckArg(AIndex: Integer; AClass: TAlgosimObjectClass);
begin
Assert(InRange(AIndex, 0, ChildCount - 1), 'TASFunction.CheckArg: AIndex out of range.');
if not (Children[AIndex].Value is AClass) then
CheckArgFailed(AIndex, AClass);
end;
function TASFunction.Args(AStartAt: Integer = 0): TArgumentExtractor;
begin
Result.Fcn := Self;
Result.Index := AStartAt;
end;
procedure TASFunction.CheckArg(AIndex: Integer; AStructType: TStructType);
begin
Assert(InRange(AIndex, 0, ChildCount - 1), 'TASFunction.CheckArg: AIndex out of range.');
if not AStructType.MatchingName(Children[AIndex].Value) then
CheckArgFailed(AStructType, AIndex);
end;
procedure TASFunction.CheckNumArgs(const AExpected: array of Integer);
var
i: Integer;
begin
for i := 0 to High(AExpected) do
if ChildCount = AExpected[i] then
Exit;
raise EInvArgs.CreateFmt(SWrongArgCountUnspec, [ChildCount]);
end;
procedure TASFunction.CheckNumArgsAtLeast(AMinCount: Integer);
begin
if ChildCount < AMinCount then
raise EInvArgs.CreateFmt(STooFewArgs, [AMinCount]);
end;
procedure TASFunction.CheckNumArgs(AExpected: Integer);
begin
if ChildCount <> AExpected then
raise EInvArgs.CreateFmt(SWrongArgCount, [AExpected, ChildCount]);
end;
procedure TASFunction.CheckSymbol(AIndex: Integer);
begin
Assert(InRange(AIndex, 0, ChildCount - 1), 'TASFunction.CheckSymbol: AIndex out of range.');
if not IsSymbol(Children[AIndex]) then
raise EInvArgs.CreateFmt(SASymbolWasExpected, [AIndex + 1]);
end;
procedure TASFunction.Extract<T>(AIndex: Integer; out AArg: T);
begin
Assert(InRange(AIndex, 0, ChildCount - 1), 'TASFunction.Extract<T>: AIndex out of range.');
CheckArg(AIndex, T);
AArg := T(Children[AIndex].Value);
end;
function TASFunction.ExtractRef(AIndex: Integer;
out AArg: TAlgosimObject): Boolean;
begin
Result := ExtractRef<TAlgosimObject>(AIndex, AArg);
end;
function TASFunction.ExtractRef<T>(AIndex: Integer; out AArg: T): Boolean;
var
LValueData: TLValueData;
Obj: TAlgosimObject;
begin
Assert(InRange(AIndex, 0, ChildCount - 1), 'TASFunction.ExtractRef: AIndex out of range.');
Result := True;
LValueData := nil;
try
if GetLValue(Children[AIndex], LValueData) and Context.GetObjRef(LValueData, Obj).Success then
if Obj is T then
AArg := T(Obj)
else
raise EInvArgs.CreateFmt(SInvArgClass,
[T.ClassTypeName, AIndex + 1, Obj.TypeName])
else
begin
if not EvalChild(AIndex) then Exit(False);
Extract<T>(AIndex, AArg);
end;
finally
LValueData.Free;
end;
end;
function TASFunction.ExtractStoreRef<T>(AIndex: Integer): T;
var
LValueData: TLValueData;
Obj: TAlgosimObject;
begin
if not GetLValue(Children[AIndex], LValueData) then
raise EIllegalLValue.Create(SLeftSideCannotBeAssignedTo);
try
if not Context.GetObjRef(LValueData, Obj).Success then
raise EIllegalLValue.Create(SLeftSideCannotBeAssignedTo);
if Obj is T then
Result := T(Obj)
else
raise EInvArgs.CreateFmt(SInvArgClass,
[T.ClassTypeName, AIndex + 1, Obj.TypeName]);
finally
LValueData.Free;
end;
end;
function TASFunction.ExtractStoreRef(AIndex: Integer): TAlgosimObject;
var
LValueData: TLValueData;
begin
if not GetLValue(Children[AIndex], LValueData) then
raise EIllegalLValue.Create(SLeftSideCannotBeAssignedTo);
try
if not Context.GetObjRef(LValueData, Result).Success then
raise EIllegalLValue.Create(SLeftSideCannotBeAssignedTo);
finally
LValueData.Free;
end;
end;
procedure TASSimpleFunctionNum.SimpleFunction;
var
Arg: TAlgosimNumber;
begin
Args.Extract(Arg).Close;
Result := Arg.ComputeFunction(rfcn, cfcn);
end;
procedure TASSimpleFunctionNumDom.SimpleFunction;
var
Arg: TAlgosimNumber;
begin
Args.Extract(Arg).Close;
Result := Arg.ComputeFunction(rdom, rfcn, cfcn);
end;
procedure TASSimpleFunctionReal.SimpleFunction;
var
X: TASR;
begin
Args.Extract(X).Close;
Result := ASO(rfcn(X));
end;
function TCustomFunctionObj.Execute(AContext: TExecutionContextRef;
AArgs: TASExprNode): TAlgosimObject;
var
i: Integer;
j: Integer;
begin
if AArgs = nil then
begin
if Length(Arguments) <> 0 then
raise EInvArgs.CreateFmt(SWrongArgCount,
[Length(Arguments), 0]);
end
else
begin
if Length(Arguments) <> AArgs.ChildCount then
raise EInvArgs.CreateFmt(SWrongArgCount,
[Length(Arguments), AArgs.ChildCount]);
for i := 0 to High(Arguments) do
for j := 0 to High(Arguments[i]) do
begin
if not (Arguments[i][j] is TASSymbolExprNode) then
raise EExpressionException.Create('Custom function object''s argument isn''t a symbol node.');
FreeAndNil(TASSymbolExprNode(Arguments[i][j]).Preloaded);
if j = High(Arguments[i]) then
TMover<TAlgosimObject>.Move(TASSymbolExprNode(Arguments[i][j]).Preloaded, AArgs.Children[i].Value)
else
TASSymbolExprNode(Arguments[i][j]).Preloaded := AArgs.Children[i].Value.Clone;
end;
end;
Expression.Context := AContext;
Expression.Evaluate;
CheckFailure(Expression.Root.Value);
TMover<TAlgosimObject>.Move(Result, Expression.Root.Value);
end;
constructor TCustomFunctionObj.Create(AObject: TAlgosimObject);
function TranslateArguments(const AOldList: TTable<TASExprNode>;
AMapping: TASExpression.TNodeMapping): TTable<TASExprNode>;
var
i, j: Integer;
begin
SetLength(Result, Length(AOldList));
for i := 0 to High(AOldList) do
begin
SetLength(Result[i], Length(AOldList[i]));
for j := 0 to High(AOldList[i]) do
Result[i][j] := AMapping[AOldList[i][j]];
end;
end;
var
NodeMapping: TASExpression.TNodeMapping;
begin
if AObject is TCustomFunctionObj then
begin
inherited Create;
NodeMapping := TASExpression.TNodeMapping.Create;
try
Expression := TCustomFunctionObj(AObject).Expression.Clone(NodeMapping);
Arguments := TranslateArguments(TCustomFunctionObj(AObject).Arguments, NodeMapping);
finally
NodeMapping.Free;
end;
end
else
NoCopyConstr(AObject);
end;
destructor TCustomFunctionObj.Destroy;
begin
Arguments := nil;
Expression.Free;
inherited;
end;
function TCustomFunctionObj.Equals(Obj: TObject): Boolean;
var
rhs: TCustomFunctionObj;
begin
Result := False;
if Obj is TCustomFunctionObj then
begin
rhs := TCustomFunctionObj(Obj);
Result := Expression.Root.SubtreeAsString(Arguments) = rhs.Expression.Root.SubtreeAsString(rhs.Arguments);
end;
end;
function TCustomFunctionObj.Execute(AContext: TExecutionContextRef;
const AArgs: array of TAlgosimObject; AOwnsArgs: Boolean): TAlgosimObject;
var
ArgList: TASExpression;
begin
ArgList := TASExpression.Create(TASListExprNode);
try
ArgList.Context := AContext;
ArgList.Root.Capacity := Length(AArgs);
if (Length(AArgs) = 1) and (Length(Arguments) > 1) and (AArgs[0] is TAlgosimVector) then
begin
try
if AArgs[0] is TAlgosimRealVector then
begin
var v := TAlgosimRealVector(AArgs[0]).Value;
for var i := 0 to v.Dimension - 1 do
begin
ArgList.Root.AddChild(TASArgExprNode);
ArgList.Root.Children[i].Value := ASO(v[i]);
end;
end
else
begin
var v := (AArgs[0] as TAlgosimComplexVector).Value;
for var i := 0 to v.Dimension - 1 do
begin
ArgList.Root.AddChild(TASArgExprNode);
ArgList.Root.Children[i].Value := ASO(v[i]);
end;
end;
finally
if AOwnsArgs then
AArgs[0].Free;
end;
end
else if (Length(AArgs) = 1) and (Length(Arguments) > 1) and (AArgs[0] is TAlgosimArray) then
begin
try
for var i := 1 to AArgs[0].ElementCount do
begin
ArgList.Root.AddChild(TASArgExprNode);
ArgList.Root.Children[i - 1].Value := AArgs[0].Elements[i].Clone;
end;
finally
if AOwnsArgs then
AArgs[0].Free;
end;
end
else
begin
for var i := 0 to High(AArgs) do
begin
ArgList.Root.AddChild(TASArgExprNode);
if AOwnsArgs then
ArgList.Root.Children[i].Value := AArgs[i]
else
ArgList.Root.Children[i].Value := AArgs[i].Clone
end;
end;
Result := Execute(AContext, ArgList.Root);
finally
ArgList.Free;
end;
end;
function TCustomFunctionObj.ExprAsStr(AStrict: Boolean): string;
var
i: Integer;
ArgArr: TArray<string>;
ArgList: string;
begin
if AStrict then
Result := Expression.Root.SubtreeAsString(Arguments)
else
begin
for i := 0 to High(Arguments) do
if Length(Arguments[i]) > 0 then
TArrBuilder<string>.Add(ArgArr, Arguments[i][0].ToString)
else
TArrBuilder<string>.Add(ArgArr, '(dummy)');
ArgList := 'Arguments: ' + string.Join(', ', ArgArr);
Result := ArgList + sLineBreak + Expression.Root.SubtreeAsString;
end;
end;
procedure TASCustomFunction.SimpleFunction;
begin
if fo = nil then
raise EKernelException.Create(SNoFunctionObj);
Result := fo.Execute(Context, Self);
end;
function IsSymbol(ANode: TASExprNode): Boolean;
begin
Result := ANode is TASSymbolExprNode;
end;
function IsSymbol(ANode: TASExprNode; const ASymbol: string): Boolean;
begin
Result := (ANode is TASSymbolExprNode) and
(TASSymbolExprNode(ANode).Symbol = ASymbol);
end;
function IsSymbolAny(ANode: TASExprNode; const ASymbols: array of string): Boolean;
begin
Result := (ANode is TASSymbolExprNode) and
(IndexStr(TASSymbolExprNode(ANode).Symbol, ASymbols) <> -1)
end;
function IsBifurcation(ANode: TASExprNode): Boolean;
begin
Result := ANode is TASListExprNode;
end;
procedure FindSymbols(ARoot: TASExprNode; const ASymbol: string;
AList: TList<TASExprNode>);
var
i: Integer;
begin
if ARoot = nil then Exit;
if IsSymbol(ARoot, ASymbol) then
AList.Add(ARoot)
else
for i := 0 to ARoot.ChildCount - 1 do
FindSymbols(ARoot.Children[i], ASymbol, AList);
end;
procedure PopulateSymbols(ASymbols: TList<TASExprNode>; AValue: TAlgosimObject);
var
i: Integer;
begin
try
for i := 0 to ASymbols.Count - 1 do
begin
if not (ASymbols[i] is TASSymbolExprNode) then
raise EExpressionException.Create('Cannot populate a non-symbol node.');
FreeAndNil(TASSymbolExprNode(ASymbols[i]).Preloaded);
TASSymbolExprNode(ASymbols[i]).Preloaded := AValue.Clone;
end;
finally
AValue.Free;
end;
end;
function GetLValue(ANode: TASExprNode; out LValueData: TLValueData): Boolean;
begin
if not ANode.LValuePart then
Exit(False);
LValueData := TLValueData.Create;
try
Result := ANode.BuildLValue(LValueData);
if not Result then FreeAndNil(LValueData);
except
FreeAndNil(LValueData);
Result := False;
end;
end;
function TASExprNode.AddChild(ANodeClass: TASExprNodeClass): TASExprNode;
begin
Result := TASExprNode(inherited AddChild(ANodeClass));
Result.Depth := Self.Depth + 1;
if Result.Depth > MAX_EXPR_DEPTH then
raise EParseException.Create(SExpressionTooDeep);
end;
function TASExprNode.AddChild(ALiteralValue: TAlgosimObject): TASExprNode;
begin
try
Result := AddChild(TASLiteralExprNode);
except
ALiteralValue.Free;
raise;
end;
TASLiteralExprNode(Result).Literal := ALiteralValue;
end;
function TASExprNode.AddChild(const AText: string): TASExprNode;
begin
Result := AddChild(TASSymbolExprNode);
TASSymbolExprNode(Result).Symbol := AText;
end;
procedure TASExprNode.Assign(const ASource: TASExprNode;
ANodeMapping: TASExpression.TNodeMapping);
var
i: Integer;
begin
if Assigned(ANodeMapping) then
ANodeMapping.Add(ASource, Self);
Clear;
Capacity := ASource.ChildCount;
for i := 0 to ASource.ChildCount - 1 do
AddChild(ASource.Children[i].ExprNodeClassType)
.Assign(ASource.Children[i], ANodeMapping);
end;
function TASExprNode.BuildLValue(LValueData: TLValueData): Boolean;
begin
Result := False;
end;
procedure TASExprNode.Clear;
begin
inherited;
FreeAndNil(Value);
end;
destructor TASExprNode.Destroy;
begin
FreeAndNil(Value);
inherited;
end;
function TASExprNode.DoAddChild(ANodeClass: TTreeNodeClass): TTreeNode;
begin
if not ANodeClass.InheritsFrom(TASExprNode) then
raise EExpressionException.Create(SExprNodeChildren);
Result := inherited DoAddChild(ANodeClass);
end;
function TASExprNode.DoPause(AResumeEvent, AAbortEvent: TEvent): TResumeAction;
var
Obj: THandleObject;
begin
if (AResumeEvent = nil) or (AAbortEvent = nil) then
Exit(raResume);
Context.NotifyPause;
try
if
(TEvent.WaitForMultiple([AResumeEvent, AAbortEvent], INFINITE, False, Obj) = wrSignaled)
and
(Obj = AResumeEvent)
then
Result := raResume
else
Result := raAbort;
finally
Context.NotifyResume;
end;
end;
function TASExprNode.EvalChild(AIndex: Integer): Boolean;
begin
Assert(InRange(AIndex, 0, ChildCount - 1), 'TASExprNode.EvalChild: AIndex out of range.');
Children[AIndex].Evaluate;
if IsControl(Children[AIndex].Value) then
begin
TMover<TAlgosimObject>.ReplaceMove(Value, Children[AIndex].Value);
Result := False;
end
else
Result := True;
end;
function TASExprNode.EvalChildCtrl(AIndex: Integer): Boolean;
begin
Assert(InRange(AIndex, 0, ChildCount - 1), 'TASExprNode.EvalChild: AIndex out of range.');
Children[AIndex].Evaluate;
if IsControl(Children[AIndex].Value) then
begin
TMover<TAlgosimObject>.ReplaceMove(Value, Children[AIndex].Value);
Result := Value is TAlgosimContinue;
if
((Value is TAlgosimBreak) and TAlgosimBreak(Value).Consume)
or
(Value is TAlgosimContinue)
then
TObjReplacer<TAlgosimObject>.Replace(Value, ASO(null));
end
else
Result := True;
end;
function TASExprNode.EvalChildren(AFrom: Integer): Boolean;
var
i: Integer;
begin
for i := AFrom to ChildCount - 1 do
if not EvalChild(i) then
Exit(False);
Result := True;
end;
function TASExprNode.ExpressionRootedHere: TASExpression;
begin
Result := TASExpression.Create(ExprNodeClassType);
try
Result.Context := Expression.Context;
Result.Root.Assign(Self);
except
Result.Free;
raise;
end;
end;
function TASExprNode.ExprNodeClassType: TASExprNodeClass;
begin
Result := TASExprNodeClass(ClassType);
end;
function TASExprNode.GetContext: TExecutionContextRef;
begin
Result := Expression.Context;
Result.Validate;
end;
function TASExprNode.GetExprChild(AIndex: Integer): TASExprNode;
begin
Result := TASExprNode(inherited Children[AIndex]);
end;
function TASExprNode.GetExpression: TASExpression;
begin
Result := TASExpression(Tree);
end;
function TASExprNode.GetExprParent: TASExprNode;
begin
Result := TASExprNode(inherited Parent);
end;
function TASExprNode.LValuePart: Boolean;
begin
Result := False;
end;
procedure TASExprNode.ManualAbort;
begin
raise EManualAbort.Create('Evaluation aborted on request.');
end;
class function TASExprNode.NodeName: string;
begin
Result := ClassName;
end;
procedure TASExprNode.QuitPauseCheck;
begin
if TThread.Current.ThreadID <> MainThreadID then
begin
if
Expression.Context.AbortCurrent
or
(
Expression.Context.EnterPause
and
(
DoPause(Expression.Context.ResumeEvent, Expression.Context.AbortCurrentEvent) = raAbort
)
)
then
ManualAbort;
end;
end;
procedure TASExprNode.Reset;
var
i: Integer;
begin
for i := 0 to ChildCount - 1 do
TASExprNode(Children[i]).Reset;
FreeAndNil(Value);
end;
function TASExprNode.SubtreeAsString(ALevel: Integer): string;
var
i: Integer;
begin
Result := ToString;
for i := 0 to ChildCount - 1 do
Result := Result +
sLineBreak +
StringOfChar(#32, 4*(ALevel + 1)) +
Children[i].SubtreeAsString(ALevel + 1);
end;
function TASExprNode.SubtreeAsString(const AArgs: TTable<TASExprNode>; ALevel: Integer): string;
var
i, j: Integer;
begin
Result := ToString;
if Self is TASSymbolExprNode then
for i := 0 to High(AArgs) do
for j := 0 to High(AArgs[i]) do
if Self = AArgs[i, j] then
begin
Result := '(' + Succ(i).ToString + ')';
Break;
end;
for i := 0 to ChildCount - 1 do
Result := Result +
sLineBreak +
StringOfChar(#32, 4*(ALevel + 1)) +
Children[i].SubtreeAsString(AArgs, ALevel + 1);
end;
function TASExprNode.ToString: string;
begin
Result := ClassName;
end;
procedure TASExprNode.ValidateParent(ATree: TTree; AParent: TTreeNode);
begin
if not (ATree is TASExpression) or (Assigned(AParent) and not (AParent is TASExprNode)) then
raise EExpressionException.Create(SExprNodeTree);
end;
procedure TASLiteralExprNode.Assign(const ASource: TASExprNode;
ANodeMapping: TASExpression.TNodeMapping = nil);
begin
inherited;
FreeAndNil(Literal);
Literal := (ASource as TASLiteralExprNode).Literal.Clone;
end;
procedure TASLiteralExprNode.Clear;
begin
inherited;
FreeAndNil(Literal);
end;
destructor TASLiteralExprNode.Destroy;
begin
FreeAndNil(Literal);
inherited;
end;
procedure TASLiteralExprNode.Evaluate;
begin
FreeAndNil(Value);
Value := Literal.Clone;
end;
class function TASLiteralExprNode.NodeName: string;
begin
Result := 'literal node';
end;
function TASLiteralExprNode.ToString: string;
function Briefly(const S: string): string;
begin
if S.Length > 64 then
Result := Copy(S, 1, 64) + '...'
else
Result := S;
Result := StringReplace(S, #13#10, #32, [rfReplaceAll]);
Result := StringReplace(S, #10, #32, [rfReplaceAll]);
end;
begin
Result := Briefly(Literal.ToInputString);
end;
procedure TASSymbolExprNode.Assign(const ASource: TASExprNode;
ANodeMapping: TASExpression.TNodeMapping = nil);
begin
inherited;
Symbol := (ASource as TASSymbolExprNode).Symbol;
FreeAndNil(Preloaded);
if Assigned(TASSymbolExprNode(ASource).Preloaded) then
Preloaded := TASSymbolExprNode(ASource).Preloaded.Clone;
end;
function TASSymbolExprNode.BuildLValue(LValueData: TLValueData): Boolean;
begin
Result := Preloaded = nil;
if Result then
LValueData.Add(TLValuePathItem.Create(Symbol));
end;
procedure TASSymbolExprNode.Clear;
begin
inherited;
Symbol := '';
end;
destructor TASSymbolExprNode.Destroy;
begin
FreeAndNil(Preloaded);
inherited;
end;
procedure TASSymbolExprNode.Evaluate;
var
Variable: TAlgosimVariable;
FcnClass: TASFunctionClass;
begin
FreeAndNil(Value);
try
if Assigned(Preloaded) then
Value := Preloaded.Clone
else if Context.TryGetVariable(Symbol, Variable) then
Value := Variable.Value
else if TFunctionMgr.Functions.TryGetValue(Symbol, FcnClass) then
Value := TKernelFunctionObj.Create(FcnClass)
else
raise EUnknownIdentifier.CreateFmt(SUnknownIdentifier, [Symbol]);
except
on E: Exception do
begin
FreeAndNil(Value);
Value := ASO(failure, E.Message);
if Value is TAlgosimFAilure then
TAlgosimFAilure(Value).Source.Add(ClassType);
end;
end;
end;
function TASSymbolExprNode.LValuePart: Boolean;
begin
Result := Preloaded = nil;
end;
class function TASSymbolExprNode.NodeName: string;
begin
Result := 'symbol node';
end;
function TASSymbolExprNode.ToString: string;
begin
Result := Symbol;
end;
constructor TASExpression.Create(ARootNodeClass: TASExprNodeClass);
begin
inherited Create(ARootNodeClass);
end;
function TASExpression.GetExprRoot: TASExprNode;
begin
Result := TASExprNode(inherited Root);
end;
constructor TASExpression.Create(ALiteralValue: TAlgosimObject);
begin
try
Create(TASLiteralExprNode);
except
ALiteralValue.Free;
raise;
end;
TASLiteralExprNode(Root).Literal := ALiteralValue;
end;
function TASExpression.Clone(ANodeMapping: TNodeMapping): TASExpression;
begin
if Root = nil then
raise EExpressionException.Create(SCannotCloneRootlessExpression);
Result := TASExpression.Create(Root.ExprNodeClassType);
try
Result.Context := Context;
Result.Root.Assign(Root, ANodeMapping);
except
Result.Free;
raise;
end;
end;
constructor TASExpression.Create(const AText: string);
begin
Create(TASSymbolExprNode);
TASSymbolExprNode(Root).Symbol := AText;
end;
procedure TASExpression.DoCreateRoot(ARootNodeClass: TTreeNodeClass);
begin
if not ARootNodeClass.InheritsFrom(TASExprNode) then
raise EExpressionException.Create(SExpressionTreeNodes);
inherited DoCreateRoot(ARootNodeClass);
end;
procedure TASExpression.Evaluate;
begin
Root.Evaluate;
end;
procedure TASExpression.Reset;
begin
Root.Reset;
end;
function TASExpression.ToString: string;
begin
if Assigned(Root) then
Result := Root.SubtreeAsString
else
Result := '(null graph)';
end;
procedure TASArgExprNode.Assign(const ASource: TASExprNode;
ANodeMapping: TASExpression.TNodeMapping = nil);
begin
inherited;
FreeAndNil(Value);
Value := ASource.Value.Clone;
end;
procedure TASArgExprNode.Evaluate;
begin
end;
class function TASArgExprNode.NodeName: string;
begin
Result := 'argument node';
end;
function TArgumentExtractor.Extract(
out Number: TAlgosimNumber): TArgumentExtractor;
begin
Result := Extract<TAlgosimNumber>(Number);
end;
function TArgumentExtractor.Extract(
out Integer: TAlgosimInteger): TArgumentExtractor;
begin
Result := Extract<TAlgosimInteger>(Integer);
end;
function TArgumentExtractor.Extract(
out RealNumber: TAlgosimRealNumber): TArgumentExtractor;
begin
Result := Extract<TAlgosimRealNumber>(RealNumber);
end;
function TArgumentExtractor.Extract(
out ComplexNumber: TAlgosimComplexNumber): TArgumentExtractor;
begin
Result := Extract<TAlgosimComplexNumber>(ComplexNumber);
end;
function TArgumentExtractor.Extract(
out Vector: TAlgosimVector): TArgumentExtractor;
begin
Result := Extract<TAlgosimVector>(Vector);
end;
function TArgumentExtractor.Extract(
out RealVector: TAlgosimRealVector): TArgumentExtractor;
begin
Result := Extract<TAlgosimRealVector>(RealVector);
end;
function TArgumentExtractor.Extract(
out ComplexVector: TAlgosimComplexVector): TArgumentExtractor;
begin
Result := Extract<TAlgosimComplexVector>(ComplexVector);
end;
function TArgumentExtractor.Extract(
out Matrix: TAlgosimMatrix): TArgumentExtractor;
begin
Result := Extract<TAlgosimMatrix>(Matrix);
end;
function TArgumentExtractor.Extract(
out RealMatrix: TAlgosimRealMatrix): TArgumentExtractor;
begin
Result := Extract<TAlgosimRealMatrix>(RealMatrix);
end;
function TArgumentExtractor.Extract(
out ComplexMatrix: TAlgosimComplexMatrix): TArgumentExtractor;
begin
Result := Extract<TAlgosimComplexMatrix>(ComplexMatrix);
end;
function TArgumentExtractor.Extract<T>(out Obj: T): TArgumentExtractor;
begin
if not ArgExists then
TooFewArgs(T.ClassTypeName);
Fcn.CheckArg(Index, T);
Obj := T(Fcn.Children[Index].Value);
Result := NextArg;
end;
function TArgumentExtractor.TryExtract<T>(out Obj: T): Boolean;
begin
if not ArgExists then
TooFewArgs(T.ClassTypeName);
Result := Fcn.Children[Index].Value is T;
if Result then
Obj := T(Fcn.Children[Index].Value)
else
Obj := nil;
end;
function TArgumentExtractor.Extract(
out Obj: TAlgosimObject): TArgumentExtractor;
begin
Result := Extract<TAlgosimObject>(Obj);
end;
function TArgumentExtractor.NextArg: TArgumentExtractor;
begin
Result.Fcn := Self.Fcn;
Result.Index := Self.Index + 1;
end;
function TArgumentExtractor.PeekAt(const AIndex: Integer): TAlgosimObject;
begin
if InRange(AIndex, 0, Count - 1) then
Result := Fcn.Children[AIndex].Value
else
Result := nil;
end;
function TArgumentExtractor.Skip: TArgumentExtractor;
begin
Result := NextArg;
end;
procedure TArgumentExtractor.TooFewArgs(const AMissingType: string);
begin
raise EInvArgs.CreateFmt(STooFewArguments, [AMissingType]);
end;
function TArgumentExtractor.Extract(
out Str: TAlgosimString): TArgumentExtractor;
begin
Result := Extract<TAlgosimString>(Str);
end;
function TArgumentExtractor.Extract(
out Bool: TAlgosimBoolean): TArgumentExtractor;
begin
Result := Extract<TAlgosimBoolean>(Bool);
end;
function TArgumentExtractor.Extract(
out NumericEntity: TAlgosimNumericEntity): TArgumentExtractor;
begin
Result := Extract<TAlgosimNumericEntity>(NumericEntity);
end;
function TArgumentExtractor.Extract(
out List: TAlgosimArray): TArgumentExtractor;
begin
Result := Extract<TAlgosimArray>(List);
end;
function TArgumentExtractor.Extract(out List: TAlgosimArray;
UseRestriction: TRestrictionDummy; ElementClass: TAlgosimObjectClass): TArgumentExtractor;
var
i: Integer;
begin
Result := Extract(List);
for i := 1 to List.ElementCount do
if not (List[i] is ElementClass) then
raise EInvArgs.CreateFmt('The array must contain only objects of type %s, but it contains an object of type %s.',
[ElementClass.ClassTypeName, List[i].ClassTypeName]);
end;
function TArgumentExtractor.Extract(
out Struct: TAlgosimStructure): TArgumentExtractor;
begin
Result := Extract<TAlgosimStructure>(Struct);
end;
function TArgumentExtractor.Extract(
out TypedStruct: TAlgosimTypedStructure): TArgumentExtractor;
begin
Result := Extract<TAlgosimTypedStructure>(TypedStruct);
end;
function TArgumentExtractor.Extract(
out StructType: TAlgosimStructureType): TArgumentExtractor;
begin
Result := Extract<TAlgosimStructureType>(StructType);
end;
function TArgumentExtractor.Extract(out ASSet: TAlgosimSet): TArgumentExtractor;
begin
Result := Extract<TAlgosimSet>(ASSet);
end;
function TArgumentExtractor.Extract(
out Pixmap: TAlgosimPixmap): TArgumentExtractor;
begin
Result := Extract<TAlgosimPixmap>(Pixmap);
end;
function TArgumentExtractor.Extract(
out Table: TAlgosimTable): TArgumentExtractor;
begin
Result := Extract<TAlgosimTable>(Table);
end;
function TArgumentExtractor.Extract(
out Sound: TAlgosimSound): TArgumentExtractor;
begin
Result := Extract<TAlgosimSound>(Sound);
end;
function TArgumentExtractor.Extract(
out Color: TAlgosimColor): TArgumentExtractor;
begin
Result := Extract<TAlgosimColor>(Color);
end;
function TArgumentExtractor.Extract(
out BinData: TAlgosimBinaryData): TArgumentExtractor;
begin
Result := Extract<TAlgosimBinaryData>(BinData);
end;
function TArgumentExtractor.Extract(
out FcnObj: TAlgosimFunctionObject): TArgumentExtractor;
begin
Result := Extract<TAlgosimFunctionObject>(FcnObj);
end;
function TArgumentExtractor.Extract(
out FcnObj: TAlgosimFunctionObject;
const Def: TAlgosimFunctionObject): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(FcnObj)
else
begin
FcnObj := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.ArgExists: Boolean;
begin
Result := Index < Count;
end;
procedure TArgumentExtractor.Close;
begin
if ArgExists then
raise EInvArgs.Create(STooManyArguments);
end;
function TArgumentExtractor.Count: Integer;
begin
Result := Fcn.ChildCount;
end;
function TArgumentExtractor.Extract(out Integer: TASI): TArgumentExtractor;
var
ASR: TAlgosimRealNumber;
ASI: TAlgosimInteger;
ASC: TAlgosimComplexNumber;
R: TAlgosimRationalNumber;
begin
if TryExtract<TAlgosimInteger>(ASI) then
Integer := ASI.Value
else if TryExtract<TAlgosimRationalNumber>(R) and (R.Value.Denominator = 1) then
Integer := R.Value.Numerator
else if TryExtract<TAlgosimRealNumber>(ASR) and ASNum.IsInteger(ASR.Value, 1E-6) then
Integer := Round(ASR.Value)
else if TryExtract<TAlgosimComplexNumber>(ASC) and ASC.Value.IsReal and ASNum.IsInteger(ASC.Value.Re, 1E-6) then
Integer := Round(ASC.Value.Re)
else
Fcn.CheckArg(Index, TAlgosimInteger);
Result := NextArg;
end;
function TArgumentExtractor.Extract(out Integer: TASI;
const Def: TASI): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(Integer)
else
begin
Integer := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.ExtractNonNeg(out Integer: TASI): TArgumentExtractor;
begin
Result := Extract(Integer);
if Integer < 0 then
raise EInvArgs.CreateFmt(SArgNotNonNegInt, [Index + 1, Integer.ToString]);
end;
function TArgumentExtractor.ExtractNonNeg(out Integer: TASI;
const Def: TASI): TArgumentExtractor;
begin
if ArgExists then
Result := ExtractNonNeg(Integer)
else
begin
Integer := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.ExtractPos(out Integer: TASI): TArgumentExtractor;
begin
Result := Extract(Integer);
if Integer <= 0 then
raise EInvArgs.CreateFmt(SArgNotPosInt, [Index + 1, Integer.ToString]);
end;
function TArgumentExtractor.ExtractPos(out Integer: TASI;
const Def: TASI): TArgumentExtractor;
begin
if ArgExists then
Result := ExtractPos(Integer)
else
begin
Integer := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out Integer: Integer): TArgumentExtractor;
var
ASI: TASI;
begin
Result := Extract(ASI);
if InRange(ASI, Integer.MinValue, Integer.MaxValue) then
Integer := System.Integer(ASI)
else
raise EInvArgs.CreateFmt(SIntTypeToSmall, [8*ASI.Size, 8*Integer.Size]);
end;
function TArgumentExtractor.Extract(out Integer: Integer;
const Def: Integer): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(Integer)
else
begin
Integer := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.ExtractNonNeg(out Integer: Integer): TArgumentExtractor;
var
ASI: TASI;
begin
Result := ExtractNonNeg(ASI);
if InRange(ASI, Integer.MinValue, Integer.MaxValue) then
Integer := System.Integer(ASI)
else
raise EInvArgs.CreateFmt(SIntTypeToSmall, [8*ASI.Size, 8*Integer.Size]);
end;
function TArgumentExtractor.ExtractNonNeg(out Integer: Integer;
const Def: Integer): TArgumentExtractor;
begin
if ArgExists then
Result := ExtractNonNeg(Integer)
else
begin
Integer := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.ExtractPos(out Integer: Integer): TArgumentExtractor;
var
ASI: TASI;
begin
Result := ExtractPos(ASI);
if InRange(ASI, Integer.MinValue, Integer.MaxValue) then
Integer := System.Integer(ASI)
else
raise EInvArgs.CreateFmt(SIntTypeToSmall, [8*ASI.Size, 8*Integer.Size]);
end;
function TArgumentExtractor.ExtractPos(out Integer: Integer;
const Def: Integer): TArgumentExtractor;
begin
if ArgExists then
Result := ExtractPos(Integer)
else
begin
Integer := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out RealNumber: TASR): TArgumentExtractor;
var
ASR: TAlgosimRealNumber;
ASI: TAlgosimInteger;
ASC: TAlgosimComplexNumber;
R: TAlgosimRationalNumber;
begin
if TryExtract<TAlgosimRealNumber>(ASR) then
RealNumber := ASR.Value
else if TryExtract<TAlgosimInteger>(ASI) then
RealNumber := ASI.Value
else if TryExtract<TAlgosimRationalNumber>(R) then
RealNumber := R.Value
else if TryExtract<TAlgosimComplexNumber>(ASC) and ASC.Value.IsReal then
RealNumber := ASC.Value.Re
else
Fcn.CheckArg(Index, TAlgosimRealNumber);
Result := NextArg;
end;
function TArgumentExtractor.Extract(out RealNumber: TASR;
const [Ref] Def: TASR): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(RealNumber)
else
begin
RealNumber := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out ComplexNumber: TASC): TArgumentExtractor;
var
ASR: TAlgosimRealNumber;
ASI: TAlgosimInteger;
ASC: TAlgosimComplexNumber;
R: TAlgosimRationalNumber;
begin
if TryExtract<TAlgosimComplexNumber>(ASC) then
ComplexNumber := ASC.Value
else if TryExtract<TAlgosimRealNumber>(ASR) then
ComplexNumber := ASR.Value
else if TryExtract<TAlgosimInteger>(ASI) then
ComplexNumber := ASI.Value
else if TryExtract<TAlgosimRationalNumber>(R) then
ComplexNumber := TASC(TASR(R.Value))
else
Fcn.CheckArg(Index, TAlgosimComplexNumber);
Result := NextArg;
end;
function TArgumentExtractor.Extract(out ComplexNumber: TASC;
const Def: TASC): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(ComplexNumber)
else
begin
ComplexNumber := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out FieldNum: TFieldNumber): TArgumentExtractor;
function fn(const AValue: TASR): TFieldNumber; overload;
begin
Result.Complex := False;
Result.x := AValue;
end;
function fn(const AValue: TASC): TFieldNumber; overload;
begin
Result.Complex := True;
Result.z := AValue;
end;
var
ASR: TAlgosimRealNumber;
ASI: TAlgosimInteger;
ASC: TAlgosimComplexNumber;
R: TAlgosimRationalNumber;
begin
if TryExtract<TAlgosimComplexNumber>(ASC) then
FieldNum := fn(ASC.Value)
else if TryExtract<TAlgosimRealNumber>(ASR) then
FieldNum := fn(ASR.Value)
else if TryExtract<TAlgosimInteger>(ASI) then
FieldNum := fn(TASR(ASI.Value))
else if TryExtract<TAlgosimRationalNumber>(R) then
FieldNum := fn(TASR(R.Value))
else
Fcn.CheckArg(Index, TAlgosimComplexNumber);
Result := NextArg;
end;
function TArgumentExtractor.Extract(out FieldNum: TFieldNumber;
const Def: TASR): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(FieldNum)
else
begin
FieldNum.Complex := False;
FieldNum.x := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out FieldNum: TFieldNumber;
const Def: TASC): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(FieldNum)
else
begin
FieldNum.Complex := True;
FieldNum.z := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out RealVector: TRealVector): TArgumentExtractor;
var
Obj: TAlgosimVector;
begin
Result := Extract<TAlgosimVector>(Obj);
RealVector := Obj.AsRealVector;
end;
function TArgumentExtractor.Extract(out RealVector: TRealVector;
const Def: TRealVector): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(RealVector)
else
begin
RealVector := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out ComplexVector: TComplexVector): TArgumentExtractor;
var
Obj: TAlgosimVector;
begin
Result := Extract<TAlgosimVector>(Obj);
ComplexVector := Obj.AsComplexVector;
end;
function TArgumentExtractor.Extract(out ComplexVector: TComplexVector;
const Def: TComplexVector): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(ComplexVector)
else
begin
ComplexVector := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out RealMatrix: TRealMatrix): TArgumentExtractor;
var
Obj: TAlgosimMatrix;
begin
Result := Extract<TAlgosimMatrix>(Obj);
RealMatrix := Obj.AsRealMatrix;
end;
function TArgumentExtractor.Extract(out RealMatrix: TRealMatrix;
const Def: TRealMatrix): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(RealMatrix)
else
begin
RealMatrix := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out ComplexMatrix: TComplexMatrix): TArgumentExtractor;
var
Obj: TAlgosimMatrix;
begin
Result := Extract<TAlgosimMatrix>(Obj);
ComplexMatrix := Obj.AsComplexMatrix;
end;
function TArgumentExtractor.Extract(out ComplexMatrix: TComplexMatrix;
const Def: TComplexMatrix): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(ComplexMatrix)
else
begin
ComplexMatrix := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out Str: string): TArgumentExtractor;
var
Obj: TAlgosimString;
begin
Result := Extract<TAlgosimString>(Obj);
Str := Obj.Value;
end;
function TArgumentExtractor.Extract(out Str: string;
const AAllowedStrs: array of string): TArgumentExtractor;
var
AllowedStr: string;
begin
Result := Extract(Str);
for AllowedStr in AAllowedStrs do
if Str = AllowedStr then
Exit;
raise EInvArgs.CreateFmt('String "%s" not allowed as argument. Expected one of "%s".',
[Str, string.Join('", "', AAllowedStrs)]);
end;
function TArgumentExtractor.Extract(out Str: string;
const Def: string): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(Str)
else
begin
Str := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out Str: string;
const AAllowedStrs: array of string; const Def: string): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(Str, AAllowedStrs)
else
begin
Str := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out Bool: Boolean): TArgumentExtractor;
var
Obj: TAlgosimBoolean;
begin
Result := Extract<TAlgosimBoolean>(Obj);
Bool := Obj.Value;
end;
function TArgumentExtractor.Extract(out Bool: Boolean;
const Def: Boolean): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(Bool)
else
begin
Bool := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out Pixmap: TASPixmap): TArgumentExtractor;
var
Obj: TAlgosimPixmap;
begin
Result := Extract<TAlgosimPixmap>(Obj);
Pixmap := Obj.Value;
end;
function TArgumentExtractor.Extract(out Pixmap: TASPixmap;
const Def: TASPixmap): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(Pixmap)
else
begin
Pixmap := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out Table: TASTable): TArgumentExtractor;
var
Obj: TAlgosimTable;
begin
Result := Extract<TAlgosimTable>(Obj);
Table := Obj.Value;
end;
function TArgumentExtractor.Extract(out Table: TASTable;
const Def: TASTable): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(Table)
else
begin
Table := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out Sound: TASSound): TArgumentExtractor;
var
Obj: TAlgosimSound;
begin
Result := Extract<TAlgosimSound>(Obj);
Sound := Obj.Value;
end;
function TArgumentExtractor.Extract(out Sound: TASSound;
const Def: TASSound): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(Sound)
else
begin
Sound := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out Color: TRGB): TArgumentExtractor;
var
Clr: TAlgosimColor;
Int: TAlgosimInteger;
Str: TAlgosimString;
begin
if TryExtract<TAlgosimColor>(Clr) then
Color := Clr.Value
else if TryExtract<TAlgosimInteger>(Int) then
Color := TRGB(TColor(Int.Value))
else if TryExtract<TAlgosimString>(Str) then
Color := ASColors.StrToColor(Str.Value)
else
Fcn.CheckArg(Index, TAlgosimColor);
Result := NextArg;
end;
function TArgumentExtractor.Extract(out Color: TRGB;
const Def: TRGB): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(Color)
else
begin
Color := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out Date: TDate): TArgumentExtractor;
var
DateObj: TAlgosimObject;
RealVal: TASR;
begin
Extract<TAlgosimObject>(DateObj);
if (DateObj is TAlgosimNumber) and DateObj.TryToASR(RealVal) then
Date := TDate(RealVal)
else if stDate.MatchingName(DateObj) then
Date := ASOToDateTime(DateObj)
else if stDateTime.MatchingName(DateObj) then
Date := DateOf(ASOToDateTime(DateObj))
else
Fcn.CheckArg(Index, stDate);
Result := NextArg;
end;
function TArgumentExtractor.Extract(out Date: TDate;
const Def: TDate): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(Date)
else
begin
Date := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out Time: TTime): TArgumentExtractor;
var
TimeObj: TAlgosimObject;
RealVal: TASR;
begin
Extract<TAlgosimObject>(TimeObj);
if (TimeObj is TAlgosimNumber) and TimeObj.TryToASR(RealVal) then
Time := TTime(RealVal)
else if stTime.MatchingName(TimeObj) then
Time := ASOToDateTime(TimeObj)
else if stDateTime.MatchingName(TimeObj) then
Time := TimeOf(ASOToDateTime(TimeObj))
else
Fcn.CheckArg(Index, stTime);
Result := NextArg;
end;
function TArgumentExtractor.Extract(out Time: TTime;
const Def: TTime): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(Time)
else
begin
Time := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out DateTime: TDateTime): TArgumentExtractor;
var
DateTimeObj: TAlgosimObject;
RealVal: TASR;
begin
Extract<TAlgosimObject>(DateTimeObj);
if (DateTimeObj is TAlgosimNumber) and DateTimeObj.TryToASR(RealVal) then
DateTime := TDateTime(RealVal)
else if stDateTime.MatchingName(DateTimeObj) then
DateTime := ASOToDateTime(DateTimeObj)
else if stDate.MatchingName(DateTimeObj) then
DateTime := ASOToDateTime(DateTimeObj)
else
Fcn.CheckArg(Index, stDateTime);
Result := NextArg;
end;
function TArgumentExtractor.Extract(out DateTime: TDateTime;
const Def: TDateTime): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(DateTime)
else
begin
DateTime := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.MoveObject<T>(out Dest: TAlgosimObject): TArgumentExtractor;
begin
if not ArgExists then
TooFewArgs(T.ClassTypeName);
Fcn.CheckArg(Index, T);
TMover<TAlgosimObject>.Move(Dest, Fcn.Children[Index].Value);
Result := NextArg;
end;
function TArgumentExtractor.MoveObject(
out Dest: TAlgosimObject): TArgumentExtractor;
begin
if not ArgExists then
TooFewArgs(TAlgosimObject.ClassTypeName);
TMover<TAlgosimObject>.Move(Dest, Fcn.Children[Index].Value);
Result := NextArg;
end;
function TArgumentExtractor.MoveObject(out Dest: TAlgosimTypedStructure;
AStructType: TStructType): TArgumentExtractor;
begin
if not ArgExists then
TooFewArgs(TAlgosimTypedStructure.ClassTypeName);
Fcn.CheckArg(Index, AStructType);
TMover<TAlgosimTypedStructure>.Move(Dest, TAlgosimTypedStructure(Fcn.Children[Index].Value));
Result := NextArg;
end;
function TArgumentExtractor.MoveObject<T>(out Dest: TAlgosimObject; out Ref: T): TArgumentExtractor;
begin
if not ArgExists then
TooFewArgs(T.ClassTypeName);
Fcn.CheckArg(Index, T);
TMover<TAlgosimObject>.Move(Dest, Fcn.Children[Index].Value);
Ref := T(Dest);
Result := NextArg;
end;
function TArgumentExtractor.Extract(out Chr: Char): TArgumentExtractor;
var
Value: string;
begin
Result := Extract(Value);
if Value.Length <> 1 then
raise EInvArgs.CreateFmt(SArgNotChr, [Index + 1, Value]);
Chr := Value[1];
end;
function TArgumentExtractor.Extract(out Chr: Char;
const AAllowedChars: array of Char): TArgumentExtractor;
var
AllowedChar: char;
begin
Result := Extract(Chr);
for AllowedChar in AAllowedChars do
if Chr = AllowedChar then
Exit;
raise EInvArgs.CreateFmt('Character "%s" not allowed as argument. Expected one of "%s".',
[string(Chr), string.Create(AAllowedChars)]);
end;
function TArgumentExtractor.Extract(out Chr: Char;
const Def: Char): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(Chr)
else
begin
Chr := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out Chr: Char;
const AAllowedChars: array of Char; const Def: Char): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(Chr, AAllowedChars)
else
begin
Chr := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out ChrSet: TSysCharSet): TArgumentExtractor;
var
Value: string;
c: char;
begin
Result := Extract(Value);
ChrSet := [];
for c in Value do
if InRange(Ord(c), 0, 127) then
Include(ChrSet, AnsiChar(c))
else
raise EInvArgs.Create('Invalid character in string of supposedly ASCII characters.');
end;
function TArgumentExtractor.Extract(out ChrSet: TSysCharSet;
UseRestriction: TRestrictionDummy; const AAllowedChars: TSysCharSet): TArgumentExtractor;
var
c: AnsiChar;
begin
Result := Extract(ChrSet);
for c in ChrSet do
if not (c in AAllowedChars) then
raise EInvArgs.CreateFmt('Unsupported character "%s".', [string(c)]);
end;
function TArgumentExtractor.Extract(out ChrSet: TSysCharSet;
UseDefVal: TDefValueDummy; const Def: TSysCharSet): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(ChrSet)
else
begin
ChrSet := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out ChrSet: TSysCharSet;
UseRestriction: TRestrictionDummy; const AAllowedChars: TSysCharSet;
UseDefVal: TDefValueDummy; const Def: TSysCharSet): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(ChrSet, restr, AAllowedChars)
else
begin
ChrSet := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out AStruct: TAlgosimTypedStructure;
AStructType: TStructType): TArgumentExtractor;
begin
Result := Extract(AStruct);
if not AStructType.MatchingName(AStruct) then
raise EInvArgs.CreateFmt(SArgNotMatchingStruct, [Index + 1, AStructType.Name]);
end;
function TArgumentExtractor.Extract(out AStruct: TAlgosimTypedStructure;
AStructType: TAlgosimStructureType): TArgumentExtractor;
begin
Result := Extract(AStruct);
if AStructType.Name <> AStruct.StructureTypeName then
raise EInvArgs.CreateFmt(SArgNotMatchingStruct, [Index + 1, AStructType.Name]);
end;
function TArgumentExtractor.Extract(out Points: TArray<TPoint>): TArgumentExtractor;
var
Obj: TAlgosimObject;
vect: TRealVector;
i: Integer;
begin
Result := Extract(Obj);
if Obj.IsObjectContainer then
begin
SetLength(Points, Obj.ElementCount);
for i := 1 to Obj.ElementCount do
begin
vect := Obj.Elements[i].AsRealVector;
if (vect.Dimension = 2) and ASNum.IsInteger(vect[0]) and ASNum.IsInteger(vect[1]) then
Points[i - 1] := Point(Round(vect[0]), Round(vect[1]))
else
raise EInvArgs.CreateFmt(SNoIntPointList, [Index + 1]);
end
end
else
raise EInvArgs.CreateFmt(SNoIntPointList, [Index + 1]);
end;
function TArgumentExtractor.ExtractInt64s: TArray<Int64>;
var
tmp: TArgumentExtractor;
arr: TAlgosimArray;
val: Int64;
i: Integer;
begin
if PeekAt(Index) is TAlgosimArray then
begin
Extract(arr, restr, TAlgosimInteger).Close;
SetLength(Result, arr.ElementCount);
for i := 0 to High(Result) do
Result[i] := arr.Elements[i + 1].ToInt64;
end
else
begin
SetLength(Result, Count - Index);
tmp := Self;
while tmp.ArgExists do
begin
tmp := tmp.Extract(val);
Result[tmp.Index - Self.Index - 1] := val;
end;
end;
end;
function TArgumentExtractor.ExtractArray: TArray<TAlgosimObject>;
var
tmp: TArgumentExtractor;
arr: TAlgosimArray;
obj: TAlgosimObject;
begin
if PeekAt(Index) is TAlgosimArray then
begin
Extract(arr).Close;
Result := arr.AsArray;
end
else
begin
SetLength(Result, Count - Index);
tmp := Self;
while tmp.ArgExists do
begin
tmp := tmp.Extract(obj);
Result[tmp.Index - Self.Index - 1] := obj;
end;
end;
end;
function TArgumentExtractor.ExtractRealNumbers: TArray<TASR>;
var
tmp: TArgumentExtractor;
arr: TAlgosimArray;
val: TASR;
i: Integer;
begin
if PeekAt(Index) is TAlgosimArray then
begin
Extract(arr, restr, TAlgosimNumber).Close;
SetLength(Result, arr.ElementCount);
for i := 0 to High(Result) do
Result[i] := arr.Elements[i + 1].ToASR;
end
else
begin
SetLength(Result, Count - Index);
tmp := Self;
while tmp.ArgExists do
begin
tmp := tmp.Extract(val);
Result[tmp.Index - Self.Index - 1] := val;
end;
end;
end;
function TArgumentExtractor.ExtractComplexNumbers: TArray<TASC>;
var
tmp: TArgumentExtractor;
arr: TAlgosimArray;
val: TASC;
i: Integer;
begin
if PeekAt(Index) is TAlgosimArray then
begin
Extract(arr, restr, TAlgosimNumber).Close;
SetLength(Result, arr.ElementCount);
for i := 0 to High(Result) do
Result[i] := arr.Elements[i + 1].ToASC;
end
else
begin
SetLength(Result, Count - Index);
tmp := Self;
while tmp.ArgExists do
begin
tmp := tmp.Extract(val);
Result[tmp.Index - Self.Index - 1] := val;
end;
end;
end;
function TArgumentExtractor.ExtractRealVectors: TArray<TRealVector>;
var
tmp: TArgumentExtractor;
arr: TAlgosimArray;
val: TAlgosimVector;
i: Integer;
begin
if PeekAt(Index) is TAlgosimArray then
begin
Extract(arr, restr, TAlgosimVector).Close;
SetLength(Result, arr.ElementCount);
for i := 0 to High(Result) do
Result[i] := arr.Elements[i + 1].AsRealVector;
end
else
begin
SetLength(Result, Count - Index);
tmp := Self;
while tmp.ArgExists do
begin
tmp := tmp.Extract(val);
Result[tmp.Index - Self.Index - 1] := val.AsRealVector;
end;
end;
end;
function TArgumentExtractor.ExtractStrings: TArray<string>;
var
tmp: TArgumentExtractor;
arr: TAlgosimArray;
val: string;
i: Integer;
begin
if PeekAt(Index) is TAlgosimArray then
begin
Extract(arr, restr, TAlgosimString).Close;
SetLength(Result, arr.ElementCount);
for i := 0 to High(Result) do
Result[i] := arr.Elements[i + 1].ToString;
end
else
begin
SetLength(Result, Count - Index);
tmp := Self;
while tmp.ArgExists do
begin
tmp := tmp.Extract(val);
Result[tmp.Index - Self.Index - 1] := val;
end;
end;
end;
function TArgumentExtractor.ExtractStruct: TAlgosimStructure;
var
tmp: TArgumentExtractor;
sm: TAlgosimTypedStructure;
MemberName: string;
MemberValue: TAlgosimObject;
begin
if (PeekAt(Index) is TAlgosimStructure) and not IsTypedStructure(PeekAt(Index), stStructMember) then
MoveObject<TAlgosimStructure>(TAlgosimObject(Result)).Close
else
begin
Result := TAlgosimStructure.Create;
try
tmp := Self;
while tmp.ArgExists do
begin
tmp := tmp.Extract(sm, stStructMember);
MemberName := sm['name'].ToString.Replace(HYPHEN_MINUS, '').Replace(SPACE, '');
MemberValue := sm['value'];
sm.Release('value');
Result.Add(MemberName, MemberValue);
end;
except
Result.Free;
raise;
end;
end;
end;
function TArgumentExtractor.ExtractSymbol(out ASymbol: string): TArgumentExtractor;
begin
if not ArgExists then
TooFewArgs(TASSymbolExprNode.NodeName);
if not (Fcn.Children[Index] is TASSymbolExprNode) then
raise EInvArgs.CreateFmt(SASymbolWasExpected, [Index + 1]);
ASymbol := TASSymbolExprNode(Fcn.Children[Index]).Symbol;
Result := NextArg;
end;
function TArgumentExtractor.ExtractComplexVectors: TArray<TComplexVector>;
var
tmp: TArgumentExtractor;
arr: TAlgosimArray;
val: TAlgosimVector;
i: Integer;
begin
if PeekAt(Index) is TAlgosimArray then
begin
Extract(arr, restr, TAlgosimVector).Close;
SetLength(Result, arr.ElementCount);
for i := 0 to High(Result) do
Result[i] := arr.Elements[i + 1].AsComplexVector;
end
else
begin
SetLength(Result, Count - Index);
tmp := Self;
while tmp.ArgExists do
begin
tmp := tmp.Extract(val);
Result[tmp.Index - Self.Index - 1] := val.AsComplexVector;
end;
end;
end;
function TArgumentExtractor.ExtractRealMatrices: TArray<TRealMatrix>;
var
tmp: TArgumentExtractor;
arr: TAlgosimArray;
val: TAlgosimMatrix;
i: Integer;
begin
if PeekAt(Index) is TAlgosimArray then
begin
Extract(arr, restr, TAlgosimMatrix).Close;
SetLength(Result, arr.ElementCount);
for i := 0 to High(Result) do
Result[i] := arr.Elements[i + 1].AsRealMatrix;
end
else
begin
SetLength(Result, Count - Index);
tmp := Self;
while tmp.ArgExists do
begin
tmp := tmp.Extract(val);
Result[tmp.Index - Self.Index - 1] := val.AsRealMatrix;
end;
end;
end;
function TArgumentExtractor.ExtractComplexMatrices: TArray<TComplexMatrix>;
var
tmp: TArgumentExtractor;
arr: TAlgosimArray;
val: TAlgosimMatrix;
i: Integer;
begin
if PeekAt(Index) is TAlgosimArray then
begin
Extract(arr, restr, TAlgosimMatrix).Close;
SetLength(Result, arr.ElementCount);
for i := 0 to High(Result) do
Result[i] := arr.Elements[i + 1].AsComplexMatrix;
end
else
begin
SetLength(Result, Count - Index);
tmp := Self;
while tmp.ArgExists do
begin
tmp := tmp.Extract(val);
Result[tmp.Index - Self.Index - 1] := val.AsComplexMatrix;
end;
end;
end;
function TArgumentExtractor.Extract(
out IntRangeArr: TArray<TRange>): TArgumentExtractor;
var
Obj: TAlgosimObject;
i: Integer;
begin
Result := Extract(Obj);
if Obj is TAlgosimNumber then
IntRangeArr := [TRange.Create(Obj.ToInt32)]
else if stIntRange.MatchingName(Obj) then
IntRangeArr := [ASOToIntRange(Obj)]
else if Obj is TAlgosimArray then
begin
SetLength(IntRangeArr, Obj.ElementCount);
for i := 1 to Obj.ElementCount do
if Obj.Elements[i] is TAlgosimNumber then
IntRangeArr[i - 1] := TRange.Create(Obj.Elements[i].ToInt32)
else
IntRangeArr[i - 1] := ASOToIntRange(Obj.Elements[i]);
end
else
ErrInvalidArguments;
end;
function TArgumentExtractor.Extract(
out Strings: TArray<string>): TArgumentExtractor;
var
Arr: TAlgosimArray;
i: Integer;
begin
Result := Extract(Arr, restr, TAlgosimString);
SetLength(Strings, Arr.ElementCount);
for i := 1 to Arr.ElementCount do
Strings[i - 1] := (Arr[i] as TAlgosimString).Value;
end;
function TArgumentExtractor.Extract(
out Sounds: TArray<TASSound>): TArgumentExtractor;
var
Arr: TAlgosimArray;
i: Integer;
begin
Result := Extract(Arr, restr, TAlgosimSound);
SetLength(Sounds, Arr.ElementCount);
for i := 1 to Arr.ElementCount do
Sounds[i - 1] := (Arr[i] as TAlgosimSound).Value;
end;
function TArgumentExtractor.Extract(out GUID: TGUID): TArgumentExtractor;
var
Obj: TAlgosimReference;
begin
Result := Extract<TAlgosimReference>(Obj);
GUID := Obj.GUID;
end;
function TArgumentExtractor.Extract(out Obj: TAlgosimObject;
Def: TAlgosimObject): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(Obj)
else
begin
Obj := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out List: TAlgosimArray;
UseRestriction: TRestrictionDummy; ElementClass: TAlgosimObjectClass;
UseDefVal: TDefValueDummy; Def: TAlgosimArray): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(List, restr, ElementClass)
else
begin
List := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.Extract(out List: TAlgosimArray;
UseDefVal: TDefValueDummy; Def: TAlgosimArray): TArgumentExtractor;
begin
if ArgExists then
Result := Extract(List)
else
begin
List := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.ExtractNonNeg(
out RealNumber: TASR): TArgumentExtractor;
begin
Result := Extract(RealNumber);
if RealNumber < 0 then
raise EInvArgs.CreateFmt(SArgNotNonNegReal, [Index + 1, RealNumber.ToString(DefaultFormatSettings)]);
end;
function TArgumentExtractor.ExtractNonNeg(out RealNumber: TASR;
const Def: TASR): TArgumentExtractor;
begin
if ArgExists then
Result := ExtractNonNeg(RealNumber)
else
begin
RealNumber := Def;
Result := NextArg;
end;
end;
function TArgumentExtractor.ExtractPos(
out RealNumber: TASR): TArgumentExtractor;
begin
Result := Extract(RealNumber);
if RealNumber <= 0 then
raise EInvArgs.CreateFmt(SArgNotPosReal, [Index + 1, RealNumber.ToString(DefaultFormatSettings)]);
end;
procedure TArgumentExtractor.ExtractPointListRn(out List: TArray<Double>;
var Dimension: Integer);
procedure Inv;
begin
raise EInvArgs.Create(SInvPointList);
end;
begin
var FirstArg := PeekAt(Index);
var LActualDimension: Integer;
if FirstArg is TAlgosimArray then
begin
if FirstArg.ElementCount = 0 then
Inv;
LActualDimension := FirstArg.Elements[1].ValueCount;
end
else if FirstArg is TAlgosimMatrix then
LActualDimension := FirstArg.AsRealMatrix.Size.Cols
else if Assigned(FirstArg) then
LActualDimension := FirstArg.ValueCount
else
LActualDimension := 2;
if (Dimension <> 0) and (LActualDimension <> Dimension) then
Inv;
Dimension := LActualDimension;
var Idx := 0;
if FirstArg is TAlgosimArray then
begin
var arr: TAlgosimArray;
Extract(arr).Close;
SetLength(List, arr.ElementCount * Dimension);
for var i := 1 to arr.ElementCount do
if arr.Elements[i].ValueCount = Dimension then
begin
var v := arr.Elements[i].AsRealVector;
if v.Dimension = Dimension then
begin
for var j := 0 to v.Dimension - 1 do
begin
List[Idx] := v[j];
Inc(Idx);
end;
end
else
Inv;
end
else
Inv;
end
else if FirstArg is TAlgosimMatrix then
begin
var mat: TRealMatrix;
Extract(mat).Close;
if mat.Size.Cols <> Dimension then
Inv;
SetLength(List, mat.Size.ElementCount);
for var i := 0 to mat.Size.Rows - 1 do
for var j := 0 to mat.Size.Cols - 1 do
begin
List[Idx] := mat[i, j];
Inc(Idx);
end;
end
else
begin
SetLength(List, (Count - Index) * Dimension);
var tmp := Self;
while tmp.ArgExists do
begin
var obj: TAlgosimObject;
tmp := tmp.Extract(obj);
if obj.ValueCount = Dimension then
begin
var v := obj.AsRealVector;
if v.Dimension = Dimension then
begin
for var j := 0 to v.Dimension - 1 do
begin
List[Idx] := v[j];
Inc(Idx);
end;
end
else
Inv;
end
else
Inv;
end;
end;
end;
function TArgumentExtractor.ExtractPointsR2: TArray<TASR2>;
begin
var LList: TArray<Double>;
var LDim := 2;
ExtractPointListRn(LList, LDim);
Result := DoubleListToASR2s(LList);
end;
procedure TArgumentExtractor.ExtractPointsR2orR3(out L2: TArray<TASR2>;
out L3: TArray<TASR3>);
begin
L2 := nil;
L3 := nil;
var LList: TArray<Double>;
var LDim := 0;
ExtractPointListRn(LList, LDim);
case LDim of
2:
L2 := DoubleListToASR2s(LList);
3:
L3 := DoubleListToASR3s(LList);
end;
end;
function TArgumentExtractor.ExtractPointsR3: TArray<TASR3>;
begin
var LList: TArray<Double>;
var LDim := 3;
ExtractPointListRn(LList, LDim);
Result := DoubleListToASR3s(LList);
end;
function TArgumentExtractor.ExtractPos(out RealNumber: TASR;
const Def: TASR): TArgumentExtractor;
begin
if ArgExists then
Result := ExtractPos(RealNumber)
else
begin
RealNumber := Def;
Result := NextArg;
end;
end;
class function TASListExprNode.NodeName: string;
begin
Result := 'list node';
end;
procedure TASListExprNode.SimpleFunction;
begin
if Args.Count > 0 then
TMover<TAlgosimObject>.Move(Value, Children[Args.Count - 1].Value)
else
Result := ASO(null);
end;
function TAlgosimFunctionObject.GetAsSingleLineText(
const AOptions: TFormatOptions): string;
begin
Result := ToString;
end;
constructor TKernelFunctionObj.Create(AObject: TAlgosimObject);
begin
if AObject is TKernelFunctionObj then
begin
inherited Create;
FFuncClass := TKernelFunctionObj(AObject).FFuncClass;
end
else
NoCopyConstr(AObject);
end;
constructor TKernelFunctionObj.Create(AFuncClass: TASFunctionClass);
begin
inherited Create;
FFuncClass := AFuncClass;
end;
function TKernelFunctionObj.Equals(Obj: TObject): Boolean;
begin
Result := (Obj is TKernelFunctionObj) and (TKernelFunctionObj(Obj).FuncClass = FuncClass);
end;
function TKernelFunctionObj.Execute(AContext: TExecutionContextRef;
const AArgs: array of TAlgosimObject; AOwnsArgs: Boolean): TAlgosimObject;
var
Expr: TASExpression;
i: Integer;
begin
Expr := TASExpression.Create(FFuncClass);
try
Expr.Context := AContext;
Expr.Root.Capacity := Length(AArgs);
for i := 0 to High(AArgs) do
begin
Expr.Root.AddChild(TASArgExprNode);
if AOwnsArgs then
Expr.Root.Children[i].Value := AArgs[i]
else
Expr.Root.Children[i].Value := AArgs[i].Clone
end;
Expr.Evaluate;
CheckFailure(Expr.Root.Value);
TMover<TAlgosimObject>.Move(Result, Expr.Root.Value);
finally
Expr.Free;
end;
end;
function TKernelFunctionObj.ToString: string;
begin
Result := FFuncClass.NodeName;
end;
function TKernelFunctionObj.Execute(AContext: TExecutionContextRef;
AArgs: TASExprNode): TAlgosimObject;
var
Expr: TASExpression;
i: Integer;
begin
Expr := TASExpression.Create(FFuncClass);
try
Expr.Context := AContext;
Expr.Root.Capacity := AArgs.ChildCount;
for i := 0 to AArgs.ChildCount - 1 do
begin
Expr.Root.AddChild(AArgs.Children[i].Value);
AArgs.Children[i].Value := nil;
end;
Expr.Evaluate;
CheckFailure(Expr.Root.Value);
TMover<TAlgosimObject>.Move(Result, Expr.Root.Value);
finally
Expr.Free;
end;
end;
function NodeName(ANode: TClass): string;
begin
if Assigned(ANode) and ANode.InheritsFrom(TASExprNode) then
Result := TASExprNodeClass(ANode).NodeName
else if Assigned(ANode) then
Result := ANode.ClassName
else
Result := '';
end;
function NodeNames(const ANodes: array of TClass): TArray<string>;
var
i: Integer;
begin
SetLength(Result, Length(ANodes));
for i := 0 to High(ANodes) do
Result[i] := NodeName(ANodes[i]);
end;
procedure CheckFailure(AObj: TAlgosimObject);
begin
if IsFailure(AObj) then
raise ERuntimeException.Create(
TAlgosimFailure(AObj).FailureReason,
TAlgosimFailure(AObj).Source
);
end;
end.