Changeset 68 for branches/Transpascal/Compiler

Timestamp:

Oct 18, 2010, 2:14:52 PM (15 years ago)

Author:

george

Message:

• Modified: Advanced record parsing.

Location:

branches/Transpascal/Compiler

Files:

• Analyze/UParser.pas (modified) (5 diffs)
• Produce/UProducerC.pas (modified) (1 diff)
• Produce/UProducerPascal.pas (modified) (1 diff)
• Produce/UProducerTreeView.pas (modified) (1 diff)
• USourceCode.pas (modified) (4 diffs)

branches/Transpascal/Compiler/Analyze/UParser.pas

@@ -83 +83 @@
     procedure ParseTypeList(SourceCode: TTypeList; Exported: Boolean = False);
     function ParseType(TypeList: TTypeList; ExpectName: Boolean = True; AssignSymbol: string = '='): TType;
+    function ParseTypeEnumeration(TypeList: TTypeList; Name: string): TType;
+    function ParseTypeRecord(TypeList: TTypeList; Name: string): TType;
     property OnGetSource: TGetSourceEvent read FOnGetSource
       write FOnGetSource;
@@ -744 +746 @@
 begin
   with SourceCode do begin
-    while FNextToken <> 'implementation' do begin
+    while (FNextToken <> 'implementation') and (FNextTokenType <> ttEndOfFile) do begin
       if FNextToken = 'var' then
         ParseVariableList(Variables)
@@ -755 +757 @@
       else if FNextToken = 'function' then
         ParseFunctionList(Functions, True)
-      else ErrorMessage(SUnknownIdentifier, [FNextToken]);
+      else begin
+        ErrorMessage(SUnknownIdentifier, [FNextToken]);
+        ReadCode;
+      end;
     end;
   end;
@@ -1071 +1076 @@
     end;
     if NextToken = '(' then begin
-      // Enumeration
-      Expect('(');
-      Result := TTypeEnumeration.Create;
-      TTypeEnumeration(Result).Parent := TypeList;
-      TTypeEnumeration(Result).Name := Name;
-      with TTypeEnumeration(Result) do
-      with TEnumItem(Items[Items.Add(TEnumItem.Create)]) do begin
-        Name := ReadCode;
-        if (NextToken = '=') and (FNextTokenType = ttConstantNumber) then begin
-          Expect('=');
-          Index := StrToInt(ReadCode);
-        end;
-      end;
-      while (NextToken = ',') and (FNextTokenType <> ttEndOfFile) do
-      begin
-        Expect(',');
-        with TTypeEnumeration(Result) do
-        with TEnumItem(Items[Items.Add(TEnumItem.Create)]) do begin
-          Name := ReadCode;
-          if (NextToken = '=') and (FNextTokenType = ttConstantNumber) then begin
-            Expect('=');
-            Index := StrToInt(ReadCode);
-          end;
-        end;
-      end;
-      Expect(')');
+      Result := ParseTypeEnumeration(TypeList, Name);
     end else
     if NextToken = 'record' then begin
-      Expect('record');
-      Result := TTypeRecord.Create;
-      TTypeRecord(Result).Parent := TypeList;
-      TType(Result).Name := Name;
-      while (NextToken <> 'end') and (FNextTokenType <> ttEndOfFile) do
-      begin
-        TTypeRecord(Result).Items.Add(ParseType(TypeList, True, ':'));
-        Expect(';');
-      end;
-      Expect('end');
+      Result := ParseTypeRecord(TypeList, Name);
     end else
     if NextToken = 'class' then begin
@@ -1178 +1149 @@
 end;
 
