Changeset 4 for trunk/Compiler

Timestamp:

Nov 5, 2010, 7:24:45 AM (14 years ago)

Author:

george

Message:

• Modified: Reorganize parser code to use logical separated functions.

Location:

trunk/Compiler

Files:

• Analyze/UParser.pas (modified) (1 diff)
• Analyze/UPascalParser.pas (modified) (14 diffs)
• USourceCode.pas (modified) (4 diffs)

trunk/Compiler/Analyze/UParser.pas

@@ -87 +87 @@
     FOnErrorMessage(Format(Text, Arguments),
       TToken(Tokens[TokenIndex + TokenOffset]).CodePosition, FileName);
+    Log('Error: ' + Format(Text, Arguments));
   end;
 end;

trunk/Compiler/Analyze/UPascalParser.pas

@@ -19 +19 @@
     function ParseFile(Name: string): Boolean;
     function ParseWhileDo(var WhileDo: TWhileDo; SourceCode: TCommonBlock): Boolean;
-    procedure ParseExpression(SourceCode: TExpression);
-    function ParseRightValue(SourceCode: TExpression): TObject;
-    function ParseFunctionCall(SourceCode: TExpression): TObject;
+    function ParseExpression(SourceCode: TExpression): Boolean;
+    function ParseExpressionParenthases(SourceCode: TExpression;
+      Expressions: TListExpression): Boolean;
+    function ParseExpressionOperator(SourceCode: TExpression;
+      Expressions: TListExpression): Boolean;
+    function ParseExpressionRightValue(SourceCode: TExpression;
+      Expressions: TListExpression): Boolean;
+    function ParseExpressionFunctionCall(SourceCode: TExpression;
+      Expressions: TListExpression; var Func: TFunction): Boolean;
     function ParseUses(SourceCode: TUsedModuleList; AExported: Boolean): Boolean;
     function ParseModule(ProgramCode: TProgram): TModule;
@@ -37 +43 @@
     function ParseIfThenElse(var IfThenElse: TIfThenElse; SourceCode: TCommonBlock): Boolean;
     function ParseForToDo(var ForToDo: TForToDo; SourceCode: TCommonBlock): Boolean;
+    function ParseAssigment(var Assignment: TAssignment; SourceCode: TCommonBlock): Boolean;
+    function ParseFunctionCall(var Call: TFunctionCall; SourceCode: TCommonBlock): Boolean;
     function ParseVariableList(SourceCode: TVariableList; Exported: Boolean = False): Boolean;
     procedure ParseVariable(SourceCode: TVariableList; Exported: Boolean = False);
@@ -43 +51 @@
     function ParseTypeList(SourceCode: TTypeList; Exported: Boolean = False;
       AssignSymbol: string = '='): Boolean;
-    function ParseType(TypeList: TTypeList; ExpectName: Boolean = True; AssignSymbol: string = '='): TType;
-    function ParseTypeSubType(TypeList: TTypeList; Name: string; ExpectName: Boolean): TType;
+    function ParseType(TypeList: TTypeList; ExpectName: Boolean = True;
+      AssignSymbol: string = '='; ForwardDeclaration: Boolean = False): TType;
+    function ParseTypeSubType(TypeList: TTypeList; Name: string;
+      ExpectName: Boolean; ForwardDeclaration: Boolean): TType;
     function ParseTypeBase(TypeList: TTypeList; Name: string): TType;
     function ParseTypePointer(TypeList: TTypeList; Name: string): TType;
@@ -125 +135 @@
 { TExpression }
 
-procedure TPascalParser.ParseExpression(SourceCode: TExpression);
-var
-  Identifier: string;
-  IdentifierType: TTokenType;
+function TPascalParser.ParseExpression(SourceCode: TExpression): Boolean;
+var
   NewVariable: TVariable;
   NewExpression: TExpression;
@@ -135 +143 @@
   UseType: TType;
   //  Brackets: Integer;
-  Expressions: TExpressionList;
+  Expressions: TListExpression;
   I: integer;
   II: integer;
