Changeset 53 for branches/DelphiToC/Analyze/UParser.pas

Timestamp:

Aug 10, 2010, 10:14:57 AM (14 years ago)

Author:

george

Message:

Project renamed to Transpascal.
Added support for generatin cycle For-to-do.
Added support for parsing and generating structured types as record and array.
Emit procedure in TProducerPascal and TProducerC reworked.

File:

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

branches/DelphiToC/Analyze/UParser.pas

@@ -65 +65 @@
     procedure ParseConstantList(SourceCode: TConstantList);
     procedure ParseTypeList(SourceCode: TTypeList);
-    function ParseType(TypeList: TTypeList): TType;
-    function ParseRecordItem(TypeList: TTypeList): TType;
+    function ParseType(TypeList: TTypeList; ExpectName: Boolean = True; AssignSymbol: string = '='): TType;
   private
   end;
@@ -999 +998 @@
   begin
     Expect('type');
-    while IsIdentificator(FNextToken) do
+    while IsIdentificator(FNextToken) do begin
       NewType := ParseType(SourceCode);
       if Assigned(NewType) then begin
@@ -1005 +1004 @@
         Add(NewType);
       end;
+      Expect(';');
+    end;
   end;
 end;
@@ -1010 +1011 @@
 { TParserType }
 
-function TPascalParser.ParseType(TypeList: TTypeList): TType;
+function TPascalParser.ParseType(TypeList: TTypeList; ExpectName: Boolean = True; AssignSymbol: string = '='): TType;
 var
   Name: string;
-  UsedTypeName: string;
+  TypeName: string;
 begin
   //with SourceCode do
   begin
-    Name := ReadCode;
-    Expect('=');
+    if ExpectName then begin
+      Name := ReadCode;
+      Expect(AssignSymbol);
+    end;
     if FNextToken = 'record' then begin
       Expect('record');
@@ -1026 +1029 @@
       while (FNextToken <> 'end') and (FNextTokenType <> ttEndOfFile) do
       begin
-        TTypeRecord(Result).Items.Add(ParseRecordItem(TypeList));
+        TTypeRecord(Result).Items.Add(ParseType(TypeList, True, ':'));
+        Expect(';');
       end;
       Expect('end');
+    end else
+    if FNextToken = 'array' then begin
+      Expect('array');
+      Result := TTypeArray.Create;
+      TTypeArray(Result).Parent := TypeList;
+      TType(Result).Name := Name;
+      if FNextToken = '[' then begin
+        Expect('[');
+        TypeName := FNextToken;
+        TTypeArray(Result).IndexType := ParseType(TypeList, False);
+        if not Assigned(TTypeArray(Result).IndexType) then
+          ErrorMessage(SUndefinedType, [TypeName]);
+        Expect(']');
+      end;
+      Expect('of');
+      TypeName := FNextToken;
+      TTypeArray(Result).ItemType := ParseType(TypeList, False);
+      if not Assigned(TTypeArray(Result).ItemType) then
+        ErrorMessage(SUndefinedType, [TypeName]);
     end else begin
-      UsedTypeName := ReadCode;
-      Result := TType.Create;
-      TType(Result).Parent := TypeList;
-      TType(Result).Name := Name;
-      TType(Result).UsedType := TypeList.Search(UsedTypeName);
-      if not Assigned(TType(Result).UsedType) then ErrorMessage(SUndefinedType, [UsedTypeName]);
-    end;
-    Expect(';');
-  end;
-end;
-
-function TPascalParser.ParseRecordItem(TypeList: TTypeList): TType;
-var
-  Name: string;
-  UsedTypeName: string;
-begin
-  //with SourceCode do
-  begin
-    Name := ReadCode;
-    Expect(':');
-    if FNextToken = 'record' then begin
-      Expect('record');
-      Result := TTypeRecord.Create;
-      TTypeRecord(Result).Parent := TypeList;
-      TTypeRecord(Result).Name := Name;
-      while (FNextToken <> 'end') and (FNextTokenType <> ttEndOfFile) do
-      begin
-        TTypeRecord(Result).Items.Add(ParseRecordItem(TypeList));
-      end;
-      Expect('end');
-    end else begin
-      UsedTypeName := ReadCode;
-      Result := TType.Create;
-      TType(Result).Parent := TypeList;
-      TType(Result).Name := Name;
-      TType(Result).UsedType := TypeList.Search(UsedTypeName);
-      if not Assigned(TType(Result).UsedType) then ErrorMessage(SUndefinedType, [UsedTypeName]);
-    end;
-    Expect(';');
+      TypeName := ReadCode;
+      if ExpectName then begin
+        Result := TType.Create;
+        TType(Result).Parent := TypeList;
+        TType(Result).Name := Name;
+        TType(Result).UsedType := TypeList.Search(TypeName);
+        if not Assigned(TType(Result).UsedType) then
+          ErrorMessage(SUndefinedType, [TypeName]);
+      end else begin
+        TType(Result) := TypeList.Search(TypeName);
+        if not Assigned(TType(Result)) then
+          ErrorMessage(SUndefinedType, [TypeName]);
+      end;
+    end;
   end;
 end;