Changeset 77 for branches/Transpascal/Compiler/Analyze/UPascalParser.pas

Timestamp:

Oct 22, 2010, 9:22:55 AM (14 years ago)

Author:

george

Message:

• Compiler producer for C language separated to GCC and Dynamic C dialect.
• Enhanced: Parse record functions body.

File:

• branches/Transpascal/Compiler/Analyze/UPascalParser.pas (modified) (8 diffs)

branches/Transpascal/Compiler/Analyze/UPascalParser.pas

@@ -32 +32 @@
     procedure ParseBeginEnd(SourceCode: TBeginEnd);
     procedure ParseFunctionList(SourceCode: TFunctionList; Exported: Boolean = False);
+    procedure ParseFunctionParameters(SourceCode: TFunction);
     procedure ParseIfThenElse(SourceCode: TIfThenElse);
     procedure ParseForToDo(SourceCode: TForToDo);
@@ -58 +59 @@
   SUndefinedConstant = 'Undefined constant "%s".';
   SUnitNotFound = 'Unit "%s" not found.';
+  SFunctionNotDeclared = 'Function "%s" not declared.';
+  SUnknownProcName = 'Unknown proc name "%s".';
 
 
@@ -507 +510 @@
 { TParserParseFunctionList }
 
-procedure TPascalParser.ParseFunctionList(SourceCode: TFunctionList; Exported: Boolean = False);
-var
-  Identifiers: TStringList;
+procedure TPascalParser.ParseFunctionList(SourceCode: TFunctionList;
+  Exported: Boolean = False);
+var
   NewValueType: TType;
   TypeName: string;
+  UseName: string;
+  I: Integer;
+  UseType: TType;
+  UseFunction: TFunction;
+  FunctionType: TFunctionType;
+begin
+  with SourceCode do begin
+    if NextToken = 'procedure' then begin
+      Expect('procedure');
+      FunctionType := ftProcedure;
+    end else
+    if NextToken = 'function' then begin
+      Expect('function');
+      FunctionType := ftFunction;
+    end else
+    if NextToken = 'constructor' then begin
+      Expect('constructor');
+      FunctionType := ftConstructor;
+    end else
+    if NextToken = 'destructor' then begin
+      Expect('destructor');
+      FunctionType := ftDestructor;
+    end else ErrorMessage(SUnknownProcName, [NextToken]);
+
+    // Read function name
+    UseName := ReadCode;
+    UseType := SourceCode.Parent.Types.Search(UseName);
+    if Assigned(UseType) and ((UseType is TTypeRecord) or
+    (UseType is TTypeClass)) then begin
+      Expect('.');
+      UseName := ReadCode;
+      if UseType is TTypeRecord then begin
+        UseFunction := TTypeRecord(UseType).CommonBlock.Functions.Search(UseName);
+        if not Assigned(UseFunction) then begin
+          ErrorMessage(SFunctionNotDeclared, [UseName]);
+          Exit;
+        end;
+      end;
+    end else begin
+      // Create new function
+      UseFunction := TFunction.Create;
+      UseFunction.Parent := SourceCode.Parent;
+      UseFunction.Name := UseName;
+      UseFunction.FunctionType := FunctionType;
+      Add(UseFunction);
+    end;
+    with UseFunction do begin
+      // Parse parameters
+      if NextToken = '(' then
+        ParseFunctionParameters(UseFunction);
+
+      // Parse function result type
+      if FunctionType = ftFunction then begin
+        Expect(':');
+        TypeName := ReadCode;
+        NewValueType := Parent.Types.Search(TypeName);
+        if not Assigned(NewValueType) then
+          ErrorMessage(SUndefinedType, [TypeName], -1);
+(*        else
+          begin
+            ResultType := NewValueType;
+            with TVariable(Parent.Variables.Items[Parent.Variables.Add(
+                TVariable.Create)]) do
+            begin
+              Name := 'Result';
+              ValueType := NewValueType;
+            end;
+          end;  *)
+      end;
+      Expect(';');
+
+      // Check directives
+      if NextToken = 'internal' then begin
+        Expect('internal');
+        Expect(';');
+        Internal := True;
+      end;
+    end;
+
+    if not Exported then ParseCommonBlock(UseFunction);
+//    if UseFunction then UseFunction.Code ;
+  end;
+end;
+
+procedure TPascalParser.ParseFunctionParameters(SourceCode: TFunction);
+var
+  Identifiers: TStringList;
   VariableName: string;
-  Variable: TParameter;
-  I: integer;
-begin
+  UseVariable: TParameter;
+  TypeName: string;
+  UseType: TType;
+  I: Integer;
+begin
+  with SourceCode do
   try
-  Identifiers := TStringList.Create;
-  with SourceCode do begin
-    with TFunction(Items[Add(TFunction.Create)]) do begin
-      Parent := SourceCode.Parent;
-      if NextToken = 'procedure' then begin
-        Expect('procedure');
-        HaveResult := False;
-      end else begin
-        Expect('function');
-        HaveResult := True;
-      end;
-      Name := ReadCode;
-
-      if NextToken = '(' then begin
+    Identifiers := TStringList.Create;
         Expect('(');
         while NextToken <> ')' do begin
@@ -540 +620 @@
             if VariableName = 'const' then begin
             end else begin
-              Variable := Search(VariableName);
-              if not Assigned(Variable) then begin
+              UseVariable := Search(VariableName);
+              if not Assigned(UseVariable) then begin
                 Identifiers.Add(VariableName);
                 while NextToken = ',' do begin
@@ -551 +631 @@
               Expect(':');
               TypeName := ReadCode;
-              NewValueType := Parent.Types.Search(TypeName);
-              if not Assigned(NewValueType) then
+              UseType := Parent.Types.Search(TypeName);
+              if not Assigned(UseType) then
                 ErrorMessage(SUndefinedType, [TypeName], -1)
               else
@@ -559 +639 @@
                   begin
                     Name := Identifiers[I];
-                    ValueType := NewValueType;
+                    ValueType := UseType;
                   end;
             end;
@@ -566 +646 @@
         end;
         Expect(')');
-
-        // Parse function result type
-        if HaveResult then begin
-          Expect(':');
-          TypeName := ReadCode;
-          NewValueType := Parent.Types.Search(TypeName);
-          if not Assigned(NewValueType) then
-            ErrorMessage(SUndefinedType, [TypeName], -1);
-(*          else
-          begin
-            ResultType := NewValueType;
-            with TVariable(Parent.Variables.Items[Parent.Variables.Add(
-                TVariable.Create)]) do
-            begin
-              Name := 'Result';
-              ValueType := NewValueType;
-            end;
-          end;  *)
-        end;
-      end;
-      Expect(';');
-
-      // Check directives
-      if NextToken = 'internal' then begin
-        Expect('internal');
-        Expect(';');
-        System := True;
-      end;
-    end;
-
-    if not Exported then ParseCommonBlock(TFunction(Last));
-  end;
   finally
     Identifiers.Free;
@@ -924 +972 @@
     if NextToken = 'var' then begin
       Expect('var');
-      SectionType := stVar
+      SectionType := stVar;
     end else
     if NextToken = 'const' then begin
       Expect('const');
-      SectionType := stConst
+      SectionType := stConst;
     end else
     if NextToken = 'type' then begin