Changeset 203

Timestamp:

Apr 17, 2020, 10:16:25 PM (5 years ago)

Author:

chronos

Message:

• Added: Simple pascal code generator.

Location:

branches/interpreter2

Files:

• Test.pas (modified) (1 diff)
• UExecutor.pas (modified) (11 diffs)
• UFormMain.lfm (modified) (1 diff)
• UFormMain.pas (modified) (4 diffs)
• UGenerator.pas (added)
• UParser.pas (modified) (6 diffs)
• USource.pas (modified) (5 diffs)
• interpreter.lpi (modified) (2 diffs)
• interpreter.lpr (modified) (1 diff)

branches/interpreter2/Test.pas

@@ -30 +30 @@
   for I := 0 to 5 do begin
     WriteLn(IntToStr(I));    
-  end;
+  end;  
     
   // Begin-End

branches/interpreter2/UExecutor.pas

@@ -10 +10 @@
 type
   TExecutorFunctions = class;
+
+  { TExecutorVariable }
 
   TExecutorVariable = class
     Variable: TVariable;
     Value: TValue;
+    constructor Create;
+    destructor Destroy; override;
   end;
 
@@ -99 +103 @@
     procedure ExecuteWhileDo(Block: TExecutorBlock; WhileDo: TWhileDo);
     procedure ExecuteForToDo(Block: TExecutorBlock; ForToDo: TForToDo);
-    procedure ExecuteBlock(ParentBlock: TExecutorBlock;Block: TBlock);
+    procedure ExecuteBlock(ParentBlock: TExecutorBlock; Block: TBlock);
     function ExecuteFunctionCall(Block: TExecutorBlock; FunctionCall: TFunctionCall): TValue;
     procedure ExecuteAssignment(Block: TExecutorBlock; Assignment: TAssignment);
@@ -112 +116 @@
 
 implementation
+
+{ TExecutorVariable }
+
+constructor TExecutorVariable.Create;
+begin
+  Value := TValue.Create;
+end;
+
+destructor TExecutorVariable.Destroy;
+begin
+  Value.Free;
+  inherited Destroy;
+end;
 
 { TExecutorType }
@@ -429 +446 @@
       else ExecuteCommand(Block, IfThenElse.CommandElse);
   end else raise Exception.Create('Expected boolean value.');
+  Value.Free;
 end;
 
@@ -441 +459 @@
       ExecuteCommand(Block, WhileDo.Command);
     end else raise Exception.Create('Expected boolean value.');
+    Value.Free;
   end;
 end;
@@ -446 +465 @@
 procedure TExecutor.ExecuteForToDo(Block: TExecutorBlock; ForToDo: TForToDo);
 var
-  Value: TValue;
   Variable: TExecutorVariable;
   Limit: TValue;
 begin
   Variable := Block.GetVariable(ForToDo.VariableRef);
+  Variable.Value.Free;
   Variable.Value := ExecuteExpression(Block, ForToDo.ExpressionFrom);
   Limit := ExecuteExpression(Block, ForToDo.ExpressionTo);
@@ -458 +477 @@
     if TValueInteger(Variable.Value).Value > TValueInteger(Limit).Value then Break;
   end;
+  Limit.Free;
 end;
 
@@ -486 +506 @@
     end;
     Result := ExecutorFunction.Callback(Params);
+    for I := 0 to FunctionCall.Params.Count - 1 do begin
+      Params[I].Free;
+    end;
   end else raise Exception.Create('No executor for ' + FunctionCall.FunctionDef.Name + ' function.');
 end;
@@ -503 +526 @@
     SetLength(Params, 1);
     Params[0] := Value;
+    Variable.Value.Free;
     Variable.Value := ExecutorFunction.Callback(Params);
   end else raise Exception('Assignment result type is ' + Variable.Variable.TypeRef.Name +
     ' but value is ' + Assignment.Expression.GetType.Name + '.');
+  Value.Free;
 end;
 
@@ -543 +568 @@
   end;
   Result := ExecutorFunction.Callback(Params);
+  for I := 0 to Expression.Items.Count - 1 do begin
+    Params[I].Free;
+  end;
 end;
 
@@ -548 +576 @@
   Expression: TExpressionOperand): TValue;
 begin
