unitparser.pas

Delphi的另一款钢琴软件

    raise EParser.Create('Unexpected #else');
  SkipLine;
end;

procedure TCPreProcessor.DoEndif;
begin
  if fIfLevel > 0 then
  begin
    Dec (fIfLevel);
    SkipLine;
  end
  else
    raise EParser.Create('Unexpected endif');

end;

procedure TCPreProcessor.DoError;
begin
  GetRestOfLine;
  if IncludeFile = '' then
    raise EErrorPragma.CreateFmt ('#Error in line %d %s', [fLineNo, fToken])
  else
    raise EErrorPragma.CreateFmt ('#Error in line %d:s %s', [fLineNo, IncludeFile, fToken])
end;

procedure TCPreProcessor.DoIf;
var
  expr : string;
  val : TValue;
begin
  GetRestOfLine;
  expr := fToken;

  CalcExpression (expr, fIdentifiers, val);

  if (val.tp <> vInteger) then
   raise EParser.Create('Must be an integer expression');

  Inc (fIfLevel);

  if val.iVal = 0 then
    SkipIfElseBlock;
  SkipLine;
end;

procedure TCPreProcessor.DoIfDef;
begin
  NextIdentifier ('Identifier expected in ifdef');
  Inc (fIfLevel);
  SkipLine;

  if not Defined (fToken) then
    SkipIfElseBlock;
  SkipLine;
end;

procedure TCPreProcessor.DoIfNDef;
begin
  NextIdentifier ('Identifier expected in ifdef');
  Inc (fIfLevel);
  SkipLine;

  if Defined (fToken) then
    SkipIfElseBlock;
  SkipLine;
end;

procedure TCPreProcessor.DoInclude;
var
  oldReader : TStreamTextReader;
  oldLinePos, oldLineNo, oldIfLevel : Integer;
  oldLineBuf : string;
  oldSOL : boolean;
  oldCh : char;
  oldPathName : string;
  r : TStreamTextReader;
  f : TFileStream;
  fName : string;
begin
  NextFileString ('File name expected');

  oldReader := fReader;
  oldLinePos := fLinePos;
  oldLineNo := fLineNo;
  oldLineBuf := fLineBuf;
  oldIfLevel := fIfLevel;
  oldSol := fSOL;
  oldCh := fCh;
  oldPathName := PathName;

  r := Nil;
  fName := GetIncludePathName (fToken);
  f := TFileStream.Create(fName, fmOpenRead or fmShareDenyWrite);
  try
    r := TStreamTextReader.Create(f);
    fLinePos := 0;
    fLineNo := 0;
    fReader := r;
    fSOL := True;
    fFirstChar := True;
    fLineBuf := '';
    fIfLevel := 0;
    PathName := ExtractFilePath (fName);
    IncludeFile := ExtractFileName (fName);

    Parse;
  finally
    fReader := oldReader;
    fLinePos := oldLinePos;
    fLineNo := oldLineNo;
    fFirstChar := False;
    fLineBuf := oldLineBuf;
    fIfLevel := oldIfLevel;
    fSOL := oldSOL;
    fCh := oldCh;
    fPathName := oldPathName;
    r.Free;
    f.Free
  end;
  SkipLine;
end;

procedure TCPreProcessor.DoPragma;
begin
  HandlePragma (GetRestOfLine);
end;

procedure TCPreProcessor.DoUndef;
var
  id : string;
begin
  NextIdentifier ('Identifier expected in #undef');
  id := fToken;
  GetRestOfLine;

  DeleteIdentifier (id);
end;

procedure TCPreProcessor.ExpectChar(ch: char);
begin
  inherited;

end;

function TCPreProcessor.ExpectInteger(const errMsg: string): Integer;
begin
  if TokenType = ttIdentifier then
    Resolve (fTokenType, fToken);

  result := inherited ExpectInteger (errMsg);
end;

function TCPreProcessor.ExpectString(const errMsg: string): string;
begin
  if TokenType = ttIdentifier then
    Resolve (fTokenType, fToken);

  result := inherited ExpectString (errMsg);
end;

function TCPreProcessor.GetIncludePathName(const FileName: string): string;
var
  st, p : string;
  ch : char;
