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

Timestamp:

Oct 21, 2010, 1:20:57 PM (14 years ago)

Author:

george

Message:

• Enhanced: Tokenizerm, parsing of record type, generation C code for record type.
• Added: Logging of debug information.

File:

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

branches/Transpascal/Compiler/Analyze/UParser.pas

@@ -10 +10 @@
 
 type
-  TOnErrorMessage = procedure(Text: string; Position: TPoint; FileName: string) of object;
+  TErrorMessageEvent = procedure(Text: string; Position: TPoint; FileName: string) of object;
+  TDebugLogEvent = procedure(Text: string) of object;
 
   TParserState = (psNone, psIdentifier, psConstantNumber, psConstantString,
     psOperator, psEndOfFile, psLineComment, psBlockComment1, psBlockComment2,
-    psUnknown, psWhiteSpace, psConstantStringEnd);
+    psUnknown, psWhiteSpace, psConstantStringEnd, psBlockComment1First,
+    psCompilerDirective, psNoneShift, psConstantHexNumber);
 
   TTokenType = (ttNone, ttIdentifier, ttConstantNumber, ttConstantString,
     ttOperator, ttEndOfFile, ttLineComment, ttBlockComment1, ttBlockComment2,
-    ttUnknown, ttWhiteSpace);
+    ttUnknown, ttWhiteSpace, ttCompilerDirective);
 
   TToken = class
@@ -31 +33 @@
   private
     FFileName: string;
-    FOnErrorMessage: TOnErrorMessage;
+    FOnDebugLog: TDebugLogEvent;
+    FOnErrorMessage: TErrorMessageEvent;
     FNextToken: string;
     FNextTokenType: TTokenType;
@@ -49 +52 @@
     destructor Destroy; override;
     function IsAlphanumeric(Character: char): boolean;
+    function IsNumeric(Character: char): boolean;
+    function IsHex(Character: char): boolean;
     function IsWhiteSpace(Character: char): boolean;
     function IsAlphabetic(Character: char): boolean;
@@ -60 +65 @@
     procedure ErrorMessage(const Text: string; const Arguments: array of const;
       TokenOffset: Integer);
-    property OnErrorMessage: TOnErrorMessage read FOnErrorMessage write FOnErrorMessage;
+    property OnErrorMessage: TErrorMessageEvent read FOnErrorMessage write FOnErrorMessage;
+    property OnDebugLog: TDebugLogEvent read FOnDebugLog write FOnDebugLog;
     procedure Process;
+    procedure Log(Text: string);
     property FileName: string read FFileName write FFileName;
   end;
@@ -84 +91 @@
 procedure TBaseParser.Expect(Code: string);
 begin
+  Log('Expect: ' + Code);
   if NextToken <> Code then begin
     ErrorMessage(SExpectedButFound, [Code, NextToken], 0);
@@ -112 +120 @@
 function TBaseParser.IsAlphanumeric(Character: char): boolean;
 begin
-  Result := IsAlphabetic(Character) or (Character in ['0'..'9']);
+  Result := IsAlphabetic(Character) or IsNumeric(Character);
+end;
+
+function TBaseParser.IsNumeric(Character: char): boolean;
+begin
+  Result := Character in ['0'..'9'];
+end;
+
+function TBaseParser.IsHex(Character: char): boolean;
+begin
+  Result := IsNumeric(Character) or (Character in ['A'..'F']);
 end;
 
@@ -179 +197 @@
 end;
 
+procedure TBaseParser.Log(Text: string);
+begin
+  if Assigned(FOnDebugLog) then
+    FOnDebugLog(Text);
+end;
+
 procedure TBaseParser.GetNextToken;
 var
@@ -204 +228 @@
       end;
 
-      if FParserState = psNone then begin
+      if (FParserState = psNone) or (FParserState = psNoneShift) then begin
         TokenCodePosition := CodePosition;
         if IsWhiteSpace(CurrentChar) then
@@ -210 +234 @@
         else
         if CurrentChar = '{' then begin
-          FParserState := psBlockComment1;
+          FParserState := psBlockComment1First;
         end else
         if CurrentChar = '''' then begin
           FParserState := psConstantString;
+        end else
+        if CurrentChar = '$' then begin
+          FParserState := psConstantHexNumber;
         end else
         if CurrentChar in SpecChar then begin
@@ -219 +246 @@
           FNextToken := FNextToken + CurrentChar;
         end else
-        if IsAlphanumeric(CurrentChar) then begin
+        if IsAlphabetic(CurrentChar) then begin
           FParserState := psIdentifier;
           FNextToken := FNextToken + CurrentChar;
+        end else
+        if IsNumeric(CurrentChar) then begin
+          FPArserSTate := psConstantNumber;
+          FNextToken := FNextToken + CurrentChar;
         end else FParserState := psUnknown;
       end else
       if FParserState = psLineComment then begin
         if (CurrentChar = #13) or (CurrentChar = #10) then
+          FParserState := psNoneShift;
+      end else
+      if FParserState = psBlockComment1First then begin
+        if CurrentChar = '$' then FParserState := psCompilerDirective
+        else FParserSTate := psBlockComment1;
+      end else
+      if FParserState = psBlockComment1 then begin
+        if (CurrentChar = '}') then begin
+          FParserState := psNoneShift;
+        end;
+      end else
+      if FParserState = psCompilerDirective then begin
+        if (CurrentChar = '}') then begin
           FParserState := psNone;
-      end else
-      if FParserState = psBlockComment1 then begin
-        if (CurrentChar = '}') then
-          FParserState := psNone;
+          FNextTokenType := ttCompilerDirective;
+          Break;
+        end;
       end else
       if FParserState = psBlockComment2 then begin
         if (PreviousChar = '*') and (CurrentChar = ')') then
-          FParserState := psNone;
+          FParserState := psNoneShift;
       end else
       if FParserState = psConstantString then
@@ -249 +292 @@
         FNextTokenType := ttConstantString;
         Break;
+      end else
+      if FParserState = psConstantHexNumber then
+      begin
+        if not IsHex(CurrentChar) then begin
+          FParserState := psNone;
+          FNextTokenType := ttConstantNumber;
+          Break;
+        end else FNextToken := FNextToken + CurrentChar;
+      end else
+      if FParserState = psConstantNumber then
+      begin
+        if not IsNumeric(CurrentChar) then begin
+          FParserState := psNone;
+          FNextTokenType := ttConstantNumber;
+          Break;
+        end else FNextToken := FNextToken + CurrentChar;
       end else
       if FParserState = psOperator then
@@ -281 +340 @@
       if FParserState = psIdentifier then
       begin
-        if not IsAlphanumeric(CurrentChar) then begin
+        if (not IsAlphanumeric(CurrentChar)) and (CurrentChar <> '_') then begin
           FNextTokenType := ttIdentifier;
           Break;
@@ -311 +370 @@
     Inc(TokenIndex);
   end else Result := '';
+  Log('ReadCode: ' + Result);
 end;
 
@@ -318 +378 @@
     Result := TToken(Tokens[TokenIndex]).Token;
   end else Result := '';
+  Log('NextToken: ' + Result);
 end;