Changeset 26 for trunk/Compiler/Analyze

Timestamp:

Dec 8, 2010, 10:00:30 AM (14 years ago)

Author:

george

Message:

• Removed: Generic template usage form project code. Replaced by TListObject descendants.

Location:

trunk/Compiler/Analyze

Files:

• UAnalyzer.pas (modified) (3 diffs)
• UAnalyzerPascal.pas (modified) (8 diffs)

trunk/Compiler/Analyze/UAnalyzer.pas

@@ -8 +8 @@
 uses
   SysUtils, Variants, Classes, Contnrs,
-  Dialogs, USourceCode, FileUtil;
+  Dialogs, USourceCode, FileUtil, SpecializedObjectList;
 
 type
@@ -82 +82 @@
 
   // TListAnalyzer = TGObjectList<Integer, TAnalyzer>
-  {$DEFINE TGObjectListIndex := Integer}
-  {$DEFINE TGObjectListItem := TAnalyzer}
-  {$DEFINE TGObjectListList := TObjectListAnalyzer}
-  {$DEFINE TGObjectList := TListAnalyzer}
-  {$DEFINE TGObjectListSortCompare := TObjectListSortCompareAnalyzer}
-  {$DEFINE TGObjectListStringConverter := TObjectListStringConverterAnalyzer}
-  {$DEFINE INTERFACE}
-  {$I 'GenericObjectList.inc'}
+  TListAnalyzer = class(TListObject);
 
 resourcestring
@@ -95 +88 @@
 
 implementation
-
-{$DEFINE IMPLEMENTATION_USES}
-{$I 'GenericObjectList.inc'}
-
-// TListAnalyzer = TGObjectList<Integer, TAnalyzer>
-{$DEFINE TGObjectListIndex := Integer}
-{$DEFINE TGObjectListItem := TAnalyzer}
-{$DEFINE TGObjectListList := TObjectListAnalyzer}
-{$DEFINE TGObjectList := TListAnalyzer}
-{$DEFINE TGObjectListSortCompare := TObjectListSortCompareAnalyzer}
-{$DEFINE TGObjectListStringConverter := TObjectListStringConverterAnalyzer}
-{$DEFINE IMPLEMENTATION}
-{$I 'GenericObjectList.inc'}
 
 { TAnalyzer }

trunk/Compiler/Analyze/UAnalyzerPascal.pas

@@ -156 +156 @@
         I := 1;
         while (I < Expressions.Count - 1) do begin
-          if not Expressions[I].Associated and
-            (Expressions[I].OperatorName = Operators[II]) then
+          if not TExpression(Expressions[I]).Associated and
+            (TExpression(Expressions[I]).OperatorName = Operators[II]) then
           begin
-            Expressions[I].Associated := True;
-            Expressions[I - 1].SubItems.Last := Expressions[I];
-            Expressions[I + 1].SubItems.First := Expressions[I];
+            TExpression(Expressions[I]).Associated := True;
+            TExpression(Expressions[I - 1]).SubItems.Last := Expressions[I];
+            TExpression(Expressions[I + 1]).SubItems.First := Expressions[I];
             Expressions.Delete(I);
           end else Inc(I);
         end;
       end;
-      if Assigned(Expressions.First.SubItems.Last) then
-        Assign(Expressions.First.SubItems.Last);
-      Expressions.First.SubItems.Last := nil;
+      if Assigned(TExpression(Expressions.First).SubItems.Last) then
+        Assign(TExpression(TExpression(Expressions.First).SubItems.Last));
+      TExpression(Expressions.First).SubItems.Last := nil;
       //ShowMessage(IntToStr(Expressions.Count));
       if Expressions.Count > 1 then
-        Expressions[1].SubItems.First := nil;
+        TExpression(Expressions[1]).SubItems.First := nil;
     end;
   finally
@@ -191 +191 @@
     ParseExpression(NewExpression);
 