-  RightValue: TObject;
-begin
-  Expressions := TExpressionList.Create;
-  Expressions.Add(TExpression.Create);
-  with SourceCode do begin
-    while ((NextToken <> ';') and (NextToken <> ',') and (not IsKeyWord(NextToken))) and not
-      (((NextToken = ')') or (NextToken = ']'))) and not (NextTokenType = ttEndOfFile) do begin
-      IdentifierType := NextTokenType;
-      if NextToken = '(' then begin
-        Expect('(');
-        // Subexpression
-        with TExpression(Expressions.Last) do begin
-          SubItems[1] := TExpression.Create;
-          TExpression(SubItems[1]).CommonBlock := SourceCode.CommonBlock;
-          ParseExpression(TExpression(SubItems[1]));
-        end;
-        with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do
-        begin
-          CommonBlock := SourceCode.CommonBlock;
-          SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
-        end;
-        Expect(')');
-      end else
-      if IsOperator(NextToken) then begin
-        // Operator
-        TExpression(Expressions.Last).OperatorName := ReadToken;
-        TExpression(Expressions.Last).NodeType := ntOperator;
-      end else begin
-        RightValue := ParseRightValue(SourceCode);
-        if Assigned(RightValue) then begin
-          with TExpression(Expressions.Last) do begin
-            SubItems[1] := TExpression.Create;
-            TExpression(SubItems[1]).CommonBlock := SourceCode.CommonBlock;
-            if RightValue is TVariable then begin
-              TExpression(SubItems[1]).NodeType := ntVariable;
-              TExpression(SubItems[1]).Variable := TVariable(RightValue);
-            end;
-            if RightValue is TConstant then begin
-              TExpression(SubItems[1]).NodeType := ntConstant;
-              TExpression(SubItems[1]).Constant := TConstant(RightValue);
-            end;
-            if RightValue is TFunctionCall then begin
-              TExpression(SubItems[1]).NodeType := ntFunction;
-              TExpression(SubItems[1]).FunctionCall := TFunction(RightValue);
-            end;
-          end;
-          with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do
-          begin
-            CommonBlock := SourceCode.CommonBlock;
-            SubItems[0] := TExpression(Expressions[Expressions.Count - 2]).SubItems[1];
-          end;
-        end else begin
+begin
+  try
+    Expressions := TListExpression.Create;
+    Expressions.Add(TExpression.Create);
+    with SourceCode do begin
+      while ((NextToken <> ';') and (NextToken <> ',') and (not IsKeyWord(NextToken))) and not
+        (((NextToken = ')') or (NextToken = ']'))) and not (NextTokenType = ttEndOfFile) do begin
+        if not ParseExpressionParenthases(SourceCode, Expressions) then
+        if not ParseExpressionOperator(SourceCode, Expressions) then
+        if not ParseExpressionRightValue(SourceCode, Expressions) then begin
           ErrorMessage(SInvalidAssignmentValue, [NextToken]);
           ReadToken;
         end;
       end;
-    end;
-
-    // Build expression tree
-    for II := 0 to High(Operators) do begin
-      I := 1;
-      while (I < Expressions.Count - 1) do begin
-        if not TExpression(Expressions[I]).Associated and
-          (TExpression(Expressions[I]).OperatorName = Operators[II]) then
-        begin
-          TExpression(Expressions[I]).Associated := True;
-          TExpression(Expressions[I - 1]).SubItems[1] := Expressions[I];
-          TExpression(Expressions[I + 1]).SubItems[0] := Expressions[I];
-          //Expressions.Delete(I);
-        end else Inc(I);
-      end;
-    end;
-    if Assigned(TExpression(Expressions.First).SubItems[1]) then
-      Assign(TExpression(TExpression(Expressions.First).SubItems[1]));
-    TExpression(Expressions.First).SubItems[1] := nil;
-    //ShowMessage(IntToStr(Expressions.Count));
-    if Expressions.Count > 1 then
-      TExpression(Expressions[1]).SubItems[0] := nil;
+
+      // Build expression tree using operator precedence
+      for II := 0 to High(Operators) do begin
+        I := 1;
+        while (I < Expressions.Count - 1) do begin
+          if not Expressions[I].Associated and
+            (Expressions[I].OperatorName = Operators[II]) then
+          begin
+            Expressions[I].Associated := True;
+            Expressions[I - 1].SubItems.Last := Expressions[I];
+            Expressions[I + 1].SubItems.First := Expressions[I];
+            //Expressions.Delete(I);
+          end else Inc(I);
+        end;
+      end;
+      if Assigned(Expressions.First.SubItems.Last) then
+        Assign(Expressions.First.SubItems.Last);
+      Expressions.First.SubItems.Last := nil;
+      //ShowMessage(IntToStr(Expressions.Count));
+      if Expressions.Count > 1 then
+        Expressions[1].SubItems.First := nil;
+    end;
+  finally
     Expressions.Free;
   end;
 end;
 