begin
  result := PathName + fileName;

  if not FileExists (result) then
  begin
    st := IncludePath;
    if st = '' then
      st := GetEnvironmentVariable ('include');

    while st <> '' do
    begin
      p := SplitString (';', st);

      if p <> '' then
      begin
        ch := p [Length (p)];
        if (ch <> '\') and (ch <> ':') then
          p := p + '\';

        result := p + fileName;
        if FileExists (result) then
          Exit
      end
    end;

    result := FileName
  end
end;

function TCPreProcessor.GetRestOfLine: string;
begin
  result := '';
  if fSol then
  begin
    fToken := '';
    exit;
  end;
  SkipWhitespace;
  fToken := '';
  repeat
    if fCh = '/' then
      if GetChar = '/' then
      begin
        SkipLine;
        break
      end
      else
        if fCh = '*' then
        begin
          GetChar;
          repeat
            if fLinePos >= Length (fLineBuf) then
              break;

            if fCh = '*' then
            begin
              if GetChar = '/' then
                break
            end
            else
              GetChar
          until fLinePos >= Length (fLineBuf)
        end
        else
          fToken := fToken + '/' + fCh
    else
      fToken := fToken + fCh;
    if fLinePos = Length (fLineBuf) then
    begin
      GetChar;
      break
    end;
    GetChar
  until False;
  fToken := Trim (fToken);
  result := fToken;
end;

function TCPreProcessor.GetToken: boolean;
var
  retry : boolean;
begin
  result := True;
  retry := True;
  while retry do
  begin
    retry := False;
    result := inherited GetToken;
    if not result then
    begin
      if fIfLevel <> 0 then
        raise EParser.Create('Unexpected end of file');
      Exit;
    end;

    if TokenType = ttChar then
    case fTokenChar of
      '/' : if fCh = '/' then
            begin
              SkipLine;
              retry := True;
            end
            else
            if fCh = '*' then
            begin
              repeat
                if GetChar = #0 then break;
                if (fCh = '*') and (GetChar = '/') then
                  break;
              until fCh = #0;
              GetChar;
              retry := True;
            end
            else
              fTokenType := ttOpDiv;
      '#' :
            if fTokenSOL then
            begin
              inherited GetToken;
              if fTokenType <> ttIdentifier then
                raise EParserError.Create('Syntax error in directive');
              HandleDirective;
              retry := True;
            end;
      '"' : begin
              fToken := '';
              while fCh <> #0 do
              begin
                case fCh of
                  '"' : break;
                  '\' :
                    case GetChar of
                      '"' : fToken := fToken + '"';
                      'n' : fToken := fToken + #10;
                      'r' : fToken := fToken + #13;
                      't' : fToken := fToken + #9;
                      '\' : fToken := fToken + '\';
                      '0' : fToken := fToken + #0;
                      else
                        raise EParserError.Create('Invalid escape sequence');
                    end;
                  else
                    fToken := fToken + fCh
                end;
                GetChar
              end;
              fTokenType := ttString;
              GetChar;
            end;
    end
  end
end;

procedure TCPreProcessor.HandleDirective;
var
  idx : Integer;
begin
  idx := fDirectives.IndexOf(LowerCase (fToken));
  if idx >= 0 then
  case Integer (fDirectives.Objects [idx]) of
    dtInclude : DoInclude;
    dtDefine  : DoDefine;
    dtIfDef   : DoIfDef;
    dtIfnDef  : DoIfNDef;
    dtEndif   : DoEndif;
    dtUndef   : DoUndef;
    dtElse    : DoElse;
    dtIf      : DoIf;
    dtPragma  : DoPragma;
    dtError   : DoError;
    else
      raise EParser.Create('Unknown directive #' + fToken)
  end
  else
    raise EParser.Create('Unknown directive #' + fToken)
end;

procedure TCPreProcessor.HandlePragma(const st: string);
begin

end;

function TCPreProcessor.IsIdentifier(const id: string): boolean;
begin
  result := fIdentifiers.IndexOf(id) >= 0
end;

procedure TCPreProcessor.NextFileString(const errMsg: string);
begin
  GetChar;
  if fCh = '<' then
  begin
    GetChar;
    fToken := '';
    while fCh <> #0 do
    begin
      case fCh of
        '>' : break;
        else
          fToken := fToken + fCh
      end;
      GetChar
    end;
    fTokenType := ttString
  end
  else
    if ch = '"' then
    begin
      GetChar;
      fToken := '';
      while fCh <> #0 do
      begin
        case fCh of
          '"' : break;
          else
            fToken := fToken + fCh
        end;
        GetChar
      end;
      fTokenType := ttString
    end
    else
      GetToken;

  if TokenType <> ttString then
    raise EParser.Create(errMsg);
end;

function TCPreProcessor.Resolve(var TokenType : Integer; var st: string): TValue;
begin
  if (TokenType = ttIdentifier) and IsIdentifier (st) then
  begin
    CalcExpression (st, fIdentifiers, result);

    case result.tp of
      vString  : begin st := result.sVal; tokenType := ttString; end;
      vInteger : begin st := IntToStr (result.iVal); tokenType := ttNumber; end;
      vReal    : begin st := FloatToStr (result.rVal); tokenType := ttNumber; end;
    end
  end
end;

function TCPreProcessor.ResolveToken: TValue;
begin
  if (TokenType = ttNumber) or (TokenType = ttIdentifier) then
    result := Calc (Token)
  else
    if TokenType = ttString then
    begin
      result.tp := vString;
      result.sVal := Token
    end
    else
      raise EParser.Create('Value expected');

end;

procedure TCPreProcessor.SkipIfElseBlock;
var
  level : Integer;
begin
  level := 0;
  repeat
    SkipWhitespace;
    if fCh = #0 then Break;
    if fCh = '#' then
    begin
      GetChar;
      inherited GetToken;
      if fToken = 'endif' then
        if level = 0 then
          break
        else
          Dec (level)
      else
        if (fToken = 'ifdef') or (ftoken = 'ifndef') or (ftoken = 'if') then
          Inc (level)
    end
    else
      fSOL := False;
    SkipLine
  until False;
  Dec (fIfLevel)
end;

end.