Changeset 202

Timestamp:

Apr 17, 2020, 12:09:15 AM (5 years ago)

Author:

chronos

Message:

• Added: Support for String, Integer and Boolean types.
• Added: Support for more system defined functions..
• Added: Support for line comments.
• Added: For-To-Do construction.
• Added: Defined function parameters and and parsing function calls with parameters.
• Modified: Improved handling of expressions.

Location:

branches/interpreter2

Files:

• Test.pas (modified) (1 diff)
• UExecutor.pas (modified) (14 diffs)
• UFormMain.lfm (modified) (5 diffs)
• UFormMain.pas (modified) (4 diffs)
• UParser.pas (modified) (15 diffs)
• USource.pas (modified) (11 diffs)
• UTokenizer.pas (modified) (7 diffs)
• interpreter.lpi (modified) (1 diff)

branches/interpreter2/Test.pas

@@ +1 @@
+// Line comment
 program Test;
 var
-  A;
-  B;
+  A: string;
+  B: string;
+  X: string;
+  I: Integer;
 const
-  C = 1;
+  C: Integer = 1;
 begin  
-  A := 2;
-  B := C;
+  X := 'A' + 'B';
+  WriteLn(X);
+  A := IntToStr(2);
+  B := IntToStr(C);
   A := B;
-  if A then begin
+  
+  // If-Then-Else
+  if A = '2' then begin
     WriteLn('DoThen');
   end else WriteLn('DoElse');
 
-  A := '';
-  while A do begin
-    WriteLn(A);
+  // While-Do
+  I := 5;
+  while I <> 0 do begin
+    WriteLn(IntToStr(I));
+    I := I - 1;
+  end;
+  
+  // For-To-Do
+  for I := 0 to 5 do begin
+    WriteLn(IntToStr(I));    
   end;
     
+  // Begin-End
   begin
     WriteLn('Hello World!');

branches/interpreter2/UExecutor.pas

@@ -9 +9 @@
 
 type
+  TExecutorFunctions = class;
+
   TExecutorVariable = class
     Variable: TVariable;
-    Value: string;
+    Value: TValue;
   end;
 
@@ -21 +23 @@
   end;
 
-  TExecutorFunctionCallback = function(Params: array of string): string of object;
+  { TExecutorType }
+
+  TExecutorType = class
+    TypeRef: TType;
+    Functions: TExecutorFunctions;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  { TExecutorTypes }
+
+  TExecutorTypes = class(TObjectList)
+    function SearchByType(TypeRef: TType): TExecutorType;
+    function AddNew(TypeRef: TType): TExecutorType;
+  end;
+
+  TExecutorFunctionCallback = function(Params: array of TValue): TValue of object;
 
   TExecutorFunction = class
@@ -39 +57 @@
   TExecutorBlock = class
     Parent: TExecutorBlock;
+    Types: TExecutorTypes;
     Variables: TExecutorVariables;
     Functions: TExecutorFunctions;
     function GetFunction(FunctionDef: TFunction): TExecutorFunction;
+    function GetType(TypeDef: TType): TExecutorType;
+    function GetVariable(Variable: TVariable): TExecutorVariable;
+    function GetTypeFunction(TypeDef: TType; FunctionDef: TFunction): TExecutorFunction; overload;
+    function GetTypeFunction(TypeDef: TType; FunctionName: string): TExecutorFunction; overload;
     constructor Create;
     destructor Destroy; override;
@@ -54 +77 @@
     FOnOutput: TOutputEvent;
     SystemBlock: TExecutorBlock;
-    function ExecuteWriteLn(Params: array of string): string;
-    function ExecuteWrite(Params: array of string): string;
+    function ExecuteWriteLn(Params: array of TValue): TValue;
+    function ExecuteWrite(Params: array of TValue): TValue;
+    function ExecuteIntToStr(Params: array of TValue): TValue;
+    function ExecuteStrToInt(Params: array of TValue): TValue;
+    function ExecuteStringAssign(Params: array of TValue): TValue;
+    function ExecuteStringAdd(Params: array of TValue): TValue;
+    function ExecuteStringEqual(Params: array of TValue): TValue;
+    function ExecuteStringNotEqual(Params: array of TValue): TValue;
+    function ExecuteIntegerAssign(Params: array of TValue): TValue;
+    function ExecuteIntegerAdd(Params: array of TValue): TValue;
+    function ExecuteIntegerSub(Params: array of TValue): TValue;
+    function ExecuteIntegerEqual(Params: array of TValue): TValue;
+    function ExecuteIntegerNotEqual(Params: array of TValue): TValue;
     procedure InitExecutorBlock(ExecutorBlock: TExecutorBlock; Block: TBlock);
   public
@@ -64 +98 @@
     procedure ExecuteIfThenElse(Block: TExecutorBlock; IfThenElse: TIfThenElse);
     procedure ExecuteWhileDo(Block: TExecutorBlock; WhileDo: TWhileDo);
+    procedure ExecuteForToDo(Block: TExecutorBlock; ForToDo: TForToDo);
     procedure ExecuteBlock(ParentBlock: TExecutorBlock;Block: TBlock);
-    function ExecuteFunctionCall(Block: TExecutorBlock; FunctionCall: TFunctionCall): string;
+    function ExecuteFunctionCall(Block: TExecutorBlock; FunctionCall: TFunctionCall): TValue;
     procedure ExecuteAssignment(Block: TExecutorBlock; Assignment: TAssignment);
-    function ExecuteExpression(Block: TExecutorBlock; Expression: TExpression): string;
+    function ExecuteExpression(Block: TExecutorBlock; Expression: TExpression): TValue;
+    function ExecuteExpressionOperation(Block: TExecutorBlock; Expression: TExpressionOperation): TValue;
+    function ExecuteExpressionOperand(Block: TExecutorBlock; Expression: TExpressionOperand): TValue;
     procedure Run;
     procedure Output(Text: string);
@@ -75 +112 @@
 
 implementation
+
+{ TExecutorType }
+
+constructor TExecutorType.Create;
+begin
+  Functions := TExecutorFunctions.Create;
+end;
+
+destructor TExecutorType.Destroy;
+begin
+  Functions.Free;
+  inherited Destroy;
+end;
+
+{ TExecutorTypes }
+
+function TExecutorTypes.SearchByType(TypeRef: TType): TExecutorType;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (TExecutorType(Items[I]).TypeRef <> TypeRef) do Inc(I);
+  if I < Count then Result := TExecutorType(Items[I])
+    else Result := nil;
+end;
+
+function TExecutorTypes.AddNew(TypeRef: TType): TExecutorType;
+begin
+  Result := TExecutorType.Create;
+  Result.TypeRef := TypeRef;
+  Add(Result);
+end;
 
 { TExecutorFunctions }
@@ -124 +193 @@
 end;
 
+function TExecutorBlock.GetType(TypeDef: TType): TExecutorType;
+begin
+  Result := Types.SearchByType(TypeDef);
+  if not Assigned(Result) and Assigned(Parent) then
+    Result := Parent.GetType(TypeDef);
+end;
+
+function TExecutorBlock.GetVariable(Variable: TVariable): TExecutorVariable;
+begin
+  Result := Variables.SearchByVariable(Variable);
+  if not Assigned(Result) and Assigned(Parent) then
+    Result := Parent.GetVariable(Variable);
+end;
+
+function TExecutorBlock.GetTypeFunction(TypeDef: TType; FunctionDef: TFunction
+  ): TExecutorFunction;
+var
+  ExecutorType: TExecutorType;
+begin
+  ExecutorType := GetType(TypeDef);
+  Result := ExecutorType.Functions.SearchByFunction(FunctionDef);
+end;
+
+function TExecutorBlock.GetTypeFunction(TypeDef: TType; FunctionName: string
+  ): TExecutorFunction;
+begin
+  Result := GetTypeFunction(TypeDef, TypeDef.Functions.SearchByName(FunctionName));
+end;
+
 constructor TExecutorBlock.Create;
 begin
+  Types := TExecutorTypes.Create;
   Variables := TExecutorVariables.Create;
   Functions := TExecutorFunctions.Create;
