Changeset 19 for branches/DelphiToC/UPascalParser.pas

Timestamp:

Apr 9, 2009, 2:08:56 PM (15 years ago)

Author:

george

Message:

• Přidáno: Nástřel parsování funkcí.
• Přidáno: Zobrazení stromu struktury programu.
• Opraveno: Zobrazení chybových hlášení.

File:

• branches/DelphiToC/UPascalParser.pas (modified) (13 diffs)

branches/DelphiToC/UPascalParser.pas

@@ -28 +28 @@
     function IsOperator(Text: string): Boolean;
     procedure ParseProgram(AProgram: TProgram);
-    procedure ParseFunctionList(FunctionList: TFunctionList);
     procedure ParseModule(Module: TModule);
     procedure ParseModuleUnit(Module: TModule);
     procedure ParseModuleProgram(Module: TModule);
-    procedure ParseFunction(AFunction: TFunction);
+    procedure ParseFunction(FunctionList: TFunctionList);
     procedure ParseVariableList(VariableList: TVariableList);
     procedure ParseVariable(Variable: TVariable);
@@ -39 +38 @@
     procedure ParseTypeList(TypeList: TTypeList);
     procedure ParseType(AType: TType);
-    procedure ParseCommonBlockDefinitions(CommonBlock: TCommonBlock);
+    procedure ParseCommonBlockDefinitions(CommonBlock: TCommonBlock; EndSymbol: string = ';');
     function ParseCommonBlockExpression(CommonBlock: TCommonBlock): TExpression;
     procedure ParseCommonBlockProgramCode(CommonBlock: TCommonBlock);
     procedure ParseCommonBlockOperation(CommonBlock: TCommonBlock);
-    procedure Parse;
+    procedure Log(Text: string);
     property OnErrorMessage: TOnErrorMessage read FOnErrorMessage write FOnErrorMessage;
   end;
@@ -58 +57 @@
 procedure TPascalParser.Expect(Code: string);
 begin
+  Log('Expected: ' + Code + '  Readed: ' + NextCode);
   if NextCode <> Code then begin
     ErrorMessage('Expected ' + Code + ' but ' + NextCode + ' found.');