-  if Assigned(Expression.VariableRef) then begin
-    Result := Block.Variables.SearchByVariable(Expression.VariableRef).Value;
-  end else
-  if Assigned(Expression.ConstantRef) then begin
-    Result := Expression.ConstantRef.Value;
-  end else
-  if Assigned(Expression.FunctionCall) then begin
-    Result := ExecuteFunctionCall(Block, Expression.FunctionCall);
-  end else raise Exception.Create('Unsupported exception operand type.');
+  case Expression.OperandType of
+    otFunctionCall: Result := ExecuteFunctionCall(Block, Expression.FunctionCall);
+    otConstantDirect: Result := Expression.ConstantDirect.Value.Clone;
+    otConstantRef: Result := Expression.ConstantRef.Value.Clone;
+    otVariableRef: Result := Block.Variables.SearchByVariable(Expression.VariableRef).Value.Clone;
+    else raise Exception.Create('Unsupported exception operand type.');
+  end;
 end;
 

branches/interpreter2/UFormMain.lfm

@@ -563 +563 @@
     end
   end
+  object ButtonGenerate: TButton
+    Left = 288
+    Height = 38
+    Top = 18
+    Width = 113
+    Caption = 'Generate'
+    OnClick = ButtonGenerateClick
+    TabOrder = 5
+  end
   object SynFreePascalSyn1: TSynFreePascalSyn
     Enabled = False

branches/interpreter2/UFormMain.pas

@@ -16 +16 @@
     ButtonCompile: TButton;
     ButtonRun: TButton;
+    ButtonGenerate: TButton;
     Label1: TLabel;
     Label2: TLabel;
@@ -23 +24 @@
     SynFreePascalSyn1: TSynFreePascalSyn;
     procedure ButtonCompileClick(Sender: TObject);
+    procedure ButtonGenerateClick(Sender: TObject);
     procedure ButtonRunClick(Sender: TObject);
     procedure FormActivate(Sender: TObject);
@@ -47 +49 @@
 
 uses
-  UParser, UExecutor;
+  UParser, UExecutor, UGenerator;
 
 { TFormMain }
@@ -105 +107 @@
 end;
 
+procedure TFormMain.ButtonGenerateClick(Sender: TObject);
+var
+  Generator: TGenerator;
+begin
+  ButtonCompile.Click;
+  MemoOutput.Lines.Clear;
+  if Assigned(Prog) then begin
+    Generator := TGenerator.Create;
+    Generator.Prog := Prog;
+    Generator.Generate;
+    MemoOutput.Lines.Text := Generator.Output;
+    Generator.Free;
+  end;
+end;
+
 procedure TFormMain.InterpreterError(Pos: TPoint; Text: string);
 begin

branches/interpreter2/UParser.pas

@@ -27 +27 @@
     function ParseExpressionOperation(Block: TBlock; out ExpressionOperation: TExpressionOperation): Boolean;
     function ParseExpressionOperand(Block: TBlock; out ExpressionOperand: TExpressionOperand): Boolean;
+    function ParseConstantRef(Block: TBlock; out ConstantRef: TConstant): Boolean;
     function ParseConstant(Block: TBlock; out ConstantRef: TConstant): Boolean;
     function ParseVariable(Block: TBlock; out VariableRef: TVariable): Boolean;
@@ -342 +343 @@
           else Error('Expression operands needs to be same type.');
       end else Error('Missing operand.');
-    end;
+    end else Operand.Free;
   end;
   if not Result then Tokenizer.Pos := LastPos;
@@ -364 +365 @@
     Result := True;
     ExpressionOperand := TExpressionOperand.Create;
+    ExpressionOperand.ConstantDirect := Constant;
+    ExpressionOperand.OperandType := otConstantDirect;
+  end else
+  if ParseConstantRef(Block, Constant) then begin
+    Result := True;
+    ExpressionOperand := TExpressionOperand.Create;
     ExpressionOperand.ConstantRef := Constant;
-    ExpressionOperand.OperandType := otConstant;
+    ExpressionOperand.OperandType := otConstantRef;
   end else
   if ParseVariable(Block, Variable) then begin
@@ -371 +378 @@
     ExpressionOperand := TExpressionOperand.Create;
     ExpressionOperand.VariableRef := Variable;
-    ExpressionOperand.OperandType := otVariable;
+    ExpressionOperand.OperandType := otVariableRef;
   end else Error('Expected expression operand.');
 end;
 