@@ -134 +233 @@
   Variables.Free;
   Functions.Free;
+  Types.Free;
   inherited Destroy;
 end;
@@ -139 +239 @@
 { TExecutor }
 
-function TExecutor.ExecuteWriteLn(Params: array of string): string;
+function TExecutor.ExecuteWriteLn(Params: array of TValue): TValue;
 var
   I: Integer;
   Text: string;
 begin
-  Result := '';
+  Result := nil;
   Text := '';
   for I := 0 to Length(Params) - 1 do
-    Text := Text + Params[I];
+    Text := Text + TValueString(Params[I]).Value;
   Output(Text + LineEnding);
 end;
 
-function TExecutor.ExecuteWrite(Params: array of string): string;
+function TExecutor.ExecuteWrite(Params: array of TValue): TValue;
 var
   I: Integer;
   Text: string;
 begin
-  Result := '';
+  Result := nil;
   Text := '';
   for I := 0 to Length(Params) - 1 do
-    Text := Text + Params[I];
+    Text := Text + TValueString(Params[I]).Value;
   Output(Text);
 end;
 
+function TExecutor.ExecuteIntToStr(Params: array of TValue): TValue;
+begin
+  Result := TValueString.Create;
+  TValueString(Result).Value := IntToStr(TValueInteger(Params[0]).Value);
+end;
+
+function TExecutor.ExecuteStrToInt(Params: array of TValue): TValue;
+begin
+  Result := TValueInteger.Create;
+  TValueInteger(Result).Value := StrToInt(TValueString(Params[0]).Value);
+end;
+
+function TExecutor.ExecuteStringAssign(Params: array of TValue): TValue;
+begin
+  Result := TValueString.Create;
+  TValueString(Result).Value := TValueString(Params[0]).Value;
+end;
+
+function TExecutor.ExecuteStringAdd(Params: array of TValue): TValue;
+begin
+  Result := TValueString.Create;
+  TValueString(Result).Value := TValueString(Params[0]).Value + TValueString(Params[1]).Value;
+end;
+
+function TExecutor.ExecuteStringEqual(Params: array of TValue): TValue;
+begin
+  Result := TValueBoolean.Create;
+  TValueBoolean(Result).Value := TValueString(Params[0]).Value = TValueString(Params[1]).Value;
+end;
+
+function TExecutor.ExecuteStringNotEqual(Params: array of TValue): TValue;
+begin
+  Result := TValueBoolean.Create;
+  TValueBoolean(Result).Value := TValueString(Params[0]).Value <> TValueString(Params[1]).Value;
+end;
+
+function TExecutor.ExecuteIntegerAssign(Params: array of TValue): TValue;
+begin
+  Result := TValueInteger.Create;
+  TValueInteger(Result).Value := TValueInteger(Params[0]).Value;
+end;
+
+function TExecutor.ExecuteIntegerAdd(Params: array of TValue): TValue;
+begin
+  Result := TValueInteger.Create;
+  TValueInteger(Result).Value := TValueInteger(Params[0]).Value + TValueInteger(Params[1]).Value;
+end;
+
+function TExecutor.ExecuteIntegerSub(Params: array of TValue): TValue;
+begin
+  Result := TValueInteger.Create;
+  TValueInteger(Result).Value := TValueInteger(Params[0]).Value - TValueInteger(Params[1]).Value;
+end;
+
+function TExecutor.ExecuteIntegerEqual(Params: array of TValue): TValue;
+begin
+  Result := TValueBoolean.Create;
+  TValueBoolean(Result).Value := TValueInteger(Params[0]).Value = TValueInteger(Params[1]).Value;
+end;
+
+function TExecutor.ExecuteIntegerNotEqual(Params: array of TValue): TValue;
+begin
+  Result := TValueBoolean.Create;
+  TValueBoolean(Result).Value := TValueInteger(Params[0]).Value <> TValueInteger(Params[1]).Value;
+end;
+
 procedure TExecutor.InitExecutorBlock(ExecutorBlock: TExecutorBlock; Block: TBlock);
 var
   I: Integer;
+  J: Integer;
   ExecutorFunction: TExecutorFunction;
-begin
+  ExecutorType: TExecutorType;
+begin
+  for I := 0 to Block.Types.Count - 1 do begin
+    ExecutorType := ExecutorBlock.Types.AddNew(TType(Block.Types[I]));
+    for J := 0 to ExecutorType.TypeRef.Functions.Count - 1 do begin
+      ExecutorFunction := ExecutorType.Functions.AddNew(TFunction(ExecutorType.TypeRef.Functions[J]));
+      if ExecutorType.TypeRef.Name = 'string' then begin
+        if ExecutorFunction.FunctionDef.Name = '_Assign' then begin
+          ExecutorFunction.Callback := ExecuteStringAssign;
+        end else
+        if ExecutorFunction.FunctionDef.Name = '_Add' then begin
+          ExecutorFunction.Callback := ExecuteStringAdd;
+        end else
+        if ExecutorFunction.FunctionDef.Name = '_Equal' then begin
+          ExecutorFunction.Callback := ExecuteStringEqual;
+        end;
+        if ExecutorFunction.FunctionDef.Name = '_NotEqual' then begin
+          ExecutorFunction.Callback := ExecuteStringNotEqual;
+        end;
+      end;
+      if ExecutorType.TypeRef.Name = 'Integer' then begin
+        if ExecutorFunction.FunctionDef.Name = '_Assign' then begin
+          ExecutorFunction.Callback := ExecuteIntegerAssign;
+        end else
+        if ExecutorFunction.FunctionDef.Name = '_Add' then begin
+          ExecutorFunction.Callback := ExecuteIntegerAdd;
+        end else
+        if ExecutorFunction.FunctionDef.Name = '_Sub' then begin
+          ExecutorFunction.Callback := ExecuteIntegerSub;
+        end else
+        if ExecutorFunction.FunctionDef.Name = '_Equal' then begin
+          ExecutorFunction.Callback := ExecuteIntegerEqual;
+        end else
+        if ExecutorFunction.FunctionDef.Name = '_NotEqual' then begin
+          ExecutorFunction.Callback := ExecuteIntegerNotEqual;
+        end;
+      end;
+    end;
+  end;
   for I := 0 to Block.Variables.Count - 1 do
     ExecutorBlock.Variables.AddNew(TVariable(Block.Variables[I]));
   for I := 0 to Block.Functions.Count - 1 do begin
     ExecutorFunction := ExecutorBlock.Functions.AddNew(TFunction(Block.Functions[I]));
-    if ExecutorFunction.FunctionDef.Name = 'Write' then ExecutorFunction.Callback := ExecuteWrite
-    else if ExecutorFunction.FunctionDef.Name = 'WriteLn' then ExecutorFunction.Callback := ExecuteWriteLn;
+    if ExecutorFunction.FunctionDef.Name = 'Write' then begin
+      ExecutorFunction.Callback := ExecuteWrite;
+    end else
+    if ExecutorFunction.FunctionDef.Name = 'WriteLn' then begin
+      ExecutorFunction.Callback := ExecuteWriteLn;
+    end;
+    if ExecutorFunction.FunctionDef.Name = 'IntToStr' then begin
+      ExecutorFunction.Callback := ExecuteIntToStr;
+    end else
+    if ExecutorFunction.FunctionDef.Name = 'StrToInt' then begin
+      ExecutorFunction.Callback := ExecuteStrToInt;
+    end;
   end;
 end;
@@ -200 +415 @@
   else if Command is TIfThenElse then ExecuteIfThenElse(Block, TIfThenElse(Command))
   else if Command is TWhileDo then ExecuteWhileDo(Block, TWhileDo(Command))
+  else if Command is TForToDo then ExecuteForToDo(Block, TForToDo(Command))
   else raise Exception.Create('Unsupported command type');
 end;
@@ -206 +422 @@
   IfThenElse: TIfThenElse);
 var
-  Value: string;
+  Value: TValue;
 begin
   Value := ExecuteExpression(Block, IfThenElse.Expression);