-function TPascalParser.ParseRightValue(SourceCode: TExpression): TObject;
+function TPascalParser.ParseExpressionParenthases(SourceCode: TExpression;
+  Expressions: TListExpression): Boolean;
+var
+  NewExpression: TExpression;
+begin
+  if NextToken = '(' then begin
+    Expect('(');
+    // Subexpression
+    NewExpression := TExpression.Create;
+    NewExpression.CommonBlock := SourceCode.CommonBlock;
+    ParseExpression(NewExpression);
+
+    Expressions.Last.SubItems.Last := NewExpression;
+    with Expressions.Items[Expressions.Add(TExpression.Create)] do
+    begin
+      CommonBlock := SourceCode.CommonBlock;
+      SubItems.First := NewExpression;
+    end;
+    Expect(')');
+    Result := True;
+  end else Result := False;
+end;
+
+function TPascalParser.ParseExpressionOperator(SourceCode: TExpression;
+  Expressions: TListExpression): Boolean;
+begin
+  if IsOperator(NextToken) then begin
+    // Operator
+    Expressions.Last.OperatorName := ReadToken;
+    Expressions.Last.NodeType := ntOperator;
+    Result := True;
+  end else Result := False;
+end;
+
+function TPascalParser.ParseExpressionRightValue(SourceCode: TExpression;
+  Expressions: TListExpression): Boolean;
 var
   UseType: TType;
@@ -226 +228 @@
   UseConstant: TConstant;
   UseFunction: TFunction;
+  NewExpression: TExpression;
   Identifier: string;
-begin
-  Result := nil;
+  O: TObject;
+begin
+  O := nil;
   with SourceCode do
   if IsIdentificator(NextToken) then begin
@@ -240 +244 @@
         UseVariable := TTypeRecord(UseType).CommonBlock.Variables.Search(Identifier);
         if Assigned(UseVariable) then begin
-          Result := UseVariable;
-        end;
-        if not Assigned(Result) then begin
+          O := UseVariable;
+        end;
+        if not Assigned(O) then begin
           UseFunction := TTypeRecord(UseType).CommonBlock.Functions.Search(Identifier);
           if Assigned(UseFunction) then begin
-            Result := UseFunction;
+            O := UseFunction;
           end;
         end;
-        if not Assigned(Result) then
+        if not Assigned(O) then
           ErrorMessage(SUndefinedVariable, [Identifier]);
       end else ErrorMessage(SIllegalExpression, [Identifier]);
     end;
-    if not Assigned(Result) then begin
+    if not Assigned(O) then begin
       UseVariable := CommonBlock.Variables.Search(Identifier);
       if Assigned(UseVariable) then begin
         // Referenced variable
         ReadToken;
-        Result := UseVariable;
-      end;
-    end;
-    if not Assigned(Result) then begin
-      Result := ParseFunctionCall(SourceCode);
-    end;
-    if not Assigned(Result) then begin
+        NewExpression := TExpression.Create;
+        NewExpression.CommonBlock := SourceCode.CommonBlock;
+        NewExpression.NodeType := ntVariable;
+        NewExpression.Variable := TVariable(UseVariable);
+        SubItems.Last := NewExpression;
+      end;
+    end;
+    if not Assigned(O) then begin
+      ParseExpressionFunctionCall(SourceCode, Expressions, TFunction(O));
+      NewExpression := TExpression.Create;
+      NewExpression.CommonBlock := SourceCode.CommonBlock;
+      NewExpression.NodeType := ntFunction;
+      NewExpression.FunctionCall := TFunction(O);
+      SubItems.Last := NewExpression;
+    end;
+    if not Assigned(O) then begin
       UseConstant := CommonBlock.Constants.Search(NextToken);
       if Assigned(UseConstant) then begin
         ReadToken;
-        Result := UseConstant;
-      end;
-    end;
-    if not Assigned(Result) then begin
+        O := UseConstant;
+        NewExpression := TExpression.Create;
+        NewExpression.CommonBlock := SourceCode.CommonBlock;
+        NewExpression.NodeType := ntConstant;
+        NewExpression.Constant := TConstant(O);
+        SubItems.Last := NewExpression;
+      end;
+    end;
+    if not Assigned(O) then begin
       // Constant value