-function TParser.ParseConstant(Block: TBlock; out ConstantRef: TConstant
+function TParser.ParseConstantRef(Block: TBlock; out ConstantRef: TConstant
   ): Boolean;
 var
@@ -389 +396 @@
       Result := True;
     end;
-  end else
+  end;
+  if not Result then Tokenizer.Pos := LastPos;
+end;
+
+function TParser.ParseConstant(Block: TBlock; out ConstantRef: TConstant
+  ): Boolean;
+var
+  LastPos: TTokenizerPos;
+  Token: TToken;
+begin
+  Result := False;
+  LastPos := Tokenizer.Pos;
+  Token := Tokenizer.GetNext;
   if Token.Kind = tkNumber then begin
     Result := True;
-    ConstantRef := Block.Constants.AddNew('_C' + IntToStr(Block.Constants.Count));
+    ConstantRef := TConstant.Create;
     ConstantRef.TypeRef := Block.GetType('Integer');
     ConstantRef.Value := TValueInteger.Create;
@@ -399 +418 @@
   if Token.Kind = tkString then begin
     Result := True;
-    ConstantRef := Block.Constants.AddNew('_C' + IntToStr(Block.Constants.Count));
+    ConstantRef := TConstant.Create;
     ConstantRef.TypeRef := Block.GetType('string');
     ConstantRef.Value := TValueString.Create;

branches/interpreter2/USource.pas

@@ -12 +12 @@
   TFunctions = class;
 
+  { TValue }
+
   TValue = class
-  end;
+    function Clone: TValue; virtual;
+  end;
+
+  { TValueString }
 
   TValueString = class(TValue)
     Value: string;
-  end;
+    function Clone: TValue; override;
+  end;
+
+  { TValueInteger }
 
   TValueInteger = class(TValue)
     Value: Integer;
-  end;
+    function Clone: TValue; override;
+  end;
+
+  { TValueBoolean }
 
   TValueBoolean = class(TValue)
     Value: Boolean;
+    function Clone: TValue; override;
   end;
 
@@ -140 +152 @@
   end;
 
-  TExpressionOperandType = (otVariable, otConstant, otFunctionCall);
+  TExpressionOperandType = (otVariableRef, otConstantRef, otConstantDirect, otFunctionCall);
 
   { TExpressionOperand }
@@ -148 +160 @@
     VariableRef: TVariable;
     ConstantRef: TConstant;
+    ConstantDirect: TConstant;
     FunctionCall: TFunctionCall;
     function GetType: TType; override;
+    constructor Create;
+    destructor Destroy; override;
   end;
 
@@ -225 +240 @@
 implementation
 
+{ TValueBoolean }
+
+function TValueBoolean.Clone: TValue;
+begin
+  Result := TValueBoolean.Create;
+  TValueBoolean(Result).Value := Value;
+end;
+
+{ TValueInteger }
+
+function TValueInteger.Clone: TValue;
+begin
+  Result := TValueInteger.Create;
+  TValueInteger(Result).Value := Value;
+end;
+
+{ TValueString }
+
+function TValueString.Clone: TValue;
+begin
+  Result := TValueString.Create;
+  TValueString(Result).Value := Value;
+end;
+
+{ TValue }
+
+function TValue.Clone: TValue;
+begin
+  Result := nil;
+end;
+
 { TForToDo }
 
@@ -254 +300 @@
 begin
   if OperandType = otFunctionCall then Result := FunctionCall.FunctionDef.ResultType
-  else if OperandType = otConstant then Result := ConstantRef.TypeRef
-  else if OperandType = otVariable then Result := VariableRef.TypeRef
+  else if OperandType = otConstantRef then Result := ConstantRef.TypeRef
+  else if OperandType = otConstantDirect then Result := ConstantDirect.TypeRef
+  else if OperandType = otVariableRef then Result := VariableRef.TypeRef
   else raise Exception.Create('Unsupported operand type');
+end;
+
+constructor TExpressionOperand.Create;
+begin
+end;
+
+destructor TExpressionOperand.Destroy;
+begin
+  if Assigned(ConstantDirect) then ConstantDirect.Free;
 end;
 

branches/interpreter2/interpreter.lpi

@@ -71 +71 @@
       </Item2>
     </RequiredPackages>
-    <Units Count="7">
+    <Units Count="8">
       <Unit0>
         <Filename Value="interpreter.lpr"/>
@@ -103 +103 @@
         <IsPartOfProject Value="True"/>
       </Unit6>
+      <Unit7>
+        <Filename Value="UGenerator.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit7>
     </Units>
   </ProjectOptions>

branches/interpreter2/interpreter.lpr

@@ -8 +8 @@
   {$ENDIF}{$ENDIF}
   Interfaces, SysUtils, // this includes the LCL widgetset
-  Forms, UFormMain, UParser, UTokenizer, USource, UExecutor, UInterpreter
+  Forms, UFormMain, UParser, UTokenizer, USource, UExecutor, UInterpreter, UGenerator
   { you can add units after this };