-  if Value <> '' then ExecuteCommand(Block, IfThenElse.CommandThen)
-    else ExecuteCommand(Block, IfThenElse.CommandElse);
+  if Value is TValueBoolean then begin
+    if TValueBoolean(Value).Value then ExecuteCommand(Block, IfThenElse.CommandThen)
+      else ExecuteCommand(Block, IfThenElse.CommandElse);
+  end else raise Exception.Create('Expected boolean value.');
 end;
 
 procedure TExecutor.ExecuteWhileDo(Block: TExecutorBlock; WhileDo: TWhileDo);
 var
-  Value: string;
+  Value: TValue;
 begin
   while True do begin
     Value := ExecuteExpression(Block, WhileDo.Expression);
-    if Value <> '' then Continue
-      else Break;
+    if Value is TValueBoolean then begin
+      if not TValueBoolean(Value).Value then Break;
+      ExecuteCommand(Block, WhileDo.Command);
+    end else raise Exception.Create('Expected boolean value.');
+  end;
+end;
+
+procedure TExecutor.ExecuteForToDo(Block: TExecutorBlock; ForToDo: TForToDo);
+var
+  Value: TValue;
+  Variable: TExecutorVariable;
+  Limit: TValue;
+begin
+  Variable := Block.GetVariable(ForToDo.VariableRef);
+  Variable.Value := ExecuteExpression(Block, ForToDo.ExpressionFrom);
+  Limit := ExecuteExpression(Block, ForToDo.ExpressionTo);
+  while True do begin
+    ExecuteCommand(Block, ForToDo.Command);
+    TValueInteger(Variable.Value).Value := TValueInteger(Variable.Value).Value + 1;
+    if TValueInteger(Variable.Value).Value > TValueInteger(Limit).Value then Break;
   end;
 end;
@@ -236 +472 @@
 
 function TExecutor.ExecuteFunctionCall(Block: TExecutorBlock;
-  FunctionCall: TFunctionCall): string;
+  FunctionCall: TFunctionCall): TValue;
 var
   ExecutorFunction: TExecutorFunction;
-  Params: array of string;
-  I: Integer;
-begin
-  Result := '';
+  Params: array of TValue;
+  I: Integer;
+begin
+  Result := nil;
   ExecutorFunction := Block.GetFunction(FunctionCall.FunctionDef);
   if Assigned(ExecutorFunction) then begin
     SetLength(Params, FunctionCall.Params.Count);
-    for I := 0 to FunctionCall.Params.Count - 1 do
+    for I := 0 to FunctionCall.Params.Count - 1 do begin
       Params[I] := ExecuteExpression(Block, TExpression(FunctionCall.Params[0]));
+    end;
     Result := ExecutorFunction.Callback(Params);
   end else raise Exception.Create('No executor for ' + FunctionCall.FunctionDef.Name + ' function.');
@@ -255 +492 @@
   Assignment: TAssignment);
 var
-  Value: string;
+  Value: TValue;
   Variable: TExecutorVariable;
+  ExecutorFunction: TExecutorFunction;
+  Params: array of TValue;
 begin
   Value := ExecuteExpression(Block, Assignment.Expression);
-  Variable := Block.Variables.SearchByVariable(Assignment.Variable);
-  Variable.Value := Value;
+  Variable := Block.GetVariable(Assignment.Variable);
+  ExecutorFunction := Block.GetTypeFunction(Assignment.Variable.TypeRef, '_Assign');
+  if Assignment.Variable.TypeRef = Assignment.Expression.GetType then begin;
+    SetLength(Params, 1);
+    Params[0] := Value;
+    Variable.Value := ExecutorFunction.Callback(Params);
+  end else raise Exception('Assignment result type is ' + Variable.Variable.TypeRef.Name +
+    ' but value is ' + Assignment.Expression.GetType.Name + '.');
 end;
 
 function TExecutor.ExecuteExpression(Block: TExecutorBlock;
-  Expression: TExpression): string;
+  Expression: TExpression): TValue;
+begin
+  if Expression is TExpressionOperation then
+    Result := ExecuteExpressionOperation(Block, TExpressionOperation(Expression))
+  else
+  if Expression is TExpressionOperand then
+    Result := ExecuteExpressionOperand(Block, TExpressionOperand(Expression))
+  else raise Exception.Create('Unknown expression class.');
+end;
+
+function TExecutor.ExecuteExpressionOperation(Block: TExecutorBlock;
+  Expression: TExpressionOperation): TValue;
+var
+  I: Integer;
+  Value: TValue;
+  ExecutorFunction: TExecutorFunction;
+  Params: array of TValue;
+  FuncName: string;
+begin
+  if Expression.Operation = eoAdd then FuncName := '_Add'
+  else if Expression.Operation = eoSub then FuncName := '_Sub'
+  else if Expression.Operation = eoEqual then FuncName := '_Equal'
+  else if Expression.Operation = eoNotEqual then FuncName := '_NotEqual'
+  else raise Exception.Create('Unsupported operation type.');
+
+  ExecutorFunction := Block.GetTypeFunction(Expression.TypeRef, FuncName);
+  Result := Expression.TypeRef.ValueClass.Create;
+
+  SetLength(Params, Expression.Items.Count);
+  for I := 0 to Expression.Items.Count - 1 do begin
+    Value := ExecuteExpression(Block, TExpression(Expression.Items[I]));
+    Params[I] := Value;
+  end;
+  Result := ExecutorFunction.Callback(Params);
+end;
+
+function TExecutor.ExecuteExpressionOperand(Block: TExecutorBlock;
+  Expression: TExpressionOperand): TValue;
 begin
   if Assigned(Expression.VariableRef) then begin
@@ -274 +556 @@
   if Assigned(Expression.FunctionCall) then begin
     Result := ExecuteFunctionCall(Block, Expression.FunctionCall);
-  end;
+  end else raise Exception.Create('Unsupported exception operand type.');
 end;
 

branches/interpreter2/UFormMain.lfm

@@ -13 +13 @@
   OnShow = FormShow
   LCLVersion = '2.0.2.0'
-  object MemoSource: TMemo
-    Left = 24
-    Height = 672
-    Top = 64
-    Width = 671
-    Font.Name = 'Liberation Mono'
-    ParentFont = False
-    ScrollBars = ssAutoBoth
-    TabOrder = 0
-  end
   object MemoLog: TMemo
     Left = 24
@@ -30 +20 @@
     ReadOnly = True
     ScrollBars = ssAutoBoth
-    TabOrder = 1
+    TabOrder = 0
   end
   object MemoOutput: TMemo
@@ -40 +30 @@
     ParentFont = False
     ScrollBars = ssAutoBoth
-    TabOrder = 2
+    TabOrder = 1
   end
   object ButtonCompile: TButton
@@ -49 +39 @@
     Caption = 'Compile'
     OnClick = ButtonCompileClick
-    TabOrder = 3
+    TabOrder = 2
   end
   object Label1: TLabel
@@ -74 +64 @@
     Caption = 'Run'
     OnClick = ButtonRunClick
+    TabOrder = 3
+  end
+  inline SynEditSource: TSynEdit
+    Left = 24
+    Height = 673
+    Top = 64
+    Width = 672
+    Font.Height = -20
+    Font.Name = 'Liberation Mono'
+    Font.Pitch = fpFixed
+    Font.Quality = fqNonAntialiased
+    ParentColor = False
+    ParentFont = False
     TabOrder = 4
