Changeset 20 for branches/DelphiToC/UPascalParser.pas

Timestamp:

Sep 8, 2009, 2:01:55 PM (15 years ago)

Author:

george

Message:

• Přidáno: Analýza páru dalších programových konstrukcí.
• Přidáno: Pár jednoduchých testovacích příkladů pro překladač.

File:

• branches/DelphiToC/UPascalParser.pas (modified) (9 diffs)

branches/DelphiToC/UPascalParser.pas

@@ -8 +8 @@
 
 type
+  TPascalParser = class;
+
   TOnErrorMessage = procedure (Text: string) of object;
+
+  TParserCommand = class(TCommand)
+    procedure Parse(Parser: TPascalParser);
+  end;
+
+  TParserWhileDo = class(TWhileDo)
+    procedure Parse(Parser: TPascalParser);
+  end;
+
+  TParserExpression = class(TExpression)
+    procedure Parse(Parser: TPascalParser);
+  end;
+
+
 
   TPascalParser = class
@@ -32 +48 @@
     procedure ParseModuleProgram(Module: TModule);
     procedure ParseFunction(FunctionList: TFunctionList);
+    procedure ParseFunctionParameterList(ParameterList: TParameterList);
     procedure ParseVariableList(VariableList: TVariableList);
     procedure ParseVariable(Variable: TVariable);
@@ -40 +57 @@
     procedure ParseCommonBlockDefinitions(CommonBlock: TCommonBlock; EndSymbol: string = ';');
     function ParseCommonBlockExpression(CommonBlock: TCommonBlock): TExpression;
-    procedure ParseCommonBlockProgramCode(CommonBlock: TCommonBlock);
-    procedure ParseCommonBlockOperation(CommonBlock: TCommonBlock);
+    function ParseCommand(CommonBlock: TCommonBlock): TCommand;
+    procedure ParseBeginEnd(CommonBlock: TCommonBlock; Command: TBeginEnd);
+    procedure ParseIfThenElse(CommonBlock: TCommonBlock; Command: TIfThenElse);
+    procedure ParseWhileDo(CommonBlock: TCommonBlock; Command: TWhileDo);
     procedure Log(Text: string);
     property OnErrorMessage: TOnErrorMessage read FOnErrorMessage write FOnErrorMessage;
@@ -206 +225 @@
 
 procedure TPascalParser.ParseFunction(FunctionList: TFunctionList);
-begin
+var
+  Identifiers: TStringList;
+  NewValueType: TType;
+  TypeName: string;
+  VariableName: string;
+  Variable: TParameter;
+  I: Integer;
+begin
+  Identifiers := TStringList.Create;
   with FunctionList do begin
     with TFunction(Items[Add(TFunction.Create)]) do begin
+      Parent := FunctionList.Parent;
       Expect('procedure');
       Name := ReadCode;
-      Expect(';');
-      ParseCommonBlockDefinitions(Items[Count - 1]);
-    end;
+      if NextCode = '(' then begin
+        Expect('(');
+        while NextCode <> ')' do begin
+//    while IsIdentificator(NextCode) do begin
+          with TParameterList(Parameters) do begin
+            VariableName := ReadCode;
+            Variable := Search(VariableName);
+            if not Assigned(Variable) then begin
+              Identifiers.Add(VariableName);
+              while NextCode = ',' do begin
+                Expect(',');
+                Identifiers.Add(ReadCode);
+              end;
+            end else ErrorMessage('Pøedefinování existující promìnné.');
+            Expect(':');
+            TypeName := ReadCode;
+            NewValueType := Parent.Types.Search(TypeName);
+            if not Assigned(NewValueType) then ErrorMessage('Typ ' + TypeName + ' nebyl definován.')
+              else for I := 0 to Identifiers.Count - 1 do
+                with TParameter(Items[Add(TParameter.Create)]) do begin
+                  Name := Identifiers[I];
+                  ValueType := NewValueType;
+                end;
+          end;
+        end;
+        Expect(')');
+      end;
+    end;
+    Expect(';');
+    ParseCommonBlockDefinitions(TFunction(Items[Count - 1]));
+  end;
+  Identifiers.Destroy;
+end;
+
+procedure TPascalParser.ParseFunctionParameterList(
+  ParameterList: TParameterList);
+begin
+
+end;
+
+procedure TPascalParser.ParseIfThenElse(CommonBlock: TCommonBlock; Command: TIfThenElse);
+begin
+  Expect('if');
+  Expect('than');
+  if NextCode = 'else' then begin
+    Expect('else');
   end;
 end;
