Changeset 65 for branches/Transpascal/Compiler/Analyze/UParser.pas

Timestamp:

Oct 18, 2010, 8:53:48 AM (14 years ago)

Author:

george

Message:

Added: Base parsing of class, pointer and enumeration.

File:

• branches/Transpascal/Compiler/Analyze/UParser.pas (modified) (5 diffs)

branches/Transpascal/Compiler/Analyze/UParser.pas

@@ -35 +35 @@
     procedure GetNextToken;
     function ReadCode: string;
+    function NextToken: string;
     procedure Expect(Code: string);
     function IsWhiteSpace(Character: char): boolean;
@@ -345 +346 @@
   GetNextToken;
   Log('Read: ' + Result);
+end;
+
+function TBaseParser.NextToken: string;
+begin
+  Result := FNextToken;
 end;
 
@@ -1064 +1070 @@
       Expect(AssignSymbol);
     end;
-    if FNextToken = 'record' then begin
+    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(')');
+    end else
+    if NextToken = 'record' then begin
       Expect('record');
       Result := TTypeRecord.Create;
       TTypeRecord(Result).Parent := TypeList;
       TType(Result).Name := Name;
-      while (FNextToken <> 'end') and (FNextTokenType <> ttEndOfFile) do
+      while (NextToken <> 'end') and (FNextTokenType <> ttEndOfFile) do
       begin
         TTypeRecord(Result).Items.Add(ParseType(TypeList, True, ':'));
@@ -1076 +1110 @@
       Expect('end');
     end else
-    if FNextToken = 'array' then begin
+    if NextToken = 'class' then begin
+      Expect('class');
+      Result := TTypeClass.Create;
+      TTypeClass(Result).Parent := TypeList;
+      TTypeClass(Result).Name := Name;
+      if NextToken <> ';' then begin
+        while (NextToken <> 'end') and (FNextTokenType <> ttEndOfFile) do
+        begin
+          TTypeClass(Result).Items.Add(ParseType(TypeList, True, ':'));
+          Expect(';');
+        end;
+        Expect('end');
+      end;
+    end else
+    if NextToken = 'array' then begin
       Expect('array');
       Result := TTypeArray.Create;
       TTypeArray(Result).Parent := TypeList;
       TType(Result).Name := Name;
-      if FNextToken = '[' then begin
+      if NextToken = '[' then begin
         Expect('[');
         TypeName := FNextToken;
@@ -1094 +1142 @@
       if not Assigned(TTypeArray(Result).ItemType) then
         ErrorMessage(SUndefinedType, [TypeName]);
+    end else
+    if NextToken = '^' then begin
+      Expect('^');
+      Result := TTypePointer.Create;
+      TTypePointer(Result).Parent := TypeList;
+      TTypePointer(Result).Name := Name;
+      TTypePointer(Result).UsedType := ParseType(TypeList, False);
+    end else
+    if NextToken = 'type' then begin
+      Expect('type');
+      Result := TTypeInherited.Create;
+      TTypeInherited(Result).Parent := TypeList;
+      TTypeInherited(Result).Name := Name;
+      if NextToken = '(' then begin
+        Expect('(');
+        TTypeInherited(Result).UsedType := ParseType(TypeList, False);
+        Expect(')');
+      end else TTypeInherited(Result).UsedType := nil;
     end else begin
       TypeName := ReadCode;
-      if TypeName = 'internal' then begin
-        Result := TType.Create;
-        TType(Result).Parent := TypeList;
-        TType(Result).Name := Name;
-        TType(Result).UsedType := nil;
-      end else
       if ExpectName then begin
         Result := TType.Create;