+    Gutter.Width = 85
+    Gutter.MouseActions = <>
+    RightGutter.Width = 0
+    RightGutter.MouseActions = <>
+    Highlighter = SynFreePascalSyn1
+    Keystrokes = <    
+      item
+        Command = ecUp
+        ShortCut = 38
+      end    
+      item
+        Command = ecSelUp
+        ShortCut = 8230
+      end    
+      item
+        Command = ecScrollUp
+        ShortCut = 16422
+      end    
+      item
+        Command = ecDown
+        ShortCut = 40
+      end    
+      item
+        Command = ecSelDown
+        ShortCut = 8232
+      end    
+      item
+        Command = ecScrollDown
+        ShortCut = 16424
+      end    
+      item
+        Command = ecLeft
+        ShortCut = 37
+      end    
+      item
+        Command = ecSelLeft
+        ShortCut = 8229
+      end    
+      item
+        Command = ecWordLeft
+        ShortCut = 16421
+      end    
+      item
+        Command = ecSelWordLeft
+        ShortCut = 24613
+      end    
+      item
+        Command = ecRight
+        ShortCut = 39
+      end    
+      item
+        Command = ecSelRight
+        ShortCut = 8231
+      end    
+      item
+        Command = ecWordRight
+        ShortCut = 16423
+      end    
+      item
+        Command = ecSelWordRight
+        ShortCut = 24615
+      end    
+      item
+        Command = ecPageDown
+        ShortCut = 34
+      end    
+      item
+        Command = ecSelPageDown
+        ShortCut = 8226
+      end    
+      item
+        Command = ecPageBottom
+        ShortCut = 16418
+      end    
+      item
+        Command = ecSelPageBottom
+        ShortCut = 24610
+      end    
+      item
+        Command = ecPageUp
+        ShortCut = 33
+      end    
+      item
+        Command = ecSelPageUp
+        ShortCut = 8225
+      end    
+      item
+        Command = ecPageTop
+        ShortCut = 16417
+      end    
+      item
+        Command = ecSelPageTop
+        ShortCut = 24609
+      end    
+      item
+        Command = ecLineStart
+        ShortCut = 36
+      end    
+      item
+        Command = ecSelLineStart
+        ShortCut = 8228
+      end    
+      item
+        Command = ecEditorTop
+        ShortCut = 16420
+      end    
+      item
+        Command = ecSelEditorTop
+        ShortCut = 24612
+      end    
+      item
+        Command = ecLineEnd
+        ShortCut = 35
+      end    
+      item
+        Command = ecSelLineEnd
+        ShortCut = 8227
+      end    
+      item
+        Command = ecEditorBottom
+        ShortCut = 16419
+      end    
+      item
+        Command = ecSelEditorBottom
+        ShortCut = 24611
+      end    
+      item
+        Command = ecToggleMode
+        ShortCut = 45
+      end    
+      item
+        Command = ecCopy
+        ShortCut = 16429
+      end    
+      item
+        Command = ecPaste
+        ShortCut = 8237
+      end    
+      item
+        Command = ecDeleteChar
+        ShortCut = 46
+      end    
+      item
+        Command = ecCut
+        ShortCut = 8238
+      end    
+      item
+        Command = ecDeleteLastChar
+        ShortCut = 8
+      end    
+      item
+        Command = ecDeleteLastChar
+        ShortCut = 8200
+      end    
+      item
+        Command = ecDeleteLastWord
+        ShortCut = 16392
+      end    
+      item
+        Command = ecUndo
+        ShortCut = 32776
+      end    
+      item
+        Command = ecRedo
+        ShortCut = 40968
+      end    
+      item
+        Command = ecLineBreak
+        ShortCut = 13
+      end    
+      item
+        Command = ecSelectAll
+        ShortCut = 16449
+      end    
+      item
+        Command = ecCopy
+        ShortCut = 16451
+      end    
+      item
+        Command = ecBlockIndent
+        ShortCut = 24649
+      end    
+      item
+        Command = ecLineBreak
+        ShortCut = 16461
+      end    
+      item
+        Command = ecInsertLine
+        ShortCut = 16462
+      end    
+      item
+        Command = ecDeleteWord
+        ShortCut = 16468
+      end    
+      item
+        Command = ecBlockUnindent
+        ShortCut = 24661
+      end    
+      item
+        Command = ecPaste
+        ShortCut = 16470
+      end    
+      item
+        Command = ecCut
+        ShortCut = 16472
+      end    
+      item
+        Command = ecDeleteLine
+        ShortCut = 16473
+      end    
+      item
+        Command = ecDeleteEOL
+        ShortCut = 24665
+      end    
+      item
+        Command = ecUndo
+        ShortCut = 16474
+      end    
+      item
+        Command = ecRedo
+        ShortCut = 24666
+      end    
+      item
+        Command = ecGotoMarker0
+        ShortCut = 16432
+      end    
+      item
+        Command = ecGotoMarker1
+        ShortCut = 16433
+      end    
+      item
+        Command = ecGotoMarker2
+        ShortCut = 16434
+      end    
+      item
+        Command = ecGotoMarker3
+        ShortCut = 16435
+      end    
+      item
+        Command = ecGotoMarker4
+        ShortCut = 16436
+      end    
+      item
+        Command = ecGotoMarker5
+        ShortCut = 16437
+      end    
+      item
+        Command = ecGotoMarker6
+        ShortCut = 16438
+      end    
+      item
+        Command = ecGotoMarker7
+        ShortCut = 16439
+      end    
+      item
+        Command = ecGotoMarker8
+        ShortCut = 16440
+      end    
+      item
+        Command = ecGotoMarker9
+        ShortCut = 16441
+      end    
+      item
+        Command = ecSetMarker0
+        ShortCut = 24624
+      end    
+      item
+        Command = ecSetMarker1
+        ShortCut = 24625
+      end    
+      item
+        Command = ecSetMarker2
+        ShortCut = 24626
+      end    
+      item
+        Command = ecSetMarker3
+        ShortCut = 24627
+      end    
+      item
+        Command = ecSetMarker4
+        ShortCut = 24628
+      end    
+      item
+        Command = ecSetMarker5
+        ShortCut = 24629
+      end    
+      item
+        Command = ecSetMarker6
+        ShortCut = 24630
+      end    
+      item
+        Command = ecSetMarker7
+        ShortCut = 24631
+      end    
+      item
+        Command = ecSetMarker8
+        ShortCut = 24632
+      end    
+      item
+        Command = ecSetMarker9
+        ShortCut = 24633
+      end    
+      item
+        Command = EcFoldLevel1
+        ShortCut = 41009
+      end    
+      item
+        Command = EcFoldLevel2
+        ShortCut = 41010
+      end    
+      item
+        Command = EcFoldLevel3
+        ShortCut = 41011
+      end    
+      item
+        Command = EcFoldLevel4
+        ShortCut = 41012
+      end    
+      item
+        Command = EcFoldLevel5
+        ShortCut = 41013
+      end    
+      item
+        Command = EcFoldLevel6
+        ShortCut = 41014
+      end    
+      item
+        Command = EcFoldLevel7
+        ShortCut = 41015
+      end    
+      item
+        Command = EcFoldLevel8
+        ShortCut = 41016
+      end    
+      item
+        Command = EcFoldLevel9
+        ShortCut = 41017
+      end    
+      item
+        Command = EcFoldLevel0
+        ShortCut = 41008
+      end    
+      item
+        Command = EcFoldCurrent
+        ShortCut = 41005
+      end    
+      item
+        Command = EcUnFoldCurrent
+        ShortCut = 41003
+      end    
+      item
+        Command = EcToggleMarkupWord
+        ShortCut = 32845
+      end    
+      item
+        Command = ecNormalSelect
+        ShortCut = 24654
+      end    
+      item
+        Command = ecColumnSelect
+        ShortCut = 24643
+      end    
+      item
+        Command = ecLineSelect
+        ShortCut = 24652
+      end    
+      item
+        Command = ecTab
+        ShortCut = 9
+      end    
+      item
+        Command = ecShiftTab
+        ShortCut = 8201
+      end    
+      item
+        Command = ecMatchBracket
+        ShortCut = 24642
+      end    
+      item
+        Command = ecColSelUp
+        ShortCut = 40998
+      end    
+      item
+        Command = ecColSelDown
+        ShortCut = 41000
+      end    
+      item
+        Command = ecColSelLeft
+        ShortCut = 40997
+      end    
+      item
+        Command = ecColSelRight
+        ShortCut = 40999
+      end    
+      item
+        Command = ecColSelPageDown
+        ShortCut = 40994
+      end    
+      item
+        Command = ecColSelPageBottom
+        ShortCut = 57378
+      end    
+      item
+        Command = ecColSelPageUp
+        ShortCut = 40993
+      end    
+      item
+        Command = ecColSelPageTop
+        ShortCut = 57377
+      end    
+      item
+        Command = ecColSelLineStart
+        ShortCut = 40996
+      end    
+      item
+        Command = ecColSelLineEnd
+        ShortCut = 40995
+      end    
+      item
+        Command = ecColSelEditorTop
+        ShortCut = 57380
+      end    
+      item
+        Command = ecColSelEditorBottom
+        ShortCut = 57379
+      end>
+    MouseActions = <>
+    MouseTextActions = <>
+    MouseSelActions = <>
+    VisibleSpecialChars = [vscSpace, vscTabAtLast]
+    SelectedColor.BackPriority = 50
+    SelectedColor.ForePriority = 50
+    SelectedColor.FramePriority = 50
+    SelectedColor.BoldPriority = 50
+    SelectedColor.ItalicPriority = 50
+    SelectedColor.UnderlinePriority = 50
+    SelectedColor.StrikeOutPriority = 50
+    BracketHighlightStyle = sbhsBoth
+    BracketMatchColor.Background = clNone
+    BracketMatchColor.Foreground = clNone
+    BracketMatchColor.Style = [fsBold]
+    FoldedCodeColor.Background = clNone
+    FoldedCodeColor.Foreground = clGray
+    FoldedCodeColor.FrameColor = clGray
+    MouseLinkColor.Background = clNone
+    MouseLinkColor.Foreground = clBlue
+    LineHighlightColor.Background = clNone
+    LineHighlightColor.Foreground = clNone
+    inline SynLeftGutterPartList1: TSynGutterPartList
+      object SynGutterMarks1: TSynGutterMarks
+        Width = 36
+        MouseActions = <>
+      end
+      object SynGutterLineNumber1: TSynGutterLineNumber
+        Width = 25
+        MouseActions = <>
+        MarkupInfo.Background = clBtnFace
+        MarkupInfo.Foreground = clNone
+        DigitCount = 2
+        ShowOnlyLineNumbersMultiplesOf = 1
+        ZeroStart = False
+        LeadingZeros = False
+      end
+      object SynGutterChanges1: TSynGutterChanges
+        Width = 6
+        MouseActions = <>
+        ModifiedColor = 59900
+        SavedColor = clGreen
+      end
+      object SynGutterSeparator1: TSynGutterSeparator
+        Width = 3
+        MouseActions = <>
+        MarkupInfo.Background = clWhite
+        MarkupInfo.Foreground = clGray
+      end
+      object SynGutterCodeFolding1: TSynGutterCodeFolding
+        Width = 15
+        MouseActions = <>
+        MarkupInfo.Background = clNone
+        MarkupInfo.Foreground = clGray
+        MouseActionsExpanded = <>
+        MouseActionsCollapsed = <>
+      end
+    end
+  end
+  object SynFreePascalSyn1: TSynFreePascalSyn
+    Enabled = False
+    CompilerMode = pcmObjFPC
+    NestedComments = True
+    left = 608
+    top = 128
   end
 end

