dfparser.pas

C,C++ To Delphi转换器 C,C++ To Delphi转换器

unit DFParser;

// Free for any project that try to translate C to Pascal
// (c)2002 by Paul TOTH <[e-mail]>

interface

uses
 SysUtils,Dialogs,
 DFTokens,DFCode;

Type
 TTokenType=(ttAlpha,ttNumeric,ttSymbolic);

 TParser=class
 private
  fSource  :string;
  fStart   :integer;
  fIndex   :integer;
  fMacro   :string;
  Tokens   :TTokens;
  Token    :string;
  TokenType:TTokenType;
  procedure Analyse;
  function NextChar:char;
  function ReadChar:char;
  function SkipChar(c:char):boolean;
  procedure DropChar(c:char);
  procedure Blanks;
  function EndOfLine:string;
  procedure Comments;
  procedure Drop(s:string);
  function NextToken:string;
  function AlphaToken:string;
  function NumericToken:string;
  function SymbolicToken:string;
  function _Expr:boolean;
  procedure OnInclude;
  procedure OnDefine;
  procedure OnIf_Expr;
  procedure OnIfDef;
  procedure OnIfNDef;
  procedure OnElse_;
  procedure OnEndIf;
  procedure OnPragma;
  procedure OnTypeDef;
 public
  Constructor Create(FileName:string);
  procedure PutMacro(value:string);
  property Source:string read fSource write fSource;
  property Start:integer read fStart write fStart;
  property Index:integer read fIndex write fIndex;
 end;

var
 Parser:TParser;

procedure Parse(FileName:string);

implementation

uses
 Classes;

Var
 Files:TStringList;

procedure Parse(FileName:string);
 var
  i:integer;
 begin
  if Files=nil then Files:=TStringList.Create;
  i:=Files.IndexOf(FileName);
  if i<0 then i:=Files.AddObject(FileName,TParser.Create(FileName));
  Parser:=TParser(Files.Objects[i]);
  Parser.Analyse;
 end;

Constructor TParser.Create(FileName:string);
 var
  f:file;
 begin
  Tokens:=TTokens.Create;
  Tokens.SetAction('#include',OnInclude);
  Tokens.SetAction('#define',OnDefine);
  Tokens.SetAction('#if',OnIf_Expr);
  Tokens.SetAction('#ifdef',OnIfDef);
  Tokens.SetAction('#ifndef',OnIfNDef);
  Tokens.SetAction('#else',OnElse_);
  Tokens.SetAction('#endif',OnEndIf);
  Tokens.SetAction('#pragma',OnPragma);
  Tokens.SetAction('typedef',OnTypeDef);
  AssignFile(f,FileName);
  Reset(f,1);
  if IoResult=0 then begin
   SetLength(fSource,FileSize(f));
   BlockRead(f,fSource[1],Length(fSource));
   CloseFile(f);
  end;
  Index:=1;
 end;

function TParser._Expr:boolean;
 var
  c:char;
 begin
  blanks;
  fStart:=fIndex;
  case NextChar of
   '(': begin
         ReadChar;
         Result:=_Expr;
         blanks;
         Drop(')');
        end;
   '!': begin
         ReadChar;
         Result:=not _Expr;
        end;
   else begin
    if NextToken<>'defined' then raise Exception.Create('"defined" expected');
    blanks;
    result:=Defined(NextToken);
   end;
  end;
  blanks;
  fStart:=fIndex;
  while NextChar in ['&','|'] do begin
   c:=ReadChar; Drop(c);
   if c='&' then
    result:=_Expr and result // compute "_Expr" first !!
   else
    result:=result  or _Expr;
  end;
 end;

procedure TParser.OnInclude;
 var
  old:TParser;
  name:string;
 begin
  blanks;
  fStart:=fIndex;
  case NextChar of
   '<' : begin
          repeat inc(fIndex) until SkipChar('>');
         end;
   '"' : begin
          inc(fIndex);
          old:=Parser;
          while not SkipChar('"') do begin
           name:=name+nextchar;
           inc(fIndex)
          end;
          Parser:=TParser.Create(name);
          Parser.Analyse;
          Parser.Free;
          Parser:=old;
         end;
   else raise Exception.Create('file name expected');
  end;
 end;

