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

Timestamp:

Oct 21, 2010, 7:56:25 AM (14 years ago)

Author:

george

Message:

• Modified: Parsing sections in record type.

File:

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

branches/Transpascal/Compiler/Analyze/UPascalParser.pas

@@ -26 +26 @@
     procedure ParseUnitImplementation(SourceCode: TModuleUnit);
     procedure ParseProgram(SourceCode: TModuleProgram);
-    procedure ParseCommonBlock(SourceCode: TCommonBlock; EndSymbol: char = ';');
+    procedure ParseCommonBlock(SourceCode: TCommonBlock; EndSymbol: char = ';';
+      WithBody: Boolean = True);
     procedure ParseCommonBlockInterface(SourceCode: TCommonBlock);
     function ParseCommand(SourceCode: TCommonBlock): TCommand;
@@ -368 +369 @@
 
     ParseCommonBlock(Body, '.');
+    SourceCode.ParentProgram.Modules.Add(SourceCode);
   end;
 end;
@@ -384 +386 @@
   if NextToken = 'implementation' then
     ParseUnitImplementation(SourceCode);
+
+  SourceCode.ParentProgram.Modules.Add(SourceCode);
 
   if NextToken = 'initialization' then begin
@@ -411 +415 @@
     ParseUses(SourceCode.UsedModules, False);
 
-  ParseCommonBlock(SourceCode.Body, '.');
+  ParseCommonBlock(SourceCode.Body, '.', False);
 end;
 
@@ -417 +421 @@
 
 procedure TPascalParser.ParseCommonBlock(SourceCode: TCommonBlock;
-  EndSymbol: char = ';');
+  EndSymbol: char = ';'; WithBody: Boolean = True);
 begin
   with SourceCode do begin
     while (NextToken <> EndSymbol) do begin
-      if NextToken = 'var' then
+      if NextToken = 'var' then begin
+        Expect('var');
         ParseVariableList(Variables)
-      else if NextToken = 'const' then
+      end else
+      if NextToken = 'const' then begin
+        Expect('const');
         ParseConstantList(Constants)
-      else if NextToken = 'type' then
-        ParseTypeList(Types)
-      else if NextToken = 'procedure' then
+      end else
+      if NextToken = 'type' then begin
+        Expect('type');
+        ParseTypeList(Types);
+      end else
+      if NextToken = 'procedure' then
         ParseFunctionList(Functions)
       else if NextToken = 'function' then
         ParseFunctionList(Functions)
       else begin
-        ParseBeginEnd(Code);
+        if WithBody then
+          ParseBeginEnd(Code);
         Break;
       end;
     end;
-    Expect(EndSymbol);
+    if WithBody then Expect(EndSymbol);
   end;
 end;
@@ -444 +455 @@
   with SourceCode do begin
     while (NextToken <> 'implementation') and (NextTokenType <> ttEndOfFile) do begin
-      if NextToken = 'var' then
-        ParseVariableList(Variables)
-      else if NextToken = 'const' then
-        ParseConstantList(Constants, True)
-      else if NextToken = 'type' then
-        ParseTypeList(Types, True)
-      else if NextToken = 'procedure' then
+      if NextToken = 'var' then begin
+        Expect('var');
+        ParseVariableList(Variables);
+      end else
+      if NextToken = 'const' then begin
+        Expect('const');
+        ParseConstantList(Constants, True);
+      end else
+      if NextToken = 'type' then begin
+        Expect('type');
+        ParseTypeList(Types, True);
+      end else
+      if NextToken = 'procedure' then
         ParseFunctionList(Functions, True)
       else if NextToken = 'function' then
@@ -496 +513 @@
   I: integer;
 begin
+  try
   Identifiers := TStringList.Create;
   with SourceCode do begin
     with TFunction(Items[Add(TFunction.Create)]) do begin
       Parent := SourceCode.Parent;
-      if NextToken = 'procedure' then
-      begin
+      if NextToken = 'procedure' then begin
         Expect('procedure');
         HaveResult := False;
-      end
-      else
-      begin
+      end else begin
         Expect('function');
         HaveResult := True;
@@ -545 +560 @@
             end;
           end;
+          if NextToken = ';' then Expect(';');
         end;
         Expect(')');