branches/interpreter2/UFormMain.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, USource;
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  SynHighlighterPas, SynEdit, USource;
 
 type
@@ -17 +18 @@
     Label1: TLabel;
     Label2: TLabel;
-    MemoSource: TMemo;
     MemoLog: TMemo;
     MemoOutput: TMemo;
+    SynEditSource: TSynEdit;
+    SynFreePascalSyn1: TSynFreePascalSyn;
     procedure ButtonCompileClick(Sender: TObject);
     procedure ButtonRunClick(Sender: TObject);
@@ -53 +55 @@
   if not Initialized then begin
     Initialized := True;
-    MemoSource.Lines.LoadFromFile('Test.pas');
+    SynEditSource.Lines.LoadFromFile('Test.pas');
     ButtonRun.Click;
   end;
@@ -95 +97 @@
   Parser := TParser.Create;
   Parser.OnError := InterpreterError;
-  Parser.Source := MemoSource.Lines.Text;
+  Parser.Source := SynEditSource.Lines.Text;
   Parser.Parse;
   if Assigned(Prog) then Prog.Free;

branches/interpreter2/UParser.pas

@@ -21 +21 @@
     function ParseProgram(SystemBlock: TBlock; out Prog: TProgram): Boolean;
     function ParseBlock(ParentBlock: TBlock; out Block: TBlock): Boolean;
-    function ParseVarBlock(Block: TBlock): Boolean;
-    function ParseConstBlock(Block: TBlock): Boolean;
+    function ParseBlockVar(Block: TBlock): Boolean;
+    function ParseBlockConst(Block: TBlock): Boolean;
     function ParseAssignment(Block: TBlock; out Assignment: TAssignment): Boolean;
     function ParseExpression(Block: TBlock; out Expression: TExpression): Boolean;
+    function ParseExpressionOperation(Block: TBlock; out ExpressionOperation: TExpressionOperation): Boolean;
+    function ParseExpressionOperand(Block: TBlock; out ExpressionOperand: TExpressionOperand): Boolean;
+    function ParseConstant(Block: TBlock; out ConstantRef: TConstant): Boolean;
+    function ParseVariable(Block: TBlock; out VariableRef: TVariable): Boolean;
     function ParseIfThenElse(Block: TBlock; out IfThenElse: TIfThenElse): Boolean;
     function ParseWhileDo(Block: TBlock; out WhileDo: TWhileDo): Boolean;
+    function ParseForToDo(Block: TBlock; out ForToDo: TForToDo): Boolean;
     procedure TokenizerError(Pos: TPoint; Text: string);
     procedure InitSystemBlock(Block: TBlock);
@@ -73 +78 @@
   FunctionDef: TFunction;
   Expression: TExpression;
+  I: Integer;
 begin
   LastPos := Tokenizer.Pos;
@@ -80 +86 @@
     if Assigned(FunctionDef) then begin
       FunctionCall := TFunctionCall.Create;
-      FunctionCall.FunctionDef := functionDef;
+      FunctionCall.FunctionDef := FunctionDef;
       if Tokenizer.CheckNext('(', tkSpecialSymbol) then begin
         Tokenizer.Expect('(', tkSpecialSymbol);
-        if ParseExpression(Block, Expression) then begin
-          FunctionCall.Params.Add(Expression);
-        end else Error('Exprected function parameter.');
+        for I := 0 to FunctionDef.Params.Count - 1 do begin
+          if I > 0 then Tokenizer.Expect(',', tkSpecialSymbol);
+          if ParseExpression(Block, Expression) then begin
+            if Expression.GetType = TFunctionParameter(FunctionDef.Params[I]).TypeRef then
+              FunctionCall.Params.Add(Expression)
+              else Error('Function parameter mismatch.');
+          end else Error('Expected function parameter.');
+        end;
         Tokenizer.Expect(')', tkSpecialSymbol);
       end;
@@ -106 +117 @@
   IfThenElse: TIfThenElse;
   WhileDo: TWhileDo;
+  ForToDo: TForToDo;
 begin
   if ParseIfThenElse(Block, IfThenElse) then begin
@@ -114 +126 @@
     Result := True;
     Command := WhileDo;
+  end else
+  if ParseForToDo(Block, ForToDo) then begin
+    Result := True;
+    Command := ForToDo;
   end else
   if ParseBeginEnd(Block, BeginEnd) then begin
@@ -163 +179 @@
   Block := TBlock.Create;
   Block.Parent := ParentBlock;
-  ParseVarBlock(Block);
-  ParseConstBlock(Block);
+  ParseBlockVar(Block);
+  ParseBlockConst(Block);
   if ParseBeginEnd(Block, BeginEnd) then begin
     Result := True;
@@ -172 +188 @@
 end;
 
-function TParser.ParseVarBlock(Block: TBlock): Boolean;
+function TParser.ParseBlockVar(Block: TBlock): Boolean;
 var
   Token: TToken;
   Variable: TVariable;
+  TypeRef: TType;
 begin
   if Tokenizer.CheckNext('var', tkKeyword) then begin
@@ -188 +205 @@
           Variable.Name := Token.Text;
           Block.Variables.Add(Variable);