@@ -229 +300 @@
       Name := 'main';
       with TType(Types[Types.Add(TType.Create)]) do begin
+        Name := 'void';
+        Size := 0;
+        UsedType := nil;
+      end;
+      with TType(Types[Types.Add(TType.Create)]) do begin
         Name := 'byte';
         Size := 1;
         UsedType := nil;
+      end;
+      with TFunction(Methods[Methods.Add(TFunction.Create)]) do begin
+        Name := 'exit';
+        ResultType := TModule(Modules[0]).Types[0];
       end;
     end;
@@ -318 +398 @@
 end;
 
+procedure TPascalParser.ParseBeginEnd(CommonBlock: TCommonBlock; Command: TBeginEnd);
+var
+  NewCommand: TCommand;
+begin
+  with Command do begin
+    Expect('begin');
+    while NextCode <> 'end' do begin
+      NewCommand := ParseCommand(CommonBlock);
+      if Assigned(NewCommand) then Commands.Add(NewCommand);
+      //ShowMessage(NextCode);
+      if NextCode = ';' then ReadCode;      
+    end;
+    Expect('end');
+  end;
+end;
+
 procedure TPascalParser.ParseCommonBlockDefinitions(CommonBlock: TCommonBlock; EndSymbol: string = ';');
 begin
@@ -327 +423 @@
       else if NextCode = 'procedure' then ParseFunction(Methods)
       else begin
-        ParseCommonBlockProgramCode(CommonBlock);
+        ParseBeginEnd(CommonBlock, Code);
         Break;
       end;
@@ -335 +431 @@
 end;
 