@@ -580 +596 @@
     if not Exported then ParseCommonBlock(TFunction(Last));
   end;
-  Identifiers.Destroy;
+  finally
+    Identifiers.Free;
+  end;
 end;
 
@@ -638 +656 @@
   Identifiers := TStringList.Create;
   with SourceCode do begin
-    Expect('var');
     while IsIdentificator(NextToken) and (NextTokenType <> ttEndOfFile) do begin
       Identifiers.Clear;
@@ -694 +711 @@
 begin
   Identifiers := TStringList.Create;
-  with SourceCode do
-  begin
-    Expect('const');
-    while IsIdentificator(NextToken) do
-    begin
+  with SourceCode do begin
+    while IsIdentificator(NextToken) do begin
       ConstantName := ReadCode;
       Constant := Search(ConstantName);
-      if not Assigned(Constant) then
-      begin
+      if not Assigned(Constant) then begin
         Identifiers.Add(ConstantName);
-        while NextToken = ',' do
-        begin
+        while NextToken = ',' do begin
           Expect(',');
           Identifiers.Add(ReadCode);
         end;
-      end
-      else
+      end else
         ErrorMessage(SRedefineIdentifier, [ConstantName], -1);
       Expect(':');
@@ -742 +753 @@
   with SourceCode do
   begin
-    Expect('type');
     while IsIdentificator(NextToken) do begin
       NewType := ParseType(SourceCode);
@@ -872 +882 @@
 function TPascalParser.ParseTypeRecord(TypeList: TTypeList; Name: string
   ): TType;
+type
+  TSectionType = (stVar, stType, stConst);
 var
   Visibility: TTypeVisibility;
-begin
+  SectionType: TSectionType;
+begin
+  SectionType := stVar;
   Visibility := tvPublic;
       Expect('record');
       Result := TTypeRecord.Create;
       TTypeRecord(Result).Parent := TypeList;
+      TTypeRecord(Result).CommonBlock.Parent := TypeList.Parent;
       TType(Result).Name := Name;
       while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do
@@ -898 +913 @@
           Visibility := tvProtected;
         end else
-        if NextToken = 'var' then
-          ParseVariableList(TTypeRecord(Result).CommonBlock.Variables)
-        else if NextToken = 'const' then
+        if NextToken = 'var' then begin
+          Expect('var');
+          SectionType := stVar
+        end else
+        if NextToken = 'const' then begin
+          Expect('const');
+          SectionType := stConst
+        end else
+        if NextToken = 'type' then begin
+          Expect('type');
+          SectionType := stType;
+        end;
+
+        if SectionType = stVar then begin
+          if NextToken = 'procedure' then
+            ParseFunctionList(TTypeRecord(Result).CommonBlock.Functions, True)
+          else if NextToken = 'function' then
+            ParseFunctionList(TTypeRecord(Result).CommonBlock.Functions, True)
+          else begin
+            ParseVariableList(TTypeRecord(Result).CommonBlock.Variables, True)
+            //TTypeRecord(Result).CommonBlock.Types.Add(ParseType(TypeList, True, ':'));
+            //TType(TTypeRecord(Result).CommonBlock.Types.Last).Visibility := Visibility;
+          end;                                                                          ParseVariableList(TTypeRecord(Result).CommonBlock.Variables)
+        end
+        else if SectionType = stConst then
           ParseConstantList(TTypeRecord(Result).CommonBlock.Constants, True)
-        else if NextToken = 'type' then
-          ParseTypeList(TTypeRecord(Result).CommonBlock.Types, True)
-        else if NextToken = 'procedure' then
-          ParseFunctionList(TTypeRecord(Result).CommonBlock.Functions, True)
-        else if NextToken = 'function' then
-          ParseFunctionList(TTypeRecord(Result).CommonBlock.Functions, True)
-        else begin
-          TTypeRecord(Result).CommonBlock.Types.Add(ParseType(TypeList, True, ':'));
-          TType(TTypeRecord(Result).CommonBlock.Types.Last).Visibility := Visibility;
-        end;
-        Expect(';');
+        else if SectionType = stType then
+          ParseTypeList(TTypeRecord(Result).CommonBlock.Types, True);
       end;
       Expect('end');