-      Result := TConstant.Create;
-      TConstant(Result).Value := ReadToken;
-    end;
-    if not Assigned(Result) then begin
+      O := TConstant.Create;
+      TConstant(O).Value := ReadToken;
+      NewExpression := TExpression.Create;
+      NewExpression.CommonBlock := SourceCode.CommonBlock;
+      NewExpression.NodeType := ntConstant;
+      NewExpression.Constant := TConstant(O);
+      SubItems.Last := NewExpression;
+    end;
+    if not Assigned(O) then begin
       ErrorMessage(SUnknownIdentifier, [ReadToken]);
     end;
-  end else Result := nil;
-end;
-
-function TPascalParser.ParseFunctionCall(SourceCode: TExpression): TObject;
+
+    with Expressions.Items[Expressions.Add(TExpression.Create)] do
+    begin
+      CommonBlock := SourceCode.CommonBlock;
+      SubItems.First := NewExpression;
+    end;
+    Result := True;
+  end else Result := False;
+end;
+
+function TPascalParser.ParseExpressionFunctionCall(SourceCode: TExpression;
+  Expressions: TListExpression; var Func: TFunction): Boolean;
 var
   UseFunction: TFunction;
 begin
-  Result := nil;
+  Func := nil;
   with SourceCode do begin
     UseFunction := CommonBlock.Functions.Search(NextToken);
     if Assigned(UseFunction) then begin
       ReadToken;
-      Result := UseFunction;
+      Func := UseFunction;
       if NextToken = '(' then begin
         Expect('(');
@@ -298 +329 @@
         end;
       end;
-    end;
+      Result := True;
+    end else Result := False;
   end;
 end;
@@ -319 +351 @@
     if not ParseWhileDo(TWhileDo(Result), SourceCode) then
     if not ParseForToDo(TForToDo(Result), SourceCode) then
-    if IsIdentificator(NextToken) then begin
-      if Assigned(SourceCode.Variables.Search(NextToken)) then begin
-        // Variable assignment
-        Result := TAssignment.Create;
-        TAssignment(Result).CommonBlock := SourceCode;
-        IdentName := ReadToken;
-        TAssignment(Result).Target := SourceCode.Variables.Search(IdentName);
-        Expect(':=');
-        TAssignment(Result).Source := TExpression.Create;
-        TAssignment(Result).Source.CommonBlock := SourceCode;
-        ParseExpression(TAssignment(Result).Source);
-      end else
-      if Assigned(SourceCode.Functions.Search(NextToken)) then begin
-        // Function call
-        FunctionName := ReadToken;
-        Result := TFunctionCall.Create;
-        TFunctionCall(Result).CommonBlock := SourceCode;
-        TFunctionCall(Result).FunctionRef := SourceCode.Functions.Search(FunctionName);
-        if NextToken = '(' then
-        begin
-          Expect('(');
-          with TFunctionCall(Result) do
-          begin
-            ParameterExpression.Add(TExpression.Create);
-            TExpression(ParameterExpression.Last).CommonBlock := SourceCode;
-            ParseExpression(TExpression(ParameterExpression.Last));
-          end;
-          Expect(')');
-        end;
-      end else begin
-        Result := nil;
-        ErrorMessage(SUnknownIdentifier, [ReadToken], -1);
-      end;
-    end else
+    if not ParseAssigment(TAssignment(Result), SourceCode) then
+    if not ParseFunctionCall(TFunctionCall(Result), SourceCode) then
     if NextToken = ';' then
       Result := nil
@@ -726 +726 @@
 end;
 