-function TPascalParser.ParseCommonBlockExpression(CommonBlock: TCommonBlock): TExpression;
+function TPascalParser.ParseCommand(CommonBlock: TCommonBlock): TCommand;
+var
+  Identifier: string;
+  Variable: TVariable;
+  Method: TFunction;
+  First: TOperation;
+  Second: TOperation;
+  StartIndex: Integer;
+  LoopVariable: TVariable;
+  IdentName: string;
+begin
+  if NextCode = 'begin' then begin
+    Result := TBeginEnd.Create;
+    ParseBeginEnd(CommonBlock, TBeginEnd(Result));
+  end else
+  if NextCode = 'if' then begin
+    Result :=  TIfThenElse.Create;
+    ParseIfThenElse(CommonBlock, TIfThenElse(Result));
+  end else
+  if NextCode = 'while' then begin
+    Result := TWhileDo.Create;
+    ParseWhileDo(CommonBlock, TWhileDo(Result));
+  end else
+  if IsIdentificator(NextCode) then begin
+    if Assigned(CommonBlock.Variables.Search(NextCode)) then begin
+      Result := TAssignment.Create;
+      IdentName := ReadCode;
+      TAssignment(Result).Target := CommonBlock.Variables.Search(IdentName);
+      Expect(':=');
+      TAssignment(Result).Source := ParseCommonBlockExpression(CommonBlock);
+    end else
+    if Assigned(CommonBlock.Methods.Search(NextCode)) then begin
+      Result := TMethodCall.Create;
+//      ParseMetVariable(TMethodCall(Result).Target);
+    end;
+  end;
+
+(*    begin
+      Expect('if');
+      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+        Instruction := inConditionalJump;
+        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
+        Negative := True;
+      end;
+      First := Operations[Operations.Count - 1];
+      Expect('then');
+      ParseCommonBlockOperation(CommonBlock);
+      if NextCode = 'else' then begin
+        with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+          Instruction := inJump;
+        end;
+        Second := Operations[Operations.Count - 1];
+        First.GotoAddress := Operations.Count;
+        Expect('else');
+        ParseCommonBlockOperation(CommonBlock);
+        Second.GotoAddress := Operations.Count;
+      end else First.GotoAddress := Operations.Count;
+    end
+    else if NextCode = 'repeat' then begin
+      Expect('repeat');
+      StartIndex := Operations.Count;
+      ParseCommonBlockOperation(CommonBlock);
+      Expect('until');
+      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+        Instruction := inConditionalJump;
+        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
+        GotoAddress := StartIndex;
+      end;
+    end
+    else if NextCode = 'while' then begin
+      Expect('while');
+      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+        Instruction := inConditionalJump;
+        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
+      end;
+      First := Operations[Operations.Count - 1];
+      StartIndex := Operations.Count - 1;
+      Expect('do');
+      ParseCommonBlockOperation(CommonBlock);
+      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+        Instruction := inJump;
+        GotoAddress := StartIndex;
+      end;
+      First.GotoAddress := Operations.Count;
+    end
+    else if NextCode = 'for' then begin
+      Expect('for');
+      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+        Instruction := inExpressionEvaluation;
+        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
+        if (ExpressionTree.NodeType <> ntOperator) and
+          (ExpressionTree.OperatorName <> ':=') then ErrorMessage('Expected assigment in for loop');
+        if TExpression(TExpression(ExpressionTree).SubItems[0]).NodeType <> ntVariable then
+          ErrorMessage('Index in FOR loop have to be variable');
+        LoopVaraible := TExpression(TExpression(ExpressionTree).SubItems[0]).Variable;
+      end;
+      Expect('to');
+      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+        Instruction := inExpressionEvaluation;
+        ExpressionTree := TExpression.Create;
+        with ExpressionTree do begin
+          NodeType := ntOperator;
+          OperatorName := '=';
+          SubItems[0] := TExpression.Create;
+          with TExpression(SubItems[0]) do begin
+            NodeType := ntVariable;
+            Variable := LoopVaraible;
+          end;
+          SubItems[1] := ParseCommonBlockExpression(CommonBlock);
+        end;
+        Negative := True;
+      end;
+      First := Operations[Operations.Count - 1];
+      StartIndex := Operations.Count - 1;
+      Expect('do');
+      ParseCommonBlockOperation(CommonBlock);
+      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+        Instruction := inExpressionEvaluation;
+        ExpressionTree := TExpression.Create;
+        with ExpressionTree do begin
+          NodeType := ntOperator;
+          OperatorName := ':=';
+          SubItems[0] := TExpression.Create;
+          with TExpression(SubItems[0]) do begin
+            NodeType := ntVariable;
+            Variable := LoopVaraible;
+          end;
+          SubItems[1] := TExpression.Create;
+          with TExpression(SubItems[1]) do begin
+            NodeType := ntOperator;
+            OperatorName := '+';
+            SubItems[0] := TExpression.Create;
+            with TExpression(SubItems[0]) do begin
+              NodeType := ntVariable;
+              Variable := LoopVaraible;
+            end;
+            SubItems[1] := TExpression.Create;
+            with TExpression(SubItems[1]) do begin
+              NodeType := ntConstant;
+              //SetLength(Value, 1);
+              //Value[0] := 1;
+              Value := 1;
+            end;
+          end;
+        end;
+      end;
+      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+        Instruction := inJump;
+        GotoAddress := StartIndex;
+      end;
+      First.GotoAddress := Operations.Count;
+    end
+    else begin
+      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
+        Instruction := inExpressionEvaluation;
+        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
+      end;
+    end;
+  *)
+end;
+
+procedure TPascalParser.ParseTypeList(TypeList: TTypeList);
+begin
+  with TypeList do begin
+    Expect('type');
+    while IsIdentificator(NextCode) do
+      with TType(Items[Add(TType.Create)]) do begin
+        Parent := TypeList;
+        ParseType(TType(Items[Count - 1]));
+      end;
+  end;
+end;
+
+procedure TPascalParser.ParseVariableList(VariableList: TVariableList);
+var
+  Identifiers: TStringList;
+  NewValueType: TType;
+  TypeName: string;
+  VariableName: string;
+  Variable: TVariable;
+  I: Integer;
+begin
+  Identifiers := TStringList.Create;
+  with VariableList do begin
+    Expect('var');
+    while IsIdentificator(NextCode) do begin
+      VariableName := ReadCode;
+      Variable := Search(VariableName);
+      if not Assigned(Variable) then begin
+        Identifiers.Add(VariableName);
+        while NextCode = ',' do begin
+          Expect(',');
+          Identifiers.Add(ReadCode);
+        end;
+      end else ErrorMessage('Pøedefinování existující promìnné.');
+      Expect(':');
+      TypeName := ReadCode;
+      NewValueType := Parent.Types.Search(TypeName);
+      if NewValueType = nil then ErrorMessage('Typ ' + TypeName + ' nebyl definován.')
+        else for I := 0 to Identifiers.Count - 1 do
+          with TVariable(Items[Add(TVariable.Create)]) do begin
+            Name := Identifiers[I];
+            ValueType := NewValueType;
+          end;
+      Expect(';');
+    end;
+  end;
+  Identifiers.Destroy;
+end;
+
+procedure TPascalParser.ParseWhileDo(CommonBlock: TCommonBlock; Command: TWhileDo);
+begin
+end;
+
+procedure TPascalParser.ParseVariable(Variable: TVariable);
+begin
+  with Variable do begin
+    Name := NextCode;
+    Expect(':=');
+
+  end;
+end;
+
+procedure TPascalParser.ParseType(AType: TType);
+begin
+  with AType do begin
+    Name := NextCode;
+    Expect('=');
+    UsedType := Parent.Search(NextCode);
+  end;
+end;
+
+{ TParserWhileDo }
+
+procedure TParserWhileDo.Parse(Parser: TPascalParser);
+begin
+  with Parser do begin
+    Expect('while');
+    TParserExpression(Condition).Parse(Parser);
+    Expect('do');
+    TParserCommand(Command).Parse(Parser);
+  end;
+end;
+
+{ TExpression }
+
+procedure TParserExpression.Parse(Parser: TPascalParser);
 var
   Identifier: string;