+          Tokenizer.Expect(':', tkSpecialSymbol);
+          Token := Tokenizer.GetNext;
+          if Token.Kind = tkIdentifier then begin
+            TypeRef := Block.GetType(Token.Text);
+            if Assigned(TypeRef) then begin
+              Variable.TypeRef := TypeRef;
+            end else Error('Type ' + Token.Text + ' not found.');
+          end;
         end else Error('Variable ' + Token.Text + ' redefined.');
         Tokenizer.Expect(';', tkSpecialSymbol);
@@ -198 +223 @@
 end;
 
-function TParser.ParseConstBlock(Block: TBlock): Boolean;
+function TParser.ParseBlockConst(Block: TBlock): Boolean;
 var
   Token: TToken;
   Constant: TConstant;
+  TypeRef: TType;
 begin
   if Tokenizer.CheckNext('const', tkKeyword) then begin
@@ -214 +240 @@
           Constant.Name := Token.Text;
           Block.Constants.Add(Constant);
+          Tokenizer.Expect(':', tkSpecialSymbol);
+          Token := Tokenizer.GetNext;
+          if Token.Kind = tkIdentifier then begin
+            TypeRef := Block.GetType(Token.Text);
+            if Assigned(TypeRef) then begin
+              Constant.TypeRef := TypeRef;
+            end else Error('Type ' + Token.Text + ' not found.');
+          end;
           Tokenizer.Expect('=', tkSpecialSymbol);
           Token := Tokenizer.GetNext;
-          if (Token.Kind = tkNumber) or (Token.Kind = tkString) then
-            Constant.Value := Token.Text
-            else Error('Expected string or number.');
+          if Token.Kind = tkNumber then begin
+            Constant.Value := TValueInteger.Create;
+            TValueInteger(Constant.Value).Value := StrToInt(Token.Text);
+          end else
+          if Token.Kind = tkString then begin
+            Constant.Value := TValueString.Create;
+            TValueString(Constant.Value).Value := Token.Text;
+          end else Error('Expected string or number.');
         end else Error('Constant ' + Token.Text + ' redefined.');
         Tokenizer.Expect(';', tkSpecialSymbol);
@@ -239 +278 @@
   if Token.Kind = tkIdentifier then begin
     Result := True;
-    Variable := Block.Variables.SearchByName(Token.Text);
+    Variable := Block.GetVariable(Token.Text);
     if Assigned(Variable) then begin
       Result := True;
@@ -246 +285 @@
       Tokenizer.Expect(':=', tkSpecialSymbol);
       if ParseExpression(Block, Expression) then begin
-        Assignment.Expression.Free;
-        Assignment.Expression := Expression;
+        if Expression.GetType = Variable.TypeRef then begin
+          Assignment.Expression.Free;
+          Assignment.Expression := Expression;
+        end else begin
+          Result := False;
+          Error('Assignment type mismatch.');
+        end;
       end;
+      if not Result then Assignment.Free;
     end else Error('Variable ' + Token.Text + ' not defined.');
   end;
@@ -256 +301 @@
   ): Boolean;
 var
+  ExpressionOperation: TExpressionOperation;
+  ExpressionOperand: TExpressionOperand;
+begin
+  Result := False;
+  if ParseExpressionOperation(Block, ExpressionOperation) then begin
+    Result := True;
+    Expression := ExpressionOperation;
+  end else
+  if ParseExpressionOperand(Block, ExpressionOperand) then begin
+    Result := True;
+    Expression := ExpressionOperand;
+  end;
+end;
+
+function TParser.ParseExpressionOperation(Block: TBlock; out
+  ExpressionOperation: TExpressionOperation): Boolean;
+var
+  Operand: TExpressionOperand;
+  Token: TToken;
+  Expression: TExpression;
+  LastPos: TTokenizerPos;
+begin
+  Result := False;
+  LastPos := Tokenizer.Pos;
+  if ParseExpressionOperand(Block, Operand) then begin
+    Token := Tokenizer.GetNext;
+    if (Token.Kind = tkSpecialSymbol) and Tokenizer.IsOperator(Token.Text) then begin
+      Result := True;
+      ExpressionOperation := TExpressionOperation.Create;
+      ExpressionOperation.TypeRef := Operand.GetType;
+      if Token.Text = '+' then ExpressionOperation.Operation := eoAdd
+      else if Token.Text = '-' then ExpressionOperation.Operation := eoSub
+      else if Token.Text = '=' then ExpressionOperation.Operation := eoEqual
+      else if Token.Text = '<>' then ExpressionOperation.Operation := eoNotEqual
+      else Error('Unsupported operator ' + Token.Text);
+      ExpressionOperation.Items.Add(Operand);
+      if ParseExpression(Block, Expression) then begin
+        if Expression.GetType = Operand.GetType then
+          ExpressionOperation.Items.Add(Expression)
+          else Error('Expression operands needs to be same type.');
+      end else Error('Missing operand.');
+    end;
+  end;
+  if not Result then Tokenizer.Pos := LastPos;
+end;
+
+function TParser.ParseExpressionOperand(Block: TBlock; out
+  ExpressionOperand: TExpressionOperand): Boolean;
+var
   Variable: TVariable;
   Constant: TConstant;
-  Token: TToken;
-begin
-  Result := False;
+  FunctionCall: TFunctionCall;
+begin
+  Result := False;
+  if ParseFunctionCall(Block, FunctionCall) then begin
+    Result := True;
+    ExpressionOperand := TExpressionOperand.Create;
+    ExpressionOperand.FunctionCall := FunctionCall;
+    ExpressionOperand.OperandType := otFunctionCall;
+  end else
+  if ParseConstant(Block, Constant) then begin
+    Result := True;
+    ExpressionOperand := TExpressionOperand.Create;
+    ExpressionOperand.ConstantRef := Constant;
+    ExpressionOperand.OperandType := otConstant;
+  end else
+  if ParseVariable(Block, Variable) then begin
+    Result := True;
+    ExpressionOperand := TExpressionOperand.Create;
+    ExpressionOperand.VariableRef := Variable;
+    ExpressionOperand.OperandType := otVariable;
+  end else Error('Expected expression operand.');
+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 = tkIdentifier then begin
-    Variable := Block.Variables.SearchByName(Token.Text);
-    if Assigned(Variable) then begin
+  if Token.Kind = tkIdentifier then begin;
+    ConstantRef := Block.GetConstant(Token.Text);
+    if Assigned(ConstantRef) then begin
       Result := True;
-      Expression := TExpression.Create;
-      Expression.VariableRef := Variable;
-    end else begin
-      Constant := Block.Constants.SearchByName(Token.Text);
-      if Assigned(Constant) then begin
-        Result := True;
-        Expression := TExpression.Create;
-        Expression.ConstantRef := Constant;
-      end;
     end;
   end else
   if Token.Kind = tkNumber then begin
     Result := True;
-    Constant := Block.Constants.AddNew('_C' + IntToStr(Block.Constants.Count));
-    Constant.Value := Token.Text;
-    Expression := TExpression.Create;
-    Expression.ConstantRef := Constant;
+    ConstantRef := Block.Constants.AddNew('_C' + IntToStr(Block.Constants.Count));
+    ConstantRef.TypeRef := Block.GetType('Integer');
+    ConstantRef.Value := TValueInteger.Create;
+    TValueInteger(ConstantRef.Value).Value := StrToInt(Token.Text);
   end else
   if Token.Kind = tkString then begin
     Result := True;
-    Constant := Block.Constants.AddNew('_C' + IntToStr(Block.Constants.Count));
-    Constant.Value := Token.Text;
-    Expression := TExpression.Create;
-    Expression.ConstantRef := Constant;
-  end;
+    ConstantRef := Block.Constants.AddNew('_C' + IntToStr(Block.Constants.Count));
+    ConstantRef.TypeRef := Block.GetType('string');
+    ConstantRef.Value := TValueString.Create;
+    TValueString(ConstantRef.Value).Value := Token.Text;
+  end;
+  if not Result then Tokenizer.Pos := LastPos;
+end;
+
+function TParser.ParseVariable(Block: TBlock; out VariableRef: TVariable
+  ): Boolean;
+var
+  LastPos: TTokenizerPos;
+  Token: TToken;
+begin
+  Result := False;
+  LastPos := Tokenizer.Pos;
+  Token := Tokenizer.GetNext;
+  if Token.Kind = tkIdentifier then begin;
+    VariableRef := Block.GetVariable(Token.Text);
+    if Assigned(VariableRef) then begin
+      Result := True;
+    end;
+  end;
+  if not Result then Tokenizer.Pos := LastPos;
 end;
 
