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

Timestamp:

Oct 18, 2010, 12:39:37 PM (14 years ago)

Author:

george

Message:

• Fixed: Parsing of strings.
• Modified: Now supported C target "Dynamic C" dialect.

File:

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

branches/Transpascal/Compiler/Analyze/UParser.pas

@@ -11 +11 @@
 type
   TOnErrorMessage = procedure(Text: string; Position: TPoint; FileName: string) of object;
+
+  TParserState = (psNone, psIdentifier, psConstantNumber, psConstantString,
+    psOperator, psEndOfFile, psLineComment, psBlockComment1, psBlockComment2,
+    psUnknown, psWhiteSpace, psConstantStringEnd);
 
   TTokenType = (ttNone, ttIdentifier, ttConstantNumber, ttConstantString,
@@ -25 +29 @@
     FNextToken: string;
     FNextTokenType: TTokenType;
+    FParserState: TParserState;
     PreviousChar: char;
     CurrentChar: char;
@@ -36 +41 @@
     function ReadCode: string;
     function NextToken: string;
+    function NextTokenType: TTokenType;
     procedure Expect(Code: string);
     function IsWhiteSpace(Character: char): boolean;
@@ -216 +222 @@
   FNextToken := '';
   FNextTokenType := ttNone;
+  FParserState := psNone;
   with SourceCodeText do
     while True do
     begin
-      if CodeStreamPosition < Length(Text) then
-      begin
+      if CodeStreamPosition < Length(Text) then begin
         CurrentChar := Text[CodeStreamPosition];
-      end
-      else
-      begin
+      end else begin
         FNextToken := '';
+        FParserState := psEndOfFile;
         FNextTokenType := ttEndOfFile;
         Break;
       end;
 
-      if FNextTokenType = ttNone then
-      begin
+      if FParserState = psNone then begin
         if IsWhiteSpace(CurrentChar) then
-          FNextTokenType := ttWhiteSpace
+          FParserState := psWhiteSpace
         else
-        if CurrentChar = '{' then
-        begin
-          FNextTokenType := ttBlockComment1;
-        end
-        else
-        if CurrentChar = '''' then
-        begin
-          FNextTokenType := ttConstantString;
-        end
-        else
-        if CurrentChar in SpecChar then
-        begin
-          FNextTokenType := ttOperator;
+        if CurrentChar = '{' then begin
+          FParserState := psBlockComment1;
+        end else
+        if CurrentChar = '''' then begin
+          FParserState := psConstantString;
+        end else
+        if CurrentChar in SpecChar then begin
+          FParserState := psOperator;
           FNextToken := FNextToken + CurrentChar;
-        end
-        else
-        if IsAlphanumeric(CurrentChar) then
-        begin
-          FNextTokenType := ttIdentifier;
+        end else
+        if IsAlphanumeric(CurrentChar) then begin
+          FParserState := psIdentifier;
           FNextToken := FNextToken + CurrentChar;
-        end
-        else
-          FNextTokenType := ttUnknown;
-      end
-      else
-      if FNextTokenType = ttLineComment then
-      begin
+        end else FParserState := psUnknown;
+      end else
+      if FParserState = psLineComment then begin
         if (CurrentChar = #13) or (CurrentChar = #10) then
-          FNextTokenType := ttNone;
-      end
-      else
-      if FNextTokenType = ttBlockComment1 then
-      begin
+          FParserState := psNone;
+      end else
+      if FParserState = psBlockComment1 then begin
         if (CurrentChar = '}') then
-          FNextTokenType := ttNone;
-      end
-      else
-      if FNextTokenType = ttBlockComment2 then
-      begin
+          FParserState := psNone;
+      end else
+      if FParserState = psBlockComment2 then begin
         if (PreviousChar = '*') and (CurrentChar = ')') then
-          FNextTokenType := ttNone;
-      end
-      else
-      if FNextTokenType = ttConstantString then
-      begin
-        if (CurrentChar = '''') and (PreviousChar = '''') then
-          Break
-        else
-          FNextToken := FNextToken + CurrentChar;
-      end
-      else
-      if FNextTokenType = ttOperator then
+          FParserState := psNone;
+      end else
+      if FParserState = psConstantString then
+      begin
+        if (CurrentChar = '''') then begin
+          FParserState := psConstantStringEnd;
+        end else FNextToken := FNextToken + CurrentChar;
+      end else
+      if FParserState = psConstantStringEnd then
+      begin
+        if (CurrentChar = '''') then begin
+          FParserState := psConstantString;
+        end else FParserState := psNone;
+        FNextTokenType := ttConstantString;
+        Break;
+      end else
+      if FParserState = psOperator then
       begin
         if (CurrentChar = '*') and (PreviousChar = '(') then
         begin
           FNextToken := '';
-          FNextTokenType := ttBlockComment2;
-        end
-        else
+          FParserState := psBlockComment2;
+        end else
         if (CurrentChar = '/') and (PreviousChar = '/') then
         begin
           FNextToken := '';
-          FNextTokenType := ttLineComment;
+          FParserState := psLineComment;
+        end else
+        if not (CurrentChar in SpecChar) then begin
+          FNextTokenType := ttOperator;
+          Break;
         end
-        else
-        if not (CurrentChar in SpecChar) then
-          Break
-        else
-        begin
+        else begin
           J := 0;
           while (J < Length(DoubleSpecChar)) and
@@ -310 +303 @@
           if J < Length(DoubleSpecChar) then
             FNextToken := FNextToken + CurrentChar
-          else
+          else begin
+            FNextTokenType := ttOperator;
             Break;
-        end;
+          end;
+        end;
+      end else
+      if FParserState = psIdentifier then
+      begin
+        if not IsAlphanumeric(CurrentChar) then begin
+          FNextTokenType := ttIdentifier;
+          Break;
+        end else FNextToken := FNextToken + CurrentChar;
       end
       else
-      if FNextTokenType = ttIdentifier then
-      begin
-        if not IsAlphanumeric(CurrentChar) then
-          Break
-        else
-          FNextToken := FNextToken + CurrentChar;
-      end
-      else if FNextTokenType = ttWhiteSpace then
-        FNextTokenType := ttNone;
-
-      if FNextTokenType <> ttNone then
-      begin
+      if FParserState = psWhiteSpace then begin
+        FParserState := psNone;
+      end;
+
+      if FParserState <> psNone then begin
         // Update cursor position
         Inc(CodePosition.X);
-        if (CurrentChar = #13) then
-        begin
+        if (CurrentChar = #13) then begin
           CodePosition.X := 1;
           Inc(CodePosition.Y);
@@ -351 +345 @@
 begin
   Result := FNextToken;
+end;
+
+function TBaseParser.NextTokenType: TTokenType;
+begin
+  Result := FNextTokenType;
 end;
 
@@ -397 +396 @@
 var
   Identifier: string;
+  IdentifierType: TTokenType;
   NewVariable: TVariable;
   NewExpression: TExpression;
@@ -409 +409 @@
   Expressions.Add(TExpression.Create);
   with SourceCode do begin
-    while ((FNextToken <> ';') and (FNextToken <> ',') and
-        (not IsKeyWord(FNextToken))) and not
-      (((FNextToken = ')') or (FNextToken = ']'))) do begin
+    while ((NextToken <> ';') and (NextToken <> ',') and (not IsKeyWord(NextToken))) and not
+      (((NextToken = ')') or (NextToken = ']'))) and not (NextTokenType = ttEndOfFile) do begin
+      IdentifierType := NextTokenType;
       Identifier := ReadCode;
       if Identifier = '(' then begin
@@ -506 +506 @@
           TExpression(SubItems[1]).NodeType := ntConstant;
 
-          if Identifier[1] = '''' then begin
+          if IdentifierType = ttConstantString then begin
             TExpression(SubItems[1]).Value := Identifier;
             //SetLength(TExpression(SubItems[1]).Value, Length(Identifier));
@@ -512 +512 @@
             //  TExpression(SubItems[1]).Value[I - 1] := Byte(Identifier[I]);
           end else begin
-            TExpression(SubItems[1]).Value := Identifier;
+            TExpression(SubItems[1]).Value := StrToInt(Identifier);
           end;
         end;