@@ -455 +797 @@
 end;
 
-procedure TPascalParser.ParseCommonBlockOperation(CommonBlock: TCommonBlock);
-var
-  Identifier: string;
-  Variable: TVariable;
-  Method: TFunction;
-  First: TOperation;
-  Second: TOperation;
-  StartIndex: Integer;
-  LoopVaraible: TVariable;
-begin
-  with CommonBlock do begin
-    if NextCode = 'begin' then ParseCommonBlockProgramCode(CommonBlock)
-    else if NextCode = 'if' then begin
-      Expect('if');
-      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
-        Instruction := inConditionalJump;
-        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
-        Negative := True;
-      end;
-      First := Operations[Operations.Count - 1];
-      Expect('then');
-      ParseCommonBlockOperation(CommonBlock);
-      if NextCode = 'else' then begin
-        with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
-          Instruction := inJump;
-        end;
-        Second := Operations[Operations.Count - 1];
-        First.GotoAddress := Operations.Count;
-        Expect('else');
-        ParseCommonBlockOperation(CommonBlock);
-        Second.GotoAddress := Operations.Count;
-      end else First.GotoAddress := Operations.Count;
-    end
-    else if NextCode = 'repeat' then begin
-      Expect('repeat');
-      StartIndex := Operations.Count;
-      ParseCommonBlockOperation(CommonBlock);
-      Expect('until');
-      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
-        Instruction := inConditionalJump;
-        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
-        GotoAddress := StartIndex;
-      end;
-    end
-    else if NextCode = 'while' then begin
-      Expect('while');
-      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
-        Instruction := inConditionalJump;
-        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
-      end;
-      First := Operations[Operations.Count - 1];
-      StartIndex := Operations.Count - 1;
-      Expect('do');
-      ParseCommonBlockOperation(CommonBlock);
-      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
-        Instruction := inJump;
-        GotoAddress := StartIndex;
-      end;
-      First.GotoAddress := Operations.Count;
-    end
-    else if NextCode = 'for' then begin
-      Expect('for');
-      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
-        Instruction := inExpressionEvaluation;
-        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
-        if (ExpressionTree.NodeType <> ntOperator) and
-          (ExpressionTree.OperatorName <> ':=') then ErrorMessage('Expected assigment in for loop');
-        if TExpression(TExpression(ExpressionTree).SubItems[0]).NodeType <> ntVariable then
-          ErrorMessage('Index in FOR loop have to be variable');
-        LoopVaraible := TExpression(TExpression(ExpressionTree).SubItems[0]).Variable;
-      end;
-      Expect('to');
-      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
-        Instruction := inExpressionEvaluation;
-        ExpressionTree := TExpression.Create;
-        with ExpressionTree do begin
-          NodeType := ntOperator;
-          OperatorName := '=';
-          SubItems[0] := TExpression.Create;
-          with TExpression(SubItems[0]) do begin
-            NodeType := ntVariable;
-            Variable := LoopVaraible;
-          end;
-          SubItems[1] := ParseCommonBlockExpression(CommonBlock);
-        end;
-        Negative := True;
-      end;
-      First := Operations[Operations.Count - 1];
-      StartIndex := Operations.Count - 1;
-      Expect('do');
-      ParseCommonBlockOperation(CommonBlock);
-      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
-        Instruction := inExpressionEvaluation;
-        ExpressionTree := TExpression.Create;
-        with ExpressionTree do begin
-          NodeType := ntOperator;
-          OperatorName := ':=';
-          SubItems[0] := TExpression.Create;
-          with TExpression(SubItems[0]) do begin
-            NodeType := ntVariable;
-            Variable := LoopVaraible;
-          end;
-          SubItems[1] := TExpression.Create;
-          with TExpression(SubItems[1]) do begin
-            NodeType := ntOperator;
-            OperatorName := '+';
-            SubItems[0] := TExpression.Create;
-            with TExpression(SubItems[0]) do begin
-              NodeType := ntVariable;
-              Variable := LoopVaraible;
-            end;
-            SubItems[1] := TExpression.Create;
-            with TExpression(SubItems[1]) do begin
-              NodeType := ntConstant;
-              //SetLength(Value, 1);
-              //Value[0] := 1;
-              Value := 1;
-            end;
-          end;
-        end;
-      end;
-      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
-        Instruction := inJump;
-        GotoAddress := StartIndex;
-      end;
-      First.GotoAddress := Operations.Count;
-    end
-    else begin
-      with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
-        Instruction := inExpressionEvaluation;
-        ExpressionTree := ParseCommonBlockExpression(CommonBlock);
-      end;
-    end;
-  end;
-end;
-
-procedure TPascalParser.ParseCommonBlockProgramCode(CommonBlock: TCommonBlock);
-begin
-  with CommonBlock do begin
-    Expect('begin');
-    while NextCode <> 'end' do begin
-      ParseCommonBlockOperation(CommonBlock);
-      Expect(';');
-    end;
-    Expect('end');
-    with TOperation(Operations[Operations.Add(TOperation.Create)]) do begin
-      Instruction := inReturn;
-    end;
-    CheckReferences;
-  end;
-end;
-
-procedure TPascalParser.ParseTypeList(TypeList: TTypeList);
-begin
-  with TypeList do begin
-    Expect('type');
-    while IsIdentificator(NextCode) do
-      with TType(Items[Add(TType.Create)]) do begin
-        Parent := TypeList;
-        ParseType(TType(Items[Count - 1]));
-      end;
-  end;
-end;
-
-procedure TPascalParser.ParseVariableList(VariableList: TVariableList);
-var
-  Identifiers: TStringList;
-  NewValueType: TType;
-  TypeName: string;
-  VariableName: string;
-  Variable: TVariable;
-  I: Integer;
-begin
-  Identifiers := TStringList.Create;
-  with VariableList do begin
-    Expect('var');
-    while IsIdentificator(NextCode) do begin
-      VariableName := ReadCode;
-      Variable := Search(VariableName);
-      if not Assigned(Variable) then begin
-        Identifiers.Add(VariableName);
-        while NextCode = ',' do begin
-          Expect(',');
-          Identifiers.Add(ReadCode);
-        end;
-      end else ErrorMessage('Pøedefinování existující promìnné.');
-      Expect(':');
-      TypeName := ReadCode;
-      NewValueType := Parent.Types.Search(TypeName);
-      if NewValueType = nil then ErrorMessage('Typ ' + TypeName + ' nebyl definován.')
-        else for I := 0 to Identifiers.Count - 1 do
-          with TVariable(Items[Add(TVariable.Create)]) do begin
-            Name := Identifiers[I];
-            ValueType := NewValueType;
-          end;
-      Expect(';');
-    end;
-  end;
-  Identifiers.Destroy;
-end;
-
-procedure TPascalParser.ParseVariable(Variable: TVariable);
-begin
-end;
-
-procedure TPascalParser.ParseType(AType: TType);
-begin
-  with AType do begin
-    Name := NextCode;
-    Expect('=');
-    UsedType := Parent.Search(NextCode);
-  end;
-end;
-
 end.