@@ -345 +477 @@
 end;
 
+function TParser.ParseForToDo(Block: TBlock; out ForToDo: TForToDo): Boolean;
+var
+  Expression: TExpression;
+  VariableRef: TVariable;
+  Command: TCommand;
+begin
+  Result := False;
+  if Tokenizer.CheckNext('for', tkKeyword) then begin
+    Tokenizer.Expect('for', tkKeyword);
+    Result := True;
+    ForToDo := TForToDo.Create;
+    if ParseVariable(Block, VariableRef) then begin
+      ForToDo.VariableRef := VariableRef;
+      Tokenizer.Expect(':=', tkSpecialSymbol);
+      if ParseExpression(Block, Expression) then begin
+        ForToDo.ExpressionFrom.Free;
+        ForToDo.ExpressionFrom := Expression;
+        Tokenizer.Expect('to', tkKeyword);
+        if ParseExpression(Block, Expression) then begin
+          ForToDo.ExpressionTo.Free;
+          ForToDo.ExpressionTo := Expression;
+          Tokenizer.Expect('do', tkKeyword);
+          if ParseCommand(Block, Command) then begin
+            ForToDo.Command.Free;
+            ForToDo.Command := Command;
+          end else Error('Expected command.');
+        end else Error('Expected expression.');
+      end else Error('Expected expression.');
+    end else Error('Expected control variable.');
+  end;
+end;
+
 procedure TParser.TokenizerError(Pos: TPoint; Text: string);
 begin
@@ -352 +516 @@
 
 procedure TParser.InitSystemBlock(Block: TBlock);
-begin
-  Block.Functions.AddNew('WriteLn');
-  Block.Functions.AddNew('Write');
+var
+  TypeBoolean: TType;
+  TypeString: TType;
+  TypeInteger: TType;
+begin
+  TypeBoolean := Block.Types.AddNew('Boolean');
+  with TypeBoolean do begin
+    ValueClass := TValueBoolean;
+    with Functions.AddNew('_Assign') do begin
+      Params.AddNew('Source', TypeBoolean);
+      ResultType := TypeBoolean;
+    end;
+    with Functions.AddNew('_Equal') do begin
+      Params.AddNew('A', TypeBoolean);
+      Params.AddNew('B', TypeBoolean);
+      ResultType := TypeBoolean;
+    end;
+  end;
+  TypeString := Block.Types.AddNew('string');
+  with TypeString do begin
+    ValueClass := TValueString;
+    with Functions.AddNew('_Assign') do begin
+      Params.AddNew('Source', TypeString);
+      ResultType := TypeString;
+    end;
+    with Functions.AddNew('_Add') do begin
+      Params.AddNew('A', TypeString);
+      Params.AddNew('B', TypeString);
+      ResultType := TypeString;
+    end;
+    with Functions.AddNew('_Equal') do begin
+      Params.AddNew('A', TypeString);
+      Params.AddNew('B', TypeString);
+      ResultType := TypeBoolean;
+    end;
+    with Functions.AddNew('_NotEqual') do begin
+      Params.AddNew('A', TypeString);
+      Params.AddNew('B', TypeString);
+      ResultType := TypeBoolean;
+    end;
+  end;
+  TypeInteger := Block.Types.AddNew('Integer');
+  with TypeInteger do begin
+    ValueClass := TValueInteger;
+    with Functions.AddNew('_Assign') do begin
+      Params.AddNew('Source', TypeInteger);
+      ResultType := TypeInteger;
+    end;
+    with Functions.AddNew('_Add') do begin
+      Params.AddNew('A', TypeInteger);
+      Params.AddNew('B', TypeInteger);
+      ResultType := TypeInteger;
+    end;
+    with Functions.AddNew('_Sub') do begin
+      Params.AddNew('A', TypeInteger);
+      Params.AddNew('B', TypeInteger);
+      ResultType := TypeInteger;
+    end;
+    with Functions.AddNew('_Equal') do begin
+      Params.AddNew('A', TypeInteger);
+      Params.AddNew('B', TypeInteger);
+      ResultType := TypeBoolean;
+    end;
+    with Functions.AddNew('_NotEqual') do begin
+      Params.AddNew('A', TypeInteger);
+      Params.AddNew('B', TypeInteger);
+      ResultType := TypeBoolean;
+    end;
+  end;
+  with Block.Functions.AddNew('IntToStr') do begin
+    Params.AddNew('Value', TypeInteger);
+    ResultType := TypeString;
+  end;
+  with Block.Functions.AddNew('StrToInt') do begin
+    Params.AddNew('Value', TypeString);
+    ResultType := TypeInteger;
+  end;
+  with Block.Functions.AddNew('WriteLn') do begin
+    Params.AddNew('Text', TypeString);
+  end;
+  with Block.Functions.AddNew('Write') do begin
+    Params.AddNew('Text', TypeString);
+  end;
 end;
 

branches/interpreter2/USource.pas

@@ -10 +10 @@
 type
   TExpressions = class;
+  TFunctions = class;
+
+  TValue = class
+  end;
+
+  TValueString = class(TValue)
+    Value: string;
+  end;
+
+  TValueInteger = class(TValue)
+    Value: Integer;
+  end;
+
+  TValueBoolean = class(TValue)
+    Value: Boolean;
+  end;
+
+  TValueClass = class of TValue;
+
+  { TType }
+
+  TType = class
+    Name: string;
+    Functions: TFunctions;
+    ValueClass: TValueClass;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  { TTypes }
+
+  TTypes = class(TObjectList)
+    function SearchByName(Name: string): TType;
+    function AddNew(Name: string): TType;
+  end;
 
   TVariable = class
     Name: string;
+    TypeRef: TType;
   end;
 
@@ -23 +59 @@
   TConstant = class
     Name: string;
-    Value: string;
+    TypeRef: TType;
+    Value: TValue;
   end;
 
@@ -33 +70 @@
   end;
 
+  TFunctionParameter = class
+    Name: string;
+    TypeRef: TType;
+  end;
+
+  { TFunctionParameters }
+
+  TFunctionParameters = class(TObjectList)
+    function SearchByName(Name: string): TFunctionParameter;
+    function AddNew(Name: string; TypeRef: TType): TFunctionParameter;
+  end;
+
+  { TFunction }
+
   TFunction = class
     Name: string;
+    Params: TFunctionParameters;
+    ResultType: TType;
+    constructor Create;
+    destructor Destroy; override;
   end;
 
@@ -52 +107 @@
     FunctionDef: TFunction;
     Params: TExpressions;
-    ReturnValue: Boolean;
     constructor Create;
     destructor Destroy; override;
@@ -66 +120 @@
   end;
 
+  TExpressionOperator = (eoAdd, eoSub, eoMultiply, eoDivide, eoModulo, eoAnd, eoXor,
+    eoOr, eoShl, eoShr, eoEqual, eoNotEqual);
+
+  { TExpression }
+
   TExpression = class
+    function GetType: TType; virtual;
+  end;
+
+  { TExpressionOperation }
+
+  TExpressionOperation = class(TExpression)
+    TypeRef: TType;
+    Operation: TExpressionOperator;
+    Items: TExpressions;
+    constructor Create;
+    destructor Destroy; override;
+    function GetType: TType; override;
+  end;
+
+  TExpressionOperandType = (otVariable, otConstant, otFunctionCall);
+
+  { TExpressionOperand }
+
+  TExpressionOperand = class(TExpression)
+    OperandType: TExpressionOperandType;
     VariableRef: TVariable;
     ConstantRef: TConstant;
     FunctionCall: TFunctionCall;
+    function GetType: TType; override;
   end;
 
@@ -98 +178 @@
   TWhileDo = class(TCommand)
     Expression: TExpression;