@@ -112 +112 @@
 begin
   Result := (Character = ' ') or (Character = #13) or (Character = #10);
+end;
+
+procedure TPascalParser.Log(Text: string);
+const
+  LogFileName = 'ParseLog.txt';
+var
+  LogFile: TextFile;
+begin
+  AssignFile(LogFile, LogFileName);
+  if FileExists(LogFileName) then Append(LogFile)
+    else Rewrite(LogFile);
+  WriteLn(LogFile, Text);
+  CloseFile(LogFile);
 end;
 
@@ -189 +202 @@
 begin
   Result := NextCode(True);
-end;
-
-procedure TPascalParser.ParseFunction(AFunction: TFunction);
-begin
-  with AFunction do begin
-    if NextCode = 'var' then ParseVariableList(TVariableList(Variables))
-    else if NextCode = 'const' then ParseConstantList(TConstantList(Constants))
-    else if NextCode = 'type' then ParseTypeList(TTypeList(Types))
-    else ParseProgram(ProgramCode);
+  Log('Read: ' + Result);
+end;
+
+procedure TPascalParser.ParseFunction(FunctionList: TFunctionList);
+begin
+  with FunctionList do begin
+    with TFunction(Items[Add(TFunction.Create)]) do begin
+      Expect('procedure');
+      Name := ReadCode;
+      Expect(';');
+      ParseCommonBlockDefinitions(Items[Count - 1]);
+    end;
   end;
 end;
@@ -205 +221 @@
   I: Integer;
 begin
+  Log('==== Parse start ====');
   with AProgram do begin
     for I := 0 to Modules.Count - 1 do
@@ -227 +244 @@
 
 procedure TPascalParser.ParseConstantList(ConstantList: TConstantList);
-begin
-//  Compiler.Expect('const');
-//  while Compiler.IsIdentificator(Compiler.NextCode) do
-//    TConstant(Items[Add(TConstant.Create)]).Parse(Compiler);
+var
+  Identifiers: TStringList;
+  NewValueType: TType;
+  TypeName: string;
+  ConstantName: string;
+  Constant: TConstant;
+  I: Integer;
+  ConstantValue: string;
+begin
+  Identifiers := TStringList.Create;
+  with ConstantList do begin
+    Expect('const');
+    while IsIdentificator(NextCode) do begin
+      ConstantName := ReadCode;
+      Constant := Search(ConstantName);
+      if not Assigned(Constant) then begin
+        Identifiers.Add(ConstantName);
+        while NextCode = ',' do begin
+          Expect(',');
+          Identifiers.Add(ReadCode);
+        end;
+      end else ErrorMessage('Pøedefinování existující konstanty.');
+      Expect(':');
+      TypeName := ReadCode;
+      NewValueType := Parent.Types.Search(TypeName);
+      Expect('=');
+      ConstantValue := ReadCode;
+      Expect(';');
+
+      if NewValueType = nil then ErrorMessage('Typ ' + TypeName + ' nebyl definován.')
+        else for I := 0 to Identifiers.Count - 1 do
+          with TConstant(Items[Add(TConstant.Create)]) do begin
+            Name := Identifiers[I];
+            ValueType := NewValueType;
+            Value := ConstantValue;
+          end;
+    end;
+  end;
+  Identifiers.Destroy;
 end;
 
@@ -253 +305 @@
       end;
     end;
-    ParseCommonBlockDefinitions(Module);
+    ParseCommonBlockDefinitions(Module, '.');
   end;
 end;
@@ -266 +318 @@
 end;
 
-procedure TPascalParser.Parse;
-begin
-
-end;
-
-procedure TPascalParser.ParseCommonBlockDefinitions(CommonBlock: TCommonBlock);
+procedure TPascalParser.ParseCommonBlockDefinitions(CommonBlock: TCommonBlock; EndSymbol: string = ';');
 begin
   with CommonBlock do begin
-    while NextCode <> '.' do begin
+    while NextCode <> EndSymbol do begin
       if NextCode = 'var' then ParseVariableList(TVariableList(Variables))
       else if NextCode = 'const' then ParseConstantList(TConstantList(Constants))
       else if NextCode = 'type' then ParseTypeList(TTypeList(Types))
+      else if NextCode = 'procedure' then ParseFunction(Methods)
       else begin
         ParseCommonBlockProgramCode(CommonBlock);
@@ -283 +331 @@
       end;
     end;
+    Expect(EndSymbol);
   end;
 end;
@@ -371 +420 @@
 
             if Identifier[1] = '''' then begin
-              SetLength(TExpression(SubItems[1]).Value, Length(Identifier));
-              for I := 1 to Length(Identifier) do TExpression(SubItems[1]).Value[I - 1] := Byte(Identifier[I]);
+              TExpression(SubItems[1]).Value := Identifier;
+              //SetLength(TExpression(SubItems[1]).Value, Length(Identifier));
+              //for I := 1 to Length(Identifier) do
+              //  TExpression(SubItems[1]).Value[I - 1] := Byte(Identifier[I]);
             end else begin
-              SetLength(TExpression(SubItems[1]).Value, 1);
-              TExpression(SubItems[1]).Value[0] := StrToInt(Identifier);
+              //SetLength(TExpression(SubItems[1]).Value, 1);
+              //TExpression(SubItems[1]).Value[0] := StrToInt(Identifier);
             end;
           end;
@@ -518 +569 @@
             with TExpression(SubItems[1]) do begin
               NodeType := ntConstant;
-              SetLength(Value, 1);
-              Value[0] := 1;
+              //SetLength(Value, 1);
+              //Value[0] := 1;
+              Value := 1;
             end;
           end;
@@ -617 +669 @@
 end;
 
-procedure TPascalParser.ParseFunctionList(FunctionList: TFunctionList);
-begin
-
-end;
-
 end.