procedure TParser.OnDefine;
 var
  name,value:string;
 begin
  blanks;
  name:=NextToken;
  Define(name);
  value:=EndOfLine;
  if value='' then exit;
  Tokens.SetMacro(name,value);
 end;

procedure TParser.OnIf_Expr;
//#if (defined _M_IX86 || defined __i386__) && !defined C_ONLY && !defined __sun__
 begin
  PushState;
  SetState(_Expr);
 end;

procedure TParser.OnIfDef;
 begin
  blanks;
  PushState;
  SetState(defined(NextToken));
 end;

procedure TParser.OnIfNDef;
 begin
  blanks;
  PushState;
  SetState(not defined(NextToken));
 end;

procedure TParser.OnElse_;
 begin
  SetState(not GetState);
 end;
procedure TParser.OnEndIf;
 begin
  PopState;
 end;

procedure TParser.OnPragma;
 begin
  EndOfLine;
 end;

procedure TParser.OnTypeDef;
 begin
  //t:=GetType;
 end; 

procedure TParser.Analyse;
 begin
  repeat
   Blanks;
   fStart:=fIndex;
   Token:=NextToken;
   while Token='/' do begin
    Comments;
    Blanks;
    fStart:=fIndex;
    Token:=NextToken;
   end;
  until Tokens.Eval(Token)=False;
  if token<>'' then raise Exception.Create('unknow '+token);
 end;

function TParser.NextChar:char;
 begin
  if fMacro<>'' then begin
   Result:=fMacro[1];
   Delete(fMacro,1,1);
   exit;
  end;
  if fIndex>Length(source) then raise Exception.Create('unexpected end of file');
  Result:=fSource[fIndex];
 end;

function TParser.ReadChar:char;
 begin
  Result:=NextChar;
  inc(fIndex);
 end;

function TParser.SkipChar(c:char):boolean;
 begin
  result:=(NextChar=c);
  if result then inc(fIndex);
 end;

procedure TParser.DropChar(c:char);
 begin
  if not SkipChar(c) then raise Exception.Create('expected '+c);
 end;

procedure TParser.Blanks;
 begin
  while NextChar in [#9,#10,#13,' '] do inc(fIndex);
 end;

function TParser.EndOfLine:string;
 var
  i:integer;
 begin
  result:='';
  while not (NextChar in [#10,#13]) do result:=result+ReadChar;
  for i:=1 to length(result) do if result[i]<>' ' then exit;
  result:='';
 end;

procedure TParser.Comments;
 begin
  case NextChar of
   '/' : EndOfLine; { // comment    }
   '*' : begin
          repeat                                         { /* comment */ }
           repeat inc(fIndex) until SkipChar('*');
          until SkipChar('/');
         end;
   else raise Exception.Create('comment expected');
  end;
 end;

procedure TParser.Drop(s:string);
 begin
  blanks;
  if NextToken<>s then raise Exception.create('expected '+s);
 end;

function TParser.NextToken:string;
 begin
  case upcase(NextChar) of
   '#',
   'A'..'Z','_' : Result:=AlphaToken;
   '0'..'9'     : Result:=NumericToken;
   else           Result:=SymbolicToken;
  end;
 end;

function TParser.AlphaToken:string;
 begin
  result:='';
  repeat
   result:=result+ReadChar+NumericToken;
  until not (upcase(NextChar) in ['A'..'Z','_']);
  TokenType:=ttAlpha;
 end;

function TParser.NumericToken:string;
 begin
  result:='';
  while NextChar in ['0'..'9'] do begin
   result:=result+ReadChar;
  end;
  TokenType:=ttNumeric;
 end;

function TParser.SymbolicToken:string;
 begin
  result:=ReadChar;
  TokenType:=ttSymbolic;
 end;

procedure TParser.PutMacro(value:string);
 begin
  fMacro:=value+fMacro;
 end;

end.