+    Command: TCommand;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  { TForToDo }
+
+  TForToDo = class(TCommand)
+    VariableRef: TVariable;
+    ExpressionFrom: TExpression;
+    ExpressionTo: TExpression;
     Command: TCommand;
     constructor Create;
@@ -110 +201 @@
     Constants: TConstants;
     Functions: TFunctions;
+    Types: TTypes;
     BeginEnd: TBeginEnd;
     procedure Clear;
+    function GetType(Name: string): TType;
+    function GetConstant(Name: string): TConstant;
+    function GetVariable(Name: string): TVariable;
     function GetFunction(Name: string): TFunction;
     constructor Create;
@@ -130 +225 @@
 implementation
 
+{ TForToDo }
+
+constructor TForToDo.Create;
+begin
+  ExpressionFrom := TExpression.Create;
+  ExpressionTo := TExpression.Create;
+  Command := TCommand.Create;
+end;
+
+destructor TForToDo.Destroy;
+begin
+  Command.Free;
+  ExpressionTo.Free;
+  ExpressionFrom.Free;
+  inherited Destroy;
+end;
+
+{ TExpression }
+
+function TExpression.GetType: TType;
+begin
+  Result := nil;
+end;
+
+{ TExpressionOperand }
+
+function TExpressionOperand.GetType: TType;
+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 raise Exception.Create('Unsupported operand type');
+end;
+
+{ TFunctionParameters }
+
+function TFunctionParameters.SearchByName(Name: string): TFunctionParameter;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (TFunctionParameter(Items[I]).Name <> Name) do Inc(I);
+  if I < Count then Result := TFunctionParameter(Items[I])
+    else Result := nil;
+end;
+
+function TFunctionParameters.AddNew(Name: string; TypeRef: TType): TFunctionParameter;
+begin
+  Result := TFunctionParameter.Create;
+  Result.Name := Name;
+  Result.TypeRef := TypeRef;
+  Add(Result);
+end;
+
+{ TFunction }
+
+constructor TFunction.Create;
+begin
+  Params := TFunctionParameters.Create;
+end;
+
+destructor TFunction.Destroy;
+begin
+  Params.Free;
+  inherited Destroy;
+end;
+
+{ TType }
+
+constructor TType.Create;
+begin
+  Functions := TFunctions.Create;
+end;
+
+destructor TType.Destroy;
+begin
+  Functions.Free;
+  inherited Destroy;
+end;
+
+{ TTypes }
+
+function TTypes.SearchByName(Name: string): TType;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (TType(Items[I]).Name <> Name) do Inc(I);
+  if I < Count then Result := TType(Items[I])
+    else Result := nil;
+end;
+
+function TTypes.AddNew(Name: string): TType;
+begin
+  Result := TType.Create;
+  Result.Name := Name;
+  Add(Result);
+end;
+
+{ TExpressionOperation }
+
+constructor TExpressionOperation.Create;
+begin
+  Items := TExpressions.Create;
+end;
+
+destructor TExpressionOperation.Destroy;
+begin
+  Items.Free;
+  inherited Destroy;
+end;
+
+function TExpressionOperation.GetType: TType;
+begin
+  Result := TypeRef;
+end;
+
 { TAssignment }
 
@@ -247 +459 @@
   Constants.Clear;
   Variables.Clear;
+  Types.Clear;
+end;
+
+function TBlock.GetType(Name: string): TType;
+begin
+  Result := Types.SearchByName(Name);
+  if not Assigned(Result) and Assigned(Parent) then
+    Result := Parent.Types.SearchByName(Name);
+end;
+
+function TBlock.GetConstant(Name: string): TConstant;
+begin
+  Result := Constants.SearchByName(Name);
+  if not Assigned(Result) and Assigned(Parent) then
+    Result := Parent.Constants.SearchByName(Name);
+end;
+
+function TBlock.GetVariable(Name: string): TVariable;
+begin
+  Result := Variables.SearchByName(Name);
+  if not Assigned(Result) and Assigned(Parent) then
+    Result := Parent.Variables.SearchByName(Name);
 end;
 
@@ -261 +495 @@
   Variables := TVariables.Create;
   Functions := TFunctions.Create;
+  Types := TTypes.Create;
   BeginEnd := TBeginEnd.Create;
 end;
@@ -267 +502 @@
 begin
   BeginEnd.Free;
+  Types.Free;
   Variables.Free;
   Constants.Free;

branches/interpreter2/UTokenizer.pas

@@ -30 +30 @@
 
   TTokenizerState = (tsNone, tsIdentifier, tsString, tsStringEnd, tsNumber,
-    tsSpecialSymbol);
+    tsSpecialSymbol, tsLineComment);
 
   { TTokenizer }
@@ -48 +48 @@
     function IsSpecialSymbol2(Text: string): Boolean;
     function IsIdentifier(Text: string): Boolean;
+    function IsOperator(Text: string): Boolean;
     function IsKeyword(Text: string): Boolean;
     procedure Init;
     function GetNext: TToken;
-    function CheckNext(Text: string; Kind: TTokenKind = tkUnknown): Boolean;
+    function CheckNext(Text: string; Kind: TTokenKind): Boolean;
     function CheckNextKind(Kind: TTokenKind): Boolean;
-    procedure Expect(Text: string; Kind: TTokenKind = tkUnknown);
+    procedure Expect(Text: string; Kind: TTokenKind);
     procedure Error(Text: string);
     property OnError: TErrorEvent read FOnError write FOnError;
@@ -109 +110 @@
 begin
   Result := (C = ';') or (C = '.') or (C = '(') or (C = ')') or (C = '=') or
-    (C = ':');
+    (C = ':') or (C = '+') or (C = '-') or (C = ',') or (C = '/') or
+    (C = '<') or (C = '>');
 end;
 
 function TTokenizer.IsSpecialSymbol2(Text: string): Boolean;
 begin
-  Result := (Text = ':=');
+  Result := (Text = ':=') or (Text = '//') or (Text = '<>');
 end;
 
@@ -137 +139 @@
 end;
 
+function TTokenizer.IsOperator(Text: string): Boolean;
+begin
+  Result := (Text = '+') or (Text = '-') or (Text = '=') or (Text = '<>');
+end;
+
 function TTokenizer.IsKeyword(Text: string): Boolean;
 begin
   Result := (Text = 'begin') or (Text = 'end') or (Text = 'program') or
   (Text = 'var') or (Text = 'const') or (Text = 'if') or (Text = 'then') or
-  (Text = 'else') or (Text = 'while') or (Text = 'do');
+  (Text = 'else') or (Text = 'while') or (Text = 'do') or (Text = 'for') or
+  (Text = 'to');
 end;
 
@@ -229 +237 @@
       end;
     end else
+    if State = tsLineComment then begin
+      if C = #10 then begin
+        State := tsNone;
+      end else Pos.Increment;
+    end else
     if State = tsSpecialSymbol then begin
       if IsSpecialSymbol2(Result.Text + C) then begin
         Result.Text := Result.Text + C;
         Pos.Increment;
-        Break;
+        if Result.Text = '//' then begin
+          Result.Text := '';
+          State := tsLineComment;
+        end else Break;
       end else begin
         Break;
@@ -242 +258 @@
 end;
 
-function TTokenizer.CheckNext(Text: string; Kind: TTokenKind = tkUnknown): Boolean;
+function TTokenizer.CheckNext(Text: string; Kind: TTokenKind): Boolean;
 var
   LastPos: TTokenizerPos;
@@ -264 +280 @@
 end;
 
-procedure TTokenizer.Expect(Text: string; Kind: TTokenKind = tkUnknown);
+procedure TTokenizer.Expect(Text: string; Kind: TTokenKind);
 var
   Token: TToken;

branches/interpreter2/interpreter.lpi

@@ -63 +63 @@
       <Modes Count="0"/>
     </RunParams>
-    <RequiredPackages Count="1">
+    <RequiredPackages Count="2">
       <Item1>
+        <PackageName Value="SynEdit"/>
+      </Item1>
+      <Item2>
         <PackageName Value="LCL"/>
-      </Item1>
+      </Item2>
     </RequiredPackages>
     <Units Count="7">