+function TPascalParser.ParseTypeEnumeration(TypeList: TTypeList; Name: string): TType;
+begin
+      Expect('(');
+      Result := TTypeEnumeration.Create;
+      TTypeEnumeration(Result).Parent := TypeList;
+      TTypeEnumeration(Result).Name := Name;
+      with TTypeEnumeration(Result) do
+      with TEnumItem(Items[Items.Add(TEnumItem.Create)]) do begin
+        Name := ReadCode;
+        if (NextToken = '=') and (FNextTokenType = ttConstantNumber) then begin
+          Expect('=');
+          Index := StrToInt(ReadCode);
+        end;
+      end;
+      while (NextToken = ',') and (FNextTokenType <> ttEndOfFile) do
+      begin
+        Expect(',');
+        with TTypeEnumeration(Result) do
+        with TEnumItem(Items[Items.Add(TEnumItem.Create)]) do begin
+          Name := ReadCode;
+          if (NextToken = '=') and (FNextTokenType = ttConstantNumber) then begin
+            Expect('=');
+            Index := StrToInt(ReadCode);
+          end;
+        end;
+      end;
+      Expect(')');
+end;
+
+function TPascalParser.ParseTypeRecord(TypeList: TTypeList; Name: string
+  ): TType;
+var
+  Visibility: TTypeVisibility;
+begin
+  Visibility := tvPublic;
+      Expect('record');
+      Result := TTypeRecord.Create;
+      TTypeRecord(Result).Parent := TypeList;
+      TType(Result).Name := Name;
+      while (NextToken <> 'end') and (FNextTokenType <> ttEndOfFile) do
+      begin
+        if NextToken = 'public' then begin
+          Expect('public');
+          Visibility := tvPublic;
+        end else
+        if NextToken = 'private' then begin
+          Expect('private');
+          Visibility := tvPrivate;
+        end else
+        if NextToken = 'published' then begin
+          Expect('published');
+          Visibility := tvPublished;
+        end else
+        if NextToken = 'protected' then begin
+          Expect('protected');
+          Visibility := tvProtected;
+        end else
+        if NextToken = 'var' then
+          ParseVariableList(TTypeRecord(Result).CommonBlock.Variables)
+        else if FNextToken = 'const' then
+          ParseConstantList(TTypeRecord(Result).CommonBlock.Constants, True)
+        else if FNextToken = 'type' then
+          ParseTypeList(TTypeRecord(Result).CommonBlock.Types, True)
+        else if FNextToken = 'procedure' then
+          ParseFunctionList(TTypeRecord(Result).CommonBlock.Functions, True)
+        else if FNextToken = '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(';');
+      end;
+      Expect('end');
+end;
+
 constructor TPascalParser.Create;
 begin

branches/Transpascal/Compiler/Produce/UProducerC.pas

@@ -299 +299 @@
     Emit('{');
     Inc(Indetation);
-    for I := 0 to TTypeRecord(AType).Items.Count - 1 do begin
-      GenerateType(TType(TTypeRecord(AType).Items[I]));
+    for I := 0 to TTypeRecord(AType).CommonBlock.Types.Count - 1 do begin
+      GenerateType(TType(TTypeRecord(AType).CommonBlock.Types[I]));
       Emit(';');
     end;

branches/Transpascal/Compiler/Produce/UProducerPascal.pas

@@ -109 +109 @@
     Emit(AType.Name + ' ' + AssignSymbol + ' record');
     Inc(Indetation);
-    for I := 0 to TTypeRecord(AType).Items.Count - 1 do begin
-      GenerateType(TType(TTypeRecord(AType).Items[I]));
+    for I := 0 to TTypeRecord(AType).CommonBlock.Types.Count - 1 do begin
+      GenerateType(TType(TTypeRecord(AType).CommonBlock.Types[I]));
       Emit(';');
     end;

branches/Transpascal/Compiler/Produce/UProducerTreeView.pas

@@ -298 +298 @@
   I: Integer;
 begin
-  if TypeRecord.Items.Count > 0 then begin
-    for I := 0 to TypeRecord.Items.Count - 1 do
-    with TType(TypeRecord.Items[I]) do
+  if TypeRecord.CommonBlock.Types.Count > 0 then begin
+    for I := 0 to TypeRecord.CommonBlock.Types.Count - 1 do
+    with TType(TypeRecord.CommonBlock.Types[I]) do
     if not System then
-      AddNodeType(Node, TType(TypeRecord.Items[I]));
+      AddNodeType(Node, TType(TypeRecord.CommonBlock.Types[I]));
   end;
 end;

branches/Transpascal/Compiler/USourceCode.pas

@@ -15 +15 @@
 
   TNodeType = (ntNone, ntVariable, ntFunction, ntConstant, ntOperator);
+
+  TTypeVisibility = (tvPublic, tvPublished, tvPrivate, tvProtected);
 
   TValue = Variant; //array of Byte;
@@ -156 +158 @@
     Size: Integer;
     UsedType: TType;
+    Visibility: TTypeVisibility;
   end;
 
@@ -162 +165 @@
 
   TTypeRecord = class(TType)
-    Items: TObjectList; // TObjectList<TType>
+    CommonBlock: TCommonBlock;
     constructor Create;
     destructor Destroy; override;
@@ -714 +717 @@
 begin
   inherited;
-  Items := TObjectList.Create;
+  CommonBlock := TCommonBlock.Create;
 end;
 
 destructor TTypeRecord.Destroy;
 begin
-  Items.Free;
+  CommonBlock.Free;
   inherited Destroy;
 end;