+function TPascalParser.ParseAssigment(var Assignment: TAssignment;
+  SourceCode: TCommonBlock): Boolean;
+var
+  Variable: TVariable;
+  IdentName: string;
+begin
+  if IsIdentificator(NextToken) then begin
+    Variable := SourceCode.Variables.Search(NextToken);
+    if Assigned(Variable) then begin
+      // Variable assignment
+      Assignment := TAssignment.Create;
+      Assignment.CommonBlock := SourceCode;
+      IdentName := ReadToken;
+      Assignment.Target := SourceCode.Variables.Search(IdentName);
+      Expect(':=');
+      Assignment.Source := TExpression.Create;
+      Assignment.Source.CommonBlock := SourceCode;
+      ParseExpression(Assignment.Source);
+      Result := True;
+    end else Result := False;
+  end else Result := False;
+end;
+
+function TPascalParser.ParseFunctionCall(var Call: TFunctionCall;
+  SourceCode: TCommonBlock): Boolean;
+var
+  FunctionName: string;
+begin
+  if IsIdentificator(NextToken) then begin
+    if Assigned(SourceCode.Functions.Search(NextToken)) then begin
+      // Function call
+      FunctionName := ReadToken;
+      Call := TFunctionCall.Create;
+      Call.CommonBlock := SourceCode;
+      Call.FunctionRef := SourceCode.Functions.Search(FunctionName);
+      if NextToken = '(' then begin
+        Expect('(');
+        with Call do begin
+          ParameterExpression.Add(TExpression.Create);
+          ParameterExpression.Last.CommonBlock := SourceCode;
+          ParseExpression(ParameterExpression.Last);
+        end;
+        Expect(')');
+      end;
+      Result := True;
+    end else Result := False;
+  end else Result := False;
+end;
+
 { TParserVariableList }
 
@@ -877 +926 @@
 
 function TPascalParser.ParseType(TypeList: TTypeList; ExpectName: Boolean = True;
-  AssignSymbol: string = '='): TType;
+  AssignSymbol: string = '='; ForwardDeclaration: Boolean = False): TType;
 var
   Name: string;
@@ -894 +943 @@
     if not Assigned(Result) then Result := ParseTypePointer(TypeList, Name);
     if not Assigned(Result) then Result := ParseTypeBase(TypeList, Name);
-    if not Assigned(Result) then Result := ParseTypeSubType(TypeList, Name, ExpectName);
+    if not Assigned(Result) then Result := ParseTypeSubType(TypeList, Name,
+      ExpectName, ForwardDeclaration);
     if not Assigned(Result) then Result := ParseTypeSubRange(TypeList, Name);
-    if not Assigned(Result) then
+    if not Assigned(Result) then begin
       ErrorMessage(SInvalidConstruction, []);
+    end;
   end;
 end;
 
 function TPascalParser.ParseTypeSubType(TypeList: TTypeList; Name: string;
-  ExpectName: Boolean): TType;
+  ExpectName: Boolean; ForwardDeclaration: Boolean): TType;
 var
   TypeName: string;
@@ -918 +969 @@
     end else begin
       TType(Result) := TypeList.Search(TypeName);
-      if not Assigned(TType(Result)) then
-        ErrorMessage(SUndefinedType, [TypeName], -1);
+      if not Assigned(TType(Result)) then begin
+        if ForwardDeclaration then begin
+          // ForwardDeclaration
+          Result := TType.Create;
+          TType(Result).Parent := TypeList;
+          TType(Result).Name := TypeName;
+          TType(Result).UsedType := nil;
+        end else
+          ErrorMessage(SUndefinedType, [TypeName], -1);
+      end;
     end;
   end else Result := nil;
@@ -948 +1007 @@
     TTypePointer(Result).Parent := TypeList;
     TTypePointer(Result).Name := Name;
-    TTypePointer(Result).UsedType := ParseType(TypeList, False);
+    TTypePointer(Result).UsedType := ParseType(TypeList, False, '=', True);
   end else Result := nil;
 end;

trunk/Compiler/USourceCode.pas

@@ -25 +25 @@
   TVariableList = class;
   TFunctionList = class;
-  TExpressionList = class;
+  TListExpression = class;
   TExpression = class;
   TFunction = class;
@@ -331 +331 @@
     Value: TValue;
     OperatorName: string;
-    SubItems: TExpressionList;
+    SubItems: TListExpression;
     Associated: Boolean;
     constructor Create;
     destructor Destroy; override;
     procedure Assign(Source: TExpression);
-  end;
-
-  TExpressionList = class(TListExpression)
-    destructor Destroy; override;
   end;
 
@@ -789 +785 @@
 constructor TExpression.Create;
 begin
-  SubItems := TExpressionList.Create;
+  SubItems := TListExpression.Create;
   SubItems.Count := 2;
   SubItems.OwnsObjects := False;
@@ -810 +806 @@
   Variable := Source.Variable;
   SubItems.Assign(Source.SubItems);
-end;
-
-{ TExpressionList }
-
-destructor TExpressionList.Destroy;
-begin
-  inherited;
 end;