Changeset 212 for branches/interpreter2/USource.pas

Timestamp:

Apr 22, 2020, 12:04:22 PM (5 years ago)

Author:

chronos

Message:

• Added: Support for custom functions.

File:

• branches/interpreter2/USource.pas (modified) (16 diffs)

branches/interpreter2/USource.pas

@@ -12 +12 @@
   TFunctions = class;
   TBeginEnd = class;
+  TBlock = class;
 
   TDataType = (dtNone, dtString, dtBoolean, dtInteger, dtFloat, dtColor,
@@ -129 +130 @@
     Name: string;
     TypeRef: TType;
+    Internal: Boolean;
     procedure GetValue(Index: Integer; out Value); override;
     function GetField(Index: Integer): TField; override;
@@ -183 +185 @@
     Params: TFunctionParameters;
     ResultType: TType;
-    BeginEnd: TBeginEnd;
+    Block: TBlock;
+    ParentType: TType;
     procedure GetValue(Index: Integer; out Value); override;
     function GetField(Index: Integer): TField; override;
@@ -194 +197 @@
 
   TFunctions = class(TSourceNodes)
+    ParentType: TType;
     function SearchByName(Name: string): TFunction;
     function AddNew(Name: string): TFunction;
@@ -253 +257 @@
   public
     TypeRef: TType;
+    FunctionRef: TFunction;
     Operation: TExpressionOperator;
     Items: TExpressions;
+    function GetFunctionName: string;
     procedure GetValue(Index: Integer; out Value); override;
     function GetField(Index: Integer): TField; override;
@@ -839 +845 @@
 procedure TFunction.GetValue(Index: Integer; out Value);
 begin
-  if Index = 0 then TBeginEnd(Value) := BeginEnd
+  if Index = 0 then TBlock(Value) := Block
   else if Index = 1 then TFunctionParameters(Value) := Params
   else if Index = 2 then TType(Value) := ResultType
@@ -862 +868 @@
 procedure TFunction.SetValue(Index: Integer; var Value);
 begin
-  if Index = 0 then BeginEnd := TBeginEnd(Value)
+  if Index = 0 then Block := TBlock(Value)
   else if Index = 1 then Params := TFunctionParameters(Value)
   else if Index = 2 then ResultType := TType(Value)
@@ -872 +878 @@
 begin
   Params := TFunctionParameters.Create;
-  BeginEnd := TBeginEnd.Create;
+  Block := TBlock.Create;
 end;
 
 destructor TFunction.Destroy;
 begin
-  BeginEnd.Free;
+  Block.Free;
   Params.Free;
   inherited Destroy;
@@ -910 +916 @@
 begin
   Functions := TFunctions.Create;
+  Functions.ParentType := Self;
 end;
 
@@ -950 +957 @@
 end;
 
+function TExpressionOperation.GetFunctionName: string;
+begin
+  if Operation = eoAdd then Result := '_Add'
+  else if Operation = eoSub then Result := '_Sub'
+  else if Operation = eoEqual then Result := '_Equal'
+  else if Operation = eoNotEqual then Result := '_NotEqual'
+  else raise Exception.Create('Unsupported operation type.');
+end;
+
 function TExpressionOperation.GetFieldsCount: Integer;
 begin
@@ -1159 +1175 @@
   Result := TFunction.Create;
   Result.Name := Name;
+  Result.ParentType := ParentType;
   Add(Result);
 end;
@@ -1242 +1259 @@
   Result := Types.SearchByName(Name);
   if not Assigned(Result) and Assigned(ParentBlock) then
-    Result := ParentBlock.Types.SearchByName(Name);
+    Result := ParentBlock.GetType(Name);
 end;
 
@@ -1249 +1266 @@
   Result := Constants.SearchByName(Name);
   if not Assigned(Result) and Assigned(ParentBlock) then
-    Result := ParentBlock.Constants.SearchByName(Name);
+    Result := ParentBlock.GetConstant(Name);
 end;
 
@@ -1256 +1273 @@
   Result := Variables.SearchByName(Name);
   if not Assigned(Result) and Assigned(ParentBlock) then
-    Result := ParentBlock.Variables.SearchByName(Name);
+    Result := ParentBlock.GetVariable(Name);
 end;
 
@@ -1263 +1280 @@
   Result := Functions.SearchByName(Name);
   if not Assigned(Result) and Assigned(ParentBlock) then
-    Result := ParentBlock.Functions.SearchByName(Name);
+    Result := ParentBlock.GetFunction(Name);
 end;
 
@@ -1269 +1286 @@
 begin
   Constants := TConstants.Create;
+  Constants.Parent := Self;
   Variables := TVariables.Create;
+  Variables.Parent := Self;
   Functions := TFunctions.Create;
+  Functions.Parent := Self;
   Types := TTypes.Create;
+  Types.Parent := Self;
   BeginEnd := TBeginEnd.Create;
+  BeginEnd.Parent := Self;
 end;