-    Expressions.Last.SubItems.Last := NewExpression;
-    with Expressions.Items[Expressions.Add(TExpression.Create)] do
+    TExpression(Expressions.Last).SubItems.Last := NewExpression;
+    with TExpression(Expressions.Items[Expressions.Add(TExpression.Create)]) do
     begin
       CommonBlock := SourceCode.CommonBlock;
@@ -207 +207 @@
   if IsOperator(NextToken) then begin
     // Operator
-    Expressions.Last.OperatorName := ReadToken;
-    Expressions.Last.NodeType := ntOperator;
+    TExpression(Expressions.Last).OperatorName := ReadToken;
+    TExpression(Expressions.Last).NodeType := ntOperator;
     Result := True;
   end else Result := False;
@@ -320 +320 @@
     end;
     if Assigned(NewExpression) then begin
-      Expressions.Last.SubItems.Last := NewExpression;
+      TExpression(Expressions.Last).SubItems.Last := NewExpression;
       with Expressions.Items[Expressions.Add(TExpression.Create)] do
       begin
@@ -672 +672 @@
       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 else
+      if UseType is TTypeClass then begin
+        UseFunction := TTypeClass(UseType).CommonBlock.Functions.Search(UseName);
         if not Assigned(UseFunction) then begin
           ErrorMessage(SFunctionNotDeclared, [UseName]);
@@ -880 +887 @@
         with Call do begin
           ParameterExpression.Add(TExpression.Create);
-          ParameterExpression.Last.CommonBlock := SourceCode;
-          ParseExpression(ParameterExpression.Last);
+          TExpression(ParameterExpression.Last).CommonBlock := SourceCode;
+          ParseExpression(TExpression(ParameterExpression.Last));
         end;
         Expect(')');
@@ -1246 +1253 @@
   ): Boolean;
 var
+  Visibility: TTypeVisibility;
+  SectionType: TCommonBlockSection;
   NewType2: TType;
   TempType: TType;
@@ -1251 +1260 @@
   if NextToken = 'class' then begin
     Expect('class');
+    SectionType := cbsVariable;
+    Visibility := tvPublic;
     TempType := NewType;
     NewType := TTypeClass.Create;
     NewType.Assign(TempType);
     TempType.Free;
-    if NextToken <> ';' then begin
-      while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do
-      begin
-        if ParseType(NewType.Parent, NewType2, True, ':') then begin
-          NewType2.Parent := NewType.Parent;
-          TTypeClass(NewType).Items.Add(NewType2);
-        end;
-        Expect(';');
-      end;
-      Expect('end');
-    end;
+    TTypeClass(NewType).CommonBlock.Parent := NewType.Parent.Parent;
+    while (NextToken <> 'end') and (NextTokenType <> ttEndOfFile) do begin
+      // Visibility sections
+      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
+
+      // Definition sections
+      if NextToken = 'var' then begin
+        Expect('var');
+        SectionType := cbsVariable;
+      end else
+      if NextToken = 'const' then begin
+        Expect('const');
+        SectionType := cbsConstant;
+      end else
+      if NextToken = 'type' then begin
+        Expect('type');
+        SectionType := cbsType;
+      end;
+
+      if NextToken = 'procedure' then
+        ParseFunction(TTypeClass(NewType).CommonBlock.Functions, True)
+      else if NextToken = 'function' then
+        ParseFunction(TTypeClass(NewType).CommonBlock.Functions, True)
+      else
+      if SectionType = cbsConstant then begin
+        ParseConstant(TTypeClass(NewType).CommonBlock.Constants, True)
+      end else
+      if SectionType = cbsVariable then begin
+        ParseVariable(TTypeClass(NewType).CommonBlock.Variables, True);
+      end else
+      if SectionType = cbsType then
+      with TTypeClass(NewType).CommonBlock do begin
+        if ParseType(Types, NewType2, True, '=') then begin
+          Types.Add(NewType2);
+          NewType2.Parent := Types;
+        end;
+      end;
+    end;
+    Expect('end');
     Result := True;
   end else Result := False;