[Fdcil-cvs] dev/miracle2k/fdcil-test .cvsignore,NONE,1.1 fdcil.CommandLine.pas,NONE,1.1 fdcil.Compil

SourceForge Headquarters 1320 Columbia Street Suite 310 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/fdcil/dev/miracle2k/fdcil-test
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9368/miracle2k/fdcil-test

Added Files:
	.cvsignore fdcil.CommandLine.pas fdcil.Compiler.pas 
	fdcil.ExceptionHandling.pas fdcil.IO.Input.pas 
	fdcil.IO.Messages.Localize.pas fdcil.IO.Messages.pas 
	fdcil.Lexer.pas fdcil.Parser.pas fdcil.SymbolTable.pas 
	fdcil.Tokenizer.pas fdcil.Tokens.pas fdcil.bdsproj fdcil.cfg 
	fdcil.dpr test.pas 
Log Message:
created module structure for testing; simple parsing already working;

--- NEW FILE: .cvsignore ---
*.exe
*.dcuil
*.rsp
*.pdb
Model
--- NEW FILE: fdcil.Compiler.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the GNU General Public License
Version 1.1 or later (the "License"); you may not use this file except in
compliance with the License. You may obtain a copy of the License at
http://www.gnu.org/copyleft/gpl.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Initial Developer of the Original Code is Michael Elsdörfer.
All Rights Reserved.

$Id: fdcil.Compiler.pas,v 1.1 2004/08/09 11:16:54 miracle2k Exp $

You may retrieve the latest version of this file at the fdcil homepage,
located at http://fdcil.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

unit fdcil.Compiler;

interface

uses
  System.IO,
  fdcil.ExceptionHandling,
  fdcil.CommandLine,
  fdcil.IO.Messages,
  fdcil.IO.Input,
  fdcil.SymbolTable,
  fdcil.Lexer,
  fdcil.Parser;

type
  TDelphiCompiler = class(System.Object)
  public
    constructor Create(CommandLineParser: TCommandLineParser);
    procedure CompileFile(FileName: string);
  end;

implementation

uses
  fdcil.IO.Messages.Localize;

{ TDelphiCompiler }

procedure TDelphiCompiler.CompileFile(FileName: string);
var
  Input: TFileInput;
  Lexer: TLexer;
  Parser: TDelphiParser;
  SymbolTable: TSymbolTable;
begin
  try
    SymbolTable := TSymbolTable.Create;
    SymbolTable.Init;
    Input := TFileInput.Create(FileName);
    Lexer := TLexer.Create(Input, SymbolTable);
    Parser := TDelphiParser.Create(Lexer);
    Parser.Init;
    Parser.&Program;
  except                       
    on E: FileNotFoundException do                                               
      MessageEmitter.Emit(mtFatal, System.String.Format(E_FILE_NOT_FOUND, FileName));
    on E: EParserError do          
      MessageEmitter.Emit(mtError, E.Message);
  end;
end;

constructor TDelphiCompiler.Create(CommandLineParser: TCommandLineParser);
begin
  inherited Create;
end;

end.

--- NEW FILE: fdcil.Parser.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the GNU General Public License
Version 1.1 or later (the "License"); you may not use this file except in
compliance with the License. You may obtain a copy of the License at
http://www.gnu.org/copyleft/gpl.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Initial Developer of the Original Code is Michael Elsdörfer.
All Rights Reserved.

$Id: fdcil.Parser.pas,v 1.1 2004/08/09 11:16:54 miracle2k Exp $

You may retrieve the latest version of this file at the fdcil homepage,
located at http://fdcil.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

unit fdcil.Parser;

interface

uses
  fdcil.ExceptionHandling,
  fdcil.IO.Messages,
  fdcil.Tokens,
  fdcil.Lexer;

type
  TDelphiParser = class(System.Object)
  private
    fLexer: TLexer;
  protected
    procedure Match(Token: Integer);
    procedure Next;

    procedure &Implementation;
    procedure Block;
  public
    function get_CurrentToken: Integer;
  public
    constructor Create(Lexer: TLexer);

    procedure &Program;
    procedure Init;

    property Look: Integer read get_CurrentToken;
  end;

implementation

{ TDelphiParser }

procedure TDelphiParser.&Program;
begin
  if Look = T_PROGRAM then
  begin
    Match(T_PROGRAM); Match(T_IDENT); Match(T_SEMICOLON);
    &Implementation;
    Block; 
  end

  else if Look = T_UNIT then
  begin
    //Match(T_UNIT); Match(T_IDENT); Match(T_SEMICOLON);
    //Match(T_END); Match(T_DOT);
    raise EParserError.Create('Units not yet supported');
  end

  else if Look = T_PACKAGE then
  begin
    //Match(T_PACKAGE); Match(T_IDENT); Match(T_SEMICOLON);
    //Block;
    raise EParserError.Create('Packages not yet supported');
  end

  else if Look = T_LIBRARY then
  begin
    //Match(T_LIBRARY); Match(T_IDENT); Match(T_SEMICOLON);
    //Block;
    raise EParserError.Create('Libraries not yet supported');
  end

  else
    raise EParserError.Create('PROGRAM, UNIT, PACKAGE OR LIBRARY expected');  // TODO: make localizable

  if Look <> T_NULL then
    MessageEmitter.Emit(mtHint, 'Text after final ''End.'' is ignored by compiler');
end;

procedure TDelphiParser.Block;
begin
  try
    Match(T_BEGIN);
    Match(T_END); Match(T_SEMICOLON);
  except
    // We can continue with parsing and find more errors
    on E: EParserError do
      MessageEmitter.Emit(mtError, E.Message);
  end;
end;

constructor TDelphiParser.Create(Lexer: TLexer);
begin
  inherited Create;
  fLexer := Lexer;
end;

procedure TDelphiParser.Init;
begin
  fLexer.GetToken;
end;

procedure TDelphiParser.Match(Token: Integer);
begin
  if fLexer.CurrToken.Token = Token then
    Next
  else
    raise EParserError.Create('Expected ' + Token.ToString());
end;

procedure TDelphiParser.Next;
begin
  fLexer.GetToken;
end;

function TDelphiParser.get_CurrentToken: Integer;
begin
  Result := fLexer.CurrToken.Token;
end;

procedure TDelphiParser.&Implementation;
begin
  case Look of

    T_USES:
      begin
        Next;
        repeat
          Match(T_IDENT);  // TODO: Delphi for .NET supports namespaces; unit names may contain "." characters
          case Look of
            T_COMMA: Next;
            T_SEMICOLON: begin Match(T_SEMICOLON); break; end;
            else raise EParserError.Create('Expected ; or ,');
          end;
        until False;
      end;

    T_TYPE:
      begin
      end;

    T_VAR:
      begin
      end;

    T_CONST:
      begin
      end;

    T_RESOURCESTRING:
      begin
      end;
  end;
end;

end.

--- NEW FILE: fdcil.IO.Input.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the GNU General Public License
Version 1.1 or later (the "License"); you may not use this file except in
compliance with the License. You may obtain a copy of the License at
http://www.gnu.org/copyleft/gpl.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Initial Developer of the Original Code is Andreas Hausladen.
All Rights Reserved.

$Id: fdcil.IO.Input.pas,v 1.1 2004/08/09 11:16:54 miracle2k Exp $

You may retrieve the latest version of this file at the fdcil homepage,
located at http://fdcil.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

unit fdcil.IO.Input;

interface

uses
  System.IO,
  System.Text;

type
  TBaseInput = class(System.Object)
  protected
    Bytes: array of Byte;
    fEncoding: Encoding;
    fOffset: Integer;
    procedure DetectEncoding;
  public
    constructor Create; overload;
    function GetEverything: string; virtual;

    property Encoding: Encoding read FEncoding;
  end;

  TFileInput = class(TBaseInput)
  public
    constructor Create(FileName: string); overload;

    procedure LoadFromFile(FileName: string);
    function GetEverything: string; override;
  end;

implementation

{ TBaseInput }

constructor TBaseInput.Create;
begin
  inherited Create;
  fEncoding := nil;
end;

function TBaseInput.GetEverything: string;
begin
  if Encoding = nil then DetectEncoding;
  Result := Encoding.GetString(Bytes, fOffset, Length(Bytes) - fOffset)
end;

procedure TBaseInput.DetectEncoding;

  function IsPreamble(const Bytes, Preamble: array of Byte): Boolean;
  var
    Len, i: Integer;
  begin
    Result := False;
    Len := Length(Preamble);
    if Length(Bytes) >= Len then
    begin
      for i := 0 to Len - 1 do
        if (Bytes[i] <> Preamble[i]) then
          Exit;
      Result := True;
    end;
  end;

begin
  if Length(Bytes) > 0 then
  begin
    if fEncoding = nil then
    begin
      if IsPreamble(Bytes, Encoding.Unicode.GetPreamble) then
        fEncoding := Encoding.Unicode
      else if IsPreamble(Bytes, Encoding.BigEndianUnicode.GetPreamble) then
        fEncoding := Encoding.BigEndianUnicode
      else if IsPreamble(Bytes, Encoding.UTF8.GetPreamble) then
        fEncoding := Encoding.UTF8
      else if IsPreamble(Bytes, Encoding.UTF7.GetPreamble) then
        fEncoding := Encoding.UTF7
      else
        fEncoding := Encoding.Default;

      fOffset := Length(Encoding.GetPreamble);
    end
    else
    begin
      fEncoding := Encoding;
      if IsPreamble(Bytes, fEncoding.GetPreamble) then
        fOffset := Length(fEncoding.GetPreamble)
      else
        fOffset := 0;
    end;
  end;
end;

{ TFileInput }

constructor TFileInput.Create(FileName: string);
begin
  inherited Create;
  LoadFromFile(FileName);
end;

function TFileInput.GetEverything: string;
begin
  Result := inherited GetEverything;
end;

procedure TFileInput.LoadFromFile(FileName: string);
var
  SourceFile: FileStream;
begin
  SourceFile := FileStream.Create(FileName, FileMode.Open);
  try                                            
    SetLength(Bytes, SourceFile.Length - SourceFile.Position);
    SourceFile.Read(Bytes, 0, SourceFile.Length);
  finally
    SourceFile.Close;
  end;
end;

end.

--- NEW FILE: fdcil.Tokenizer.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the GNU General Public License
Version 1.1 or later (the "License"); you may not use this file except in
compliance with the License. You may obtain a copy of the License at
http://www.gnu.org/copyleft/gpl.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Initial Developer of the Original Code is Andreas Hausladen.
All Rights Reserved.

$Id: fdcil.Tokenizer.pas,v 1.1 2004/08/09 11:16:54 miracle2k Exp $

You may retrieve the latest version of this file at the fdcil homepage,
located at http://fdcil.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

unit fdcil.Tokenizer;

interface

{$REGION 'Interface uses'}
uses
  System.Collections,
  fdcil.Tokens;
{$ENDREGION}

{$REGION 'class TDelphiTokenizer'}

implementation

{ TDelphiTokenizer }

{function TDelphiTokenizer.GetToken: TToken;
  // Delphi specific hint: System.String[index] is 1-based in Delphi means "idx<CodeLen" => "idx<=CodeLen"
var
  Idx: Integer;
  IsDecimal: Boolean;
  IsExp: Boolean;
  IsExpSign: Boolean;
  Data: string;
  CodeLen: Integer;
  Ch, Ch2: Char;
begin
  Result := TToken.Create;
  Result.Token := T_NULL;

  // local variables are faster than instance fields
  Idx := Index;
  CodeLen := FCodeLen;
  Data := FCode;

  // go to next token and skip white chars
  while Idx <= CodeLen do
  begin
    Ch := Data[Idx];
    if not System.Char.IsWhiteSpace(Ch)  (AnsiChar(Ch) in WhiteSpaces) then
      Break;

    if (Ch = #10) or (Ch = #13) then
      HandleLineFeed(Idx);
    Inc(Idx);
  end;
  if Idx > CodeLen then
    Exit;

  Result.Line := FLineNum;
  Result.Index := Idx;
  Result.Column := Idx - FLineStartIndex;

  FIndex := Idx; // start index for this token

  // preload two chars
  Ch := Data[Idx];
  if Idx + 1 <= CodeLen then
    Ch2 := Data[Idx + 1]
  else
    Ch2 := #0;

  // ------------ string '...' -------------
  if Ch = '''' then
  begin
    Inc(Idx);
    // string
    while Idx <= CodeLen do
    begin
      case Data[Idx] of
        '''':
          begin
            if (Idx <= CodeLen) and (Data[Idx + 1] = '''') then
              Inc(Idx)
            else
              Break;
          end;
        #10, #13:
          begin
            Dec(Idx);
            Break; // line end is string end in Delphi
          end;
      end;
      Inc(Idx);
    end;
    if Idx <= CodeLen then
      Inc(Idx); // include ending "'"
    Result.Token := T_STRING;
  end

  // ------------ comment { ...  -------------
  else if (Ch = '{') then
  begin
    // comment { ...  -> find comment end
    Inc(Idx);
    if Data[Idx] = '$' then
    begin
      Result.Token := T_DIRECTIVE;
      Inc(Idx);
    end
    else
      Result.Token := T_COMMENT;  // TODO: What to do here? I think will should just omit comments

    while Idx <= CodeLen do
    begin
      Ch := Data[Idx];
      if Ch = '' then
        Break;

      if (Ch = #10) or (Ch = #13) then
        HandleLineFeed(Idx);
      Inc(Idx);
    end;
    if Idx <= CodeLen then
      Inc(Idx); // include ending ""
  end

  // ------------ comment (* ... *) -------------
  else if (Ch = '(') and (Ch2 = '*') then
  begin
    // comment (* ... *) -> find comment end
    Inc(Idx, 2);
    if Data[Idx] = '$' then
    begin
      Result.Token := T_DIRECTIVE;             
      Inc(Idx);
    end
    else
      Result.Token := T_COMMENT;  // TODO: What to do here? I think will should just omit comments

    while Idx < CodeLen do // not "<="
    begin
      Ch := Data[Idx];
      if (Ch = '*') and (Data[Idx + 1] = ')') then
        Break;

      if (Ch = #10) or (Ch = #13) then
        HandleLineFeed(Idx);
      Inc(Idx);
    end;
    if Idx <= CodeLen then
      Inc(Idx, 2); // include ending "*)"
  end

  // ------------ comment // ... -------------
  else if (Ch = '/') and (Ch2 = '/') then
  begin
    // comment "// ..." -> find comment end
    Inc(Idx, 2);
    while Idx <= CodeLen do
    begin
      Ch := Data[Idx];
      if (Ch = #10) or (Ch = #13) then
        Break;

      Inc(Idx);
    end;
    Result.Token := T_COMMENT;  // TODO: again: omit?
  end

  // ------------ identifier  begin  variablename -------------
  else if System.Char.IsLetter(Ch) or (Ch = '_') {AnsiChar(Ch) in IdentFirstChars then
  begin
    // identifier
    Inc(Idx);
    while (Idx <= CodeLen) and (System.Char.IsLetterOrDigit(Data[Idx]) or (Data[Idx] = '_')) {(AnsiChar(Data[Idx]) in IdentChars) do
      Inc(Idx);
    Result.Token := T_IDENT;
  end

  // ------------ number  +1  -1  10  1.3  -0.2e10  +0.3E10 -------------
  else if System.Char.IsDigit(Ch) then
  begin
    // number
    Inc(Idx);

    IsDecimal := False;
    IsExp := False;
    IsExpSign := False;

    while Idx <= CodeLen do
    begin
      case Data[Idx] of
        '0'..'9':
          ;

        '.':
          if IsDecimal or IsExp then
            Break
          else
            IsDecimal := True;

        '+', '-':
          if not IsExp or IsExpSign then
            Break
          else
            IsExpSign := True;

        'e', 'E':
          if IsDecimal or IsExp then
            Break
          else
            IsExp := True;

      else
        Break;
      end;
      Inc(Idx);
    end;
    if IsExp or IsDecimal then
      Result.Token := T_FLOAT
    else
      Result.Token := T_INT;
  end

  // ------------ number hex  $xx  -------------
  else if (Ch = '$') and ((Word(Ch2) <= $FF) and (AnsiChar(Ch2) in HexNumberChars)) then
  begin
    // hex number
    Inc(Idx, 2);
    while Idx <= CodeLen do
    begin
      Ch := Data[Idx];
      if (Word(Ch) > $FF) or not (AnsiChar(Ch) in HexNumberChars) then
        Break;

      Inc(Idx);
    end;
    Result.Token := T_INT;
  end

  // ------------ char  #13  #$10 -------------
  else if (Ch = '#') and ((Ch2 = '$') or System.Char.IsDigit(Ch2)) {(AnsiChar(Ch2) in NumberChars)) then
  begin
    // char
    Inc(Idx, 2);
    if (Idx > 1) and (Data[Idx - 1] = '$') then
    begin
      while Idx <= CodeLen do
      begin
        Ch := Data[Idx];
        if (Word(Ch) > $FF) or not (AnsiChar(Ch) in HexNumberChars) then
          Break;

        Inc(Idx);
      end;
    end
    else
    begin
      while (Idx <= CodeLen) and System.Char.IsDigit(Data[idx]) {(AnsiChar(Data[Idx]) in NumberChars) do
        Inc(Idx);
    end;
    Result.Token := T_STRING;
  end

  // ------------ symbol (single char)  -------------
  else if (Word(Ch) <= $FF) and (AnsiChar(Ch) in OneSymbolChars) then
  begin
    Inc(Idx);
    Result.Token := T_ADD_OP;  // TODO: merge detecting of operators into lexer
  end
  else

  // ------------ symbol (multiple chars)  -------------
  begin
    while (Word(Ch) <= $FF) and (AnsiChar(Data[Idx]) in SymbolChars) do
      Inc(Idx);
    Result.Token := T_ADD_OP;   // TODO: merge detecting of operators into lexer
  end;

  Result.Length := Idx - Result.Index;
  // TODO: copy data into token
  //Result.FToken := Copy(Data, FIndex, Idx - FIndex);
  FIndex := Idx;
end;

{ Some files have strange line breaks. }
(*procedure TDelphiTokenizer.HandleLineFeed(var Idx: Integer);
begin
  Inc(FLineNum);
  if Idx + 1 < FCodeLen then
  begin
    if FCode[Idx] = #10 then
    begin
      if FCode[Idx + 1] = #13 then
        Inc(Idx);
    end
    else
    if FCode[Idx] = #13 then
    begin
      if FCode[Idx + 1] = #10 then
        Inc(Idx);
    end
  end;
  FLineStartIndex := Idx + 1;
end;        *)
end.

--- NEW FILE: fdcil.dpr ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the GNU General Public License
Version 1.1 or later (the "License"); you may not use this file except in
compliance with the License. You may obtain a copy of the License at
http://www.gnu.org/copyleft/gpl.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Initial Developer of the Original Code is Michael Elsdörfer.
All Rights Reserved.

$Id: fdcil.dpr,v 1.1 2004/08/09 11:16:54 miracle2k Exp $

You may retrieve the latest version of this file at the fdcil homepage,
located at http://fdcil.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

program fdcil;

{$APPTYPE CONSOLE}

uses
  fdcil.CommandLine in 'fdcil.CommandLine.pas',
  fdcil.Tokens in 'fdcil.Tokens.pas',
  fdcil.Compiler in 'fdcil.Compiler.pas',
  fdcil.Tokenizer in 'fdcil.Tokenizer.pas',
  fdcil.Lexer in 'fdcil.Lexer.pas',
  fdcil.Parser in 'fdcil.Parser.pas',
  fdcil.IO.Input in 'fdcil.IO.Input.pas',
  fdcil.IO.Messages in 'fdcil.IO.Messages.pas',
  fdcil.IO.Messages.Localize in 'fdcil.IO.Messages.Localize.pas',
  fdcil.SymbolTable in 'fdcil.SymbolTable.pas',
  fdcil.ExceptionHandling in 'fdcil.ExceptionHandling.pas';

var
  CommandLineParser: TCommandLineParser;
  Compiler: TDelphiCompiler;

  Lexer: TLexer; Input: TFileInput; SymbolTable: TSymbolTable;
  i: Integer;
begin
  CommandLineParser := TCommandLineParser.Create(True);
  with CommandLineParser.Options[oiSourceFiles] do
    if IsSet then begin
      Compiler := TDelphiCompiler.Create(CommandLineParser);
      Compiler.CompileFile(string(Value));
    end else
      Writeln('FileName is missing');

(*    repeat
      i := Environment.TickCount;
        //Input := TFileInput.Create('F:\Developing\Projects\fdcil\dev\miracle2k\fdcil-test\fdcil.Lexer.pas'); //C:\Programme\Borland\BDS\2.0\source\rtl\Borland.Vcl.Windows.pas');
        Input := TFileInput.Create('C:\Programme\Borland\BDS\2.0\source\rtl\Borland.Vcl.Windows.pas');
        SymbolTable := TSymbolTable.Create; SymbolTable.Init;
        Lexer := TLexer.Create(Input, SymbolTable);
        try
          repeat Lexer.GetToken; (*Console.WriteLine(Lexer.CurrToken.Token.ToString()+ ':' + Lexer.CurrToken.Value)
          until Lexer.CurrToken.Token = T_NULL;
        except
          raise;
        end;
      Console.WriteLine(Environment.TickCount - i);

      Readln;
    until False;*)

  {$IFDEF IDE_DEBUG}
  Readln;
  {$ENDIF}
end.

--- NEW FILE: fdcil.bdsproj ---
(This appears to be a binary file; contents omitted.)

--- NEW FILE: test.pas ---
program test;

uses  test, test2;

begin

end;

--- NEW FILE: fdcil.Lexer.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the GNU General Public License
Version 1.1 or later (the "License"); you may not use this file except in
compliance with the License. You may obtain a copy of the License at
http://www.gnu.org/copyleft/gpl.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Initial Developer of the Original Code is Andreas Hausladen.
All Rights Reserved.

$Id: fdcil.Lexer.pas,v 1.1 2004/08/09 11:16:54 miracle2k Exp $

You may retrieve the latest version of this file at the fdcil homepage,
located at http://fdcil.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

unit fdcil.Lexer;

interface

uses
  System.Collections,
  fdcil.IO.Input,
  fdcil.SymbolTable,
  fdcil.Tokens,
  fdcil.Tokenizer;

{$DEFINE AdRRAY_ACCESS}

const
  Linebreaks = [#10, #13];                      
  WhiteSpace = [#9, #32] + Linebreaks;
  NumberChars = ['0'..'9'];
  NumberFirstChars = NumberChars + ['$'];
  IdentFirstChars = ['a'..'z', 'A'..'Z', '_'];
  IdentChars = IdentFirstChars + NumberChars;
  SymbolChars = ['(', ')', '[', ']', ';', '@', '^', '/', '''', '+', '-',
                 '<', '>', '=', ':', '.', ',', '&', '#'];

type
  TToken = record
    Line: Integer;
    Column: Integer;
    &Index: Integer;
    Token: Integer;
    Value: string;
  end;

  {$IFDEF ARRAY_ACCESS}
  {$REGION 'ArrayAccess Lexer'}
  TLexer = class(System.Object)
  private
    fSymbolTable: TSymbolTable;
  protected
    FCode: string;
    FIndex: Integer;
    FCodeLen: Integer;
    FLineNum: Integer;
    FLineStartIndex: Integer;

    fCurrentToken: TToken;

    procedure HandleLineFeed(var Idx: Integer);
  public
    constructor Create(Input: TBaseInput; SymbolTable: TSymbolTable);

    function GetToken: TToken; overload;
    function GetToken(out p: TToken): Boolean; overload;

    property CurrToken: TToken read fCurrentToken;
  end;
  {$ENDREGION}
  {$ELSE}
  {$REGION 'GetChar Lexer'}
  TLexer = class(System.Object)
  private
    fSymbolTable: TSymbolTable;
  protected
    Data: string;
    Index, Line, Column: Integer;
    Look: Char;
  protected
    fCurrentToken: TToken;
  protected
    procedure GetChar;
  public
    constructor Create(Input: TBaseInput; SymbolTable: TSymbolTable);

    procedure GetToken;

    property CurrToken: TToken read fCurrentToken;
  end;
  {$ENDREGION}
  {$ENDIF}

implementation

{ TLexer }

{$IFDEF ARRAY_ACCESS}
{$REGION 'ArrayAccess Lexer'}
constructor TLexer.Create(Input: TBaseInput; SymbolTable: TSymbolTable);
begin
  inherited Create;
  fSymbolTable := SymbolTable;
  FCode := Input.GetEverything;
  FCodeLen := FCode.Length;
  FIndex := 1;
//  Line := 1;
//  Column := 0;
end;

function TLexer.GetToken: TToken;
  // Delphi specific hint: System.String[index] is 1-based in Delphi means "idx<CodeLen" => "idx<=CodeLen"
var
  Idx: Integer;
  IsDecimal: Boolean;
  IsExp: Boolean;
  IsExpSign: Boolean;
  Data: string;
  CodeLen: Integer;
  Ch, Ch2: Char;
begin
  Result.Token := T_NULL;
  // local variables are faster than instance fields
  Idx := FIndex;
  CodeLen := FCodeLen;
  Data := FCode;

  while (Result.Token = T_NULL) and (Idx < CodeLen) do
  begin

  // go to next token and skip white chars
  while Idx <= CodeLen do
  begin
    Ch := Data[Idx];
    if not System.Char.IsWhiteSpace(Ch) { (AnsiChar(Ch) in WhiteSpaces)} then
      Break;

    if (Ch = #10) or (Ch = #13) then
      HandleLineFeed(Idx);
    Inc(Idx);
  end;
  if Idx > CodeLen then begin
    FIndex := Idx;
    Exit;
  end;

  Result.Line := FLineNum;
  Result.Index := Idx;
  Result.Column := Idx - FLineStartIndex;

  FIndex := Idx; // start index for this token

  // preload two chars
  Ch := Data[Idx];
  if Idx + 1 <= CodeLen then
    Ch2 := Data[Idx + 1]
  else
    Ch2 := #0;

  // ------------ string '...' -------------
  if Ch = '''' then
  begin
    Inc(Idx);
    // string
    while Idx <= CodeLen do
    begin
      case Data[Idx] of
        '''':
          begin
            if (Idx <= CodeLen) and (Data[Idx + 1] = '''') then
              Inc(Idx)
            else
              Break;
          end;
        #10, #13:
          begin
            Dec(Idx);
            Break; // line end is string end in pascal
          end;
      end;
      Inc(Idx);
    end;
    if Idx <= CodeLen then
      Inc(Idx); // include ending "'"
    Result.Token := T_STRING;
  end

  // ------------ comment { ... } -------------
  else if (Ch = '{') then
  begin
    // comment { ... } -> find comment end
    Inc(Idx);
    if Data[Idx] = '$' then
    begin
      Result.Token := T_DIRECTIVE;
      Inc(Idx);
    end;

    while Idx <= CodeLen do
    begin
      Ch := Data[Idx];
      if Ch = '}' then
        Break;

      if (Ch = #10) or (Ch = #13) then
        HandleLineFeed(Idx);
      Inc(Idx);
    end;
    if Idx <= CodeLen then
      Inc(Idx); // include ending "}"
  end

  // ------------ comment (* ... *) -------------
  else if (Ch = '(') and (Ch2 = '*') then
  begin
    // comment (* ... *) -> find comment end
    Inc(Idx, 2);
    if Data[Idx] = '$' then
    begin
      Result.Token := T_DIRECTIVE;
      Inc(Idx);
    end;

    while Idx < CodeLen do // not "<="
    begin
      Ch := Data[Idx];
      if (Ch = '*') and (Data[Idx + 1] = ')') then
        Break;

      if (Ch = #10) or (Ch = #13) then
        HandleLineFeed(Idx);
      Inc(Idx);
    end;
    if Idx <= CodeLen then
      Inc(Idx, 2); // include ending "*)"
  end

  // ------------ comment // ... -------------
  else if (Ch = '/') and (Ch2 = '/') then
  begin
    // comment "// ..." -> find comment end
    Inc(Idx, 2);
    while Idx <= CodeLen do
    begin
      Ch := Data[Idx];
      if (Ch = #10) or (Ch = #13) then
        Break;

      Inc(Idx);
    end;
  end

  // ------------ identifier  begin  variablename -------------
  else if System.Char.IsLetter(Ch) or (Ch = '_') {AnsiChar(Ch) in IdentFirstChars} then
  begin
    // identifier
    Inc(Idx);
    while (Idx <= CodeLen) and (System.Char.IsLetterOrDigit(Data[Idx]) or (Data[Idx] = '_')) {(AnsiChar(Data[Idx]) in IdentChars)} do
      Inc(Idx);
    Result.Token := T_IDENT;
  end

  // ------------ number  +1  -1  10  1.3  -0.2e10  +0.3E10 -------------
  else if System.Char.IsDigit(Ch) then
  begin
    // number
    Inc(Idx);

    IsDecimal := False;
    IsExp := False;
    IsExpSign := False;

    while Idx <= CodeLen do
    begin
      case Data[Idx] of
        '0'..'9':
          ;

        '.':
          if IsDecimal or IsExp then
            Break
          else
            IsDecimal := True;

        '+', '-':
          if not IsExp or IsExpSign then
            Break
          else
            IsExpSign := True;

        'e', 'E':
          if IsDecimal or IsExp then
            Break
          else
            IsExp := True;

      else
        Break;
      end;
      Inc(Idx);
    end;
    Result.Token := T_INT;
  end

  // ------------ number hex  $xx  -------------
  else if (Ch = '$') and ((Word(Ch2) <= $FF) and (AnsiChar(Ch2) in ['0'..'9', 'A'..'Z','a'..'f'])) then
  begin
    // hex number
    Inc(Idx, 2);
    while Idx <= CodeLen do
    begin
      Ch := Data[Idx];
      if (Word(Ch) > $FF) or not (AnsiChar(Ch) in ['0'..'9', 'A'..'Z','a'..'f']) then
        Break;

      Inc(Idx);
    end;
    Result.Token := T_INT;
  end

  // ------------ char  #13  #$10 -------------
  else if (Ch = '#') and ((Ch2 = '$') or System.Char.IsDigit(Ch2)) {(AnsiChar(Ch2) in NumberChars))} then
  begin
    // char
    Inc(Idx, 2);
    if (Idx > 1) and (Data[Idx - 1] = '$') then
    begin
      while Idx <= CodeLen do
      begin
        Ch := Data[Idx];
        //if (Word(Ch) > $FF) or not (AnsiChar(Ch) in HexNumberChars) then
        //  Break;

        Inc(Idx);
      end;
    end
    else
    begin
      while (Idx <= CodeLen) and System.Char.IsDigit(Data[idx]) {(AnsiChar(Data[Idx]) in NumberChars)} do
        Inc(Idx);
    end;
    Result.Token := T_STRING;
  end

  // ------------ symbol (single char)  -------------
  else if (Word(Ch) <= $FF) and (AnsiChar(Ch) in SymbolChars) then
  begin
    case Ch of
      '+': Result.Token := T_ADD_OP;
      '-': Result.Token := T_SUBTRACT_OP;
      '*': Result.Token := T_MULTIPLY_OP;
      '/': Result.Token := T_DIVIDE_OP;
      '(': Result.Token := T_LPAREN;
      ')': Result.Token := T_RPAREN;
      '[': Result.Token := T_LBRACKET;
      ']': Result.Token := T_RBRACKET;
      '<': begin
                Result.Token := T_LE_OP;
//             GetChar;
//             if Look = '=' then begin Result.Token := T_LE_OP; Value := Value + Look; end
//             else begin Result.Token := T_LT_OP; exit; end;
           end;
      '>': begin
                Result.Token := T_LE_OP;
//             GetChar;
//             if Look = '=' then begin Result.Token := T_GE_OP; Value := Value + Look; end
//             else begin Result.Token := T_GT_OP; exit; end;
           end;
      '@': Result.Token := T_AT;
      '^': Result.Token := T_POINTER;
      '=': Result.Token := T_EQUAL;
      ':': Result.Token := T_COLON;
      ';': Result.Token := T_SEMICOLON;
      '.': Result.Token := T_DOT;
      ',': Result.Token := T_COMMA;
      '&': Result.Token := T_AMPERSAND;
      '#': Result.Token := T_SHARP;
      '''': Result.Token := T_HOCHKOMMA;
    //  else raise Exception.Create('Unkown Symbol:' + Look);
    end;
    Inc(Idx);
  end
  else

  // ------------ symbol (multiple chars)  -------------
  begin
    //while (Word(Ch) <= $FF) and (AnsiChar(Data[Idx]) in SymbolChars) do
    //  Inc(Idx);
    //Result.Token := T_ADD_OP;
    Console.WriteLine(Ch);
    Console.WriteLine(FLineNum);
    sleep(1000);
  end;

  end;

  //Console.WriteLine(FIndex);
  //sleep(1000);

  Result.Value := Copy(Data, FIndex, Idx - FIndex);
  FIndex := Idx;
  fCurrentToken := Result;
end;

{ Some files have strange line breaks. }
procedure TLexer.HandleLineFeed(var Idx: Integer);
begin
  Inc(FLineNum);
  if Idx + 1 < FCodeLen then
  begin
    if FCode[Idx] = #10 then
    begin
      if FCode[Idx + 1] = #13 then
        Inc(Idx);
    end
    else
    if FCode[Idx] = #13 then
    begin
      if FCode[Idx + 1] = #10 then
        Inc(Idx);
    end
  end;
  FLineStartIndex := Idx + 1;
end;

function TLexer.GetToken(out p: TToken): Boolean;
begin
  p := GetToken;
  Result := p.Token <> T_NULL;
end;

{$ENDREGION}
{$ELSE}
{$REGION 'GetChar Lexer'}
constructor TLexer.Create(Input: TBaseInput; SymbolTable: TSymbolTable);
begin
  inherited Create;
  fSymbolTable := SymbolTable;
  Data := Input.GetEverything;
  Index := 0;
  Line := 1;
  Column := 0;
  Look := #0;
  GetChar;
end;

procedure TLexer.GetToken;
var
  Token: Integer;
  Value: string;

  procedure HandleLineBreak;
  begin
    // TODO: Is this correct?
    if Look in Linebreaks then
    begin
      if Look = #13 then begin
        GetChar;
        if Look = #10 then GetChar;
      end
      else if Look = #10 then begin
        GetChar;
        if Look = #13 then GetChar;
      end;
      Inc(Line);
      Column := 0;
    end;
  end;

  procedure Comment;
  begin
    repeat
      GetChar;
      if Look in LineBreaks then
        HandleLineBreak;
      if Look = '*' then begin
        GetChar;
        if Look = ')' then break;
      end
    until False;
    GetChar;
  end;

  procedure LineComment;
  begin
    repeat
      GetChar;
    until Look in Linebreaks;
    HandleLineBreak;
  end;

  procedure CurlyComment;
  begin
    repeat
      GetChar;
      if Look = '}' then break
      else if Look in LineBreaks then
        HandleLineBreak;
    until False;
    GetChar;
  end;

  procedure CompilerDirective;   // TODO: currently stops at the first whitespace; fix it
  begin
    Token := T_DIRECTIVE;
    GetChar; 
    while (Look in IdentFirstChars) do begin
      GetChar;
      Value := Value + Look;
    end;
  end;

  procedure &Symbol;     // TODO: use symbol table to load tokens
  begin
    Value := Look;
    case Look of
      '+': Token := T_ADD_OP;
      '-': Token := T_SUBTRACT_OP;
      '*': Token := T_MULTIPLY_OP;
      '/': Token := T_DIVIDE_OP;
      '(': Token := T_LPAREN;
      ')': Token := T_RPAREN;
      '[': Token := T_LBRACKET;
      ']': Token := T_RBRACKET;
      '<': begin
             GetChar;
             if Look = '=' then begin Token := T_LE_OP; Value := Value + Look; end
             else begin Token := T_LT_OP; exit; end;
           end;
      '>': begin
             GetChar;
             if Look = '=' then begin Token := T_GE_OP; Value := Value + Look; end
             else begin Token := T_GT_OP; exit; end;
           end;
      '@': Token := T_AT;
      '^': Token := T_POINTER;
      '=': Token := T_EQUAL;
      ':': Token := T_COLON;
      ';': Token := T_SEMICOLON;
      '.': Token := T_DOT;
      ',': Token := T_COMMA;
      '&': Token := T_AMPERSAND;
      '#': Token := T_SHARP;
      '''': Token := T_HOCHKOMMA;
      else raise Exception.Create('Unkown Symbol:' + Look);
    end;
    GetChar;
  end;

  procedure &String;
  begin
    Token := T_STRING;
    repeat
      GetChar;
      if Look = '''' then begin
        GetChar;
        if not (Look = '''') then break
        else Value := Value + '''';
      end;
      Value := Value + Look;
    until False;
    GetChar;
  end;

  procedure Number;
  begin
    Token := T_INT;
    Value := Look;
    repeat
      GetChar;
      if not (Look in NumberChars) then break
      else Value := Value + Look;
    until False;
  end;

  procedure Ident;
  begin
    Value := Look;
    repeat
      GetChar;
      if not (Look in IdentChars) then break
      else Value := Value + Look;
    until False;

    Token := fSymbolTable.QueryKeyword(Value);
    if Token = T_NULL then Token := T_IDENT;
  end;

begin
  Token := T_NULL;

  while (Token = T_NULL) and (Look <> #0) do
  begin
    //  Whitespace
    while (Look in WhiteSpace) do begin
      if Look in Linebreaks then
        HandleLineBreak
      else
        GetChar;
    end;

    case Look of
      '}':
        begin
          // TODO: remove this! we need a real fix!
          GetChar;
        end;

      '(':
         begin
           GetChar;
           if Look = '*' then begin
             GetChar;
             if Look = '$' then CompilerDirective;
             Comment;
           end;
         end;

      '{':                                                             
        begin
          GetChar;                 
          if Look = '$' then CompilerDirective;
          CurlyComment;
        end;

      '/':
        begin
          GetChar;
          if Look = '/' then LineComment
          else Token := T_DIVIDE_OP;
        end;

      '''':
        &String;

      else begin
        if Look in IdentFirstChars then Ident
        else if Look in NumberFirstChars then Number
        else if Look in SymbolChars then Symbol
        //else raise Exception.Create('Invalid character');
      end;
    end;
  end;

  fCurrentToken.Index := Index;
  fCurrentToken.Line := Line;
  fCurrentToken.Column := Column;
  fCurrentToken.Token := Token;
  fCurrentToken.Value := Value;
end;

procedure TLexer.GetChar;
begin
  Inc(Index);
  if Index <= Data.Length then
    Look := Data[Index]
  else
    Look := #0;
  Inc(Column);
end;

{$ENDREGION}
{$ENDIF}
end.

--- NEW FILE: fdcil.Tokens.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the GNU General Public License
Version 1.1 or later (the "License"); you may not use this file except in
compliance with the License. You may obtain a copy of the License at
http://www.gnu.org/copyleft/gpl.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Initial Developer of the Original Code is Michael Elsdörfer.
All Rights Reserved.

$Id: fdcil.Tokens.pas,v 1.1 2004/08/09 11:16:54 miracle2k Exp $

You may retrieve the latest version of this file at the fdcil homepage,
located at http://fdcil.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

unit fdcil.Tokens;

interface

const
  // Special "null" token, indicating end of input
  T_NULL             = 0000;

  // Root tokens
  T_PROGRAM          = 1001;
  T_UNIT             = 1002;
  T_LIBRARY          = 1003;
  T_PACKAGE          = 1004;

  // Basic tokens
  T_BEGIN            = 2001;
  T_END              = 2002;
  T_IF               = 2003;
  T_THEN             = 2004;
  T_ELSE             = 2005;
  T_INTERFACE        = 2006;
  T_IMPLEMENTATION   = 2007;
  T_USES             = 2008;
  T_TYPE             = 2009;
  T_CONST            = 2010;
  T_VAR              = 2011;
  T_RESOURCESTRING   = 2012;

  // Operators
  T_ADD_OP           = 3001;
  T_SUBTRACT_OP      = 3002;
  T_MULTIPLY_OP      = 3003;
  T_INT_DIVIDE_OP    = 3004;
  T_DIVIDE_OP        = 3005;
  T_GT_OP            = 3006;
  T_LT_OP            = 3007;
  T_GE_OP            = 3008;
  T_LE_OP            = 3009;
  T_ASSIGN_OP        = 3010;
  T_MODULO           = 3011;

  // Symbols
  T_LPAREN           = 4001;
  T_RPAREN           = 4002;
  T_LBRACKET         = 4003;
  T_RBRACKET         = 4003;
  T_COLON            = 4005;
  T_SEMICOLON        = 4006;
  T_AT               = 4007;
  T_POINTER          = 4008;
  T_EQUAL            = 4009;
  T_DOT              = 4010;
  T_COMMA            = 4011;
  T_SHARP            = 4012;
  T_AMPERSAND        = 4013;
  T_HOCHKOMMA        = 4014;

  // Other tokens
  T_IDENT            = 5001;
  T_STRING           = 5002;
  T_INT              = 5003;
  T_FLOAT            = 5004;
  T_DIRECTIVE        = 5010;

implementation

end.

--- NEW FILE: fdcil.CommandLine.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the GNU General Public License
Version 1.1 or later (the "License"); you may not use this file except in
compliance with the License. You may obtain a copy of the License at
http://www.gnu.org/copyleft/gpl.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Initial Developer of the Original Code is Michael Elsdörfer.
All Rights Reserved.

$Id: fdcil.CommandLine.pas,v 1.1 2004/08/09 11:16:54 miracle2k Exp $

You may retrieve the latest version of this file at the fdcil homepage,
located at http://fdcil.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

unit fdcil.CommandLine;

interface

uses
  System.Collections;

type
  ECommandLineParser = class(Exception);

  TCommandLineOptionID = (
      oiSourceFiles,                // The list of source files to compile
      oiOutputFileName              // Specify an output filename
    );

  TCommandLineOptionType = (
      otBool,                       // Either option is specified or missing
      otInt,                        // Option takes a numeric argument
      otString,                     // Option is a string agument
      otArrayList                   // Option can take multiple arguments
    );

  // Represents an option; Stores not only definition related data (which is
  // initialized at start up), but also holds the Values of the option, after
  // the command line was parsed.
  TCommandLineOption = class
  public
    ID: TCommandLineOptionID;
    &Type: TCommandLineOptionType;
    Name: string;                   // Use '' to specify default option
    Value: System.Object;           // Depends on type of option
    IsSet: boolean;                 // User has specified this option

    constructor Create(ID: TCommandLineOptionID; &Type: TCommandLineOptionType;
      Name: string);
  end;

  TCommandLineParser = class(System.Object)
  public
    // List of available options
    fOptions: System.Collections.ArrayList;
    // get/set accessors
    function get_Options(Option: TCommandLineOptionID): TCommandLineOption;
    function get_OptionsByIndex(Index: Integer): TCommandLineOption;
    function get_OptionCount: Integer;
    function get_OptionValues(Option: TCommandLineOptionID): System.Object;
    function get_OptionArrayListValues(
      Option: TCommandLineOptionID): System.Collections.ArrayList;
    function get_OptionBoolValues(
      Option: TCommandLineOptionID): Boolean;
    function get_OptionIntValues(
      Option: TCommandLineOptionID): Integer;
    function get_OptionStringValues(
      Option: TCommandLineOptionID): string;
    function GetDefaultOption: TCommandLineOption;
  protected
    procedure InitializeOptionList;
    procedure DefineOption(ID: TCommandLineOptionID;
      &Type: TCommandLineOptionType; Name: string);
    procedure AssertOptionType(Option: TCommandLineOptionID;
      RequiredType: TCommandLineOptionType);
  public
    constructor Create(AutoParse: Boolean = True);

    procedure ParseCommandLine;

    property OptionsByIndex[Index: Integer]: TCommandLineOption
      read get_OptionsByIndex;
    property OptionCount: Integer read get_OptionCount;
    property Options[Option: TCommandLineOptionID]: TCommandLineOption
      read get_Options;

    property DefaultOption: TCommandLineOption read GetDefaultOption;

    property OptionValues[Option: TCommandLineOptionID]: System.Object
      read get_OptionValues;
    property OptionBoolValues[Option: TCommandLineOptionID]: Boolean
      read get_OptionBoolValues;
    property OptionStringValues[Option: TCommandLineOptionID]: string
      read get_OptionStringValues;
    property OptionIntValues[Option: TCommandLineOptionID]: Integer read
      get_OptionIntValues;
    property OptionArrayListValues[Option: TCommandLineOptionID]:
      System.Collections.ArrayList read get_OptionArrayListValues;
  end;

implementation

{ TCommandLineParser }

procedure TCommandLineParser.AssertOptionType(Option: TCommandLineOptionID;
  RequiredType: TCommandLineOptionType);
begin
  if Options[Option].&Type <> RequiredType then
    raise ECommandLineParser.Create('Option types do not match');
end;

constructor TCommandLineParser.Create(AutoParse: Boolean);
begin
  inherited Create;
  fOptions := ArrayList.Create;
  InitializeOptionList;
  if AutoParse then
    ParseCommandLine;
end;

procedure TCommandLineParser.DefineOption(ID: TCommandLineOptionID;
  &Type: TCommandLineOptionType; Name: string);
var
  NewOption: TCommandLineOption;
begin
  NewOption := TCommandLineOption.Create(ID, &Type, Name);
  fOptions.Add(NewOption);
end;

function TCommandLineParser.GetDefaultOption: TCommandLineOption;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to OptionCount - 1 do
    if OptionsByIndex[i].Name = '' then begin
      Result := OptionsByIndex[i];
      break;
    end;
end;

function TCommandLineParser.get_OptionArrayListValues(
  Option: TCommandLineOptionID): ArrayList;
begin
  AssertOptionType(Option, otArrayList);
  Result := ArrayList(OptionValues[Option]);
end;

function TCommandLineParser.get_OptionBoolValues(
  Option: TCommandLineOptionID): Boolean;
begin
  AssertOptionType(Option, otBool);
  Result := Boolean(OptionValues[Option]);
end;

function TCommandLineParser.get_OptionCount: Integer;
begin
  Result := fOptions.Count;
end;

function TCommandLineParser.get_OptionIntValues(
  Option: TCommandLineOptionID): Integer;
begin
  AssertOptionType(Option, otInt);
  Result := Integer(OptionValues[Option]);
end;

function TCommandLineParser.get_Options(Option: TCommandLineOptionID):
  TCommandLineOption;
var
  i: Integer;
begin
    Result := nil;
  for i := 0 to OptionCount - 1 do
    if OptionsByIndex[i].ID = Option then begin
      Result := OptionsByIndex[i];
      break;
    end;
end;

function TCommandLineParser.get_OptionsByIndex(
  Index: Integer): TCommandLineOption;
begin
  Result := TCommandLineOption(fOptions[Index]);
end;

function TCommandLineParser.get_OptionStringValues(
  Option: TCommandLineOptionID): string;
begin
  AssertOptionType(Option, otString);
  Result := string(OptionValues[Option]);
end;

function TCommandLineParser.get_OptionValues(
  Option: TCommandLineOptionID): System.Object;
begin
  Result := Options[Option].Value;
end;

procedure TCommandLineParser.InitializeOptionList;
begin
  DefineOption(oiSourceFiles,     otString,      '');   // '' = default option
  DefineOption(oiOutputFileName,  otString,      'X');
end;

procedure TCommandLineParser.ParseCommandLine;
var
  i: Integer;
  Arguments: array of string;
  ArgName: string;
begin
  Arguments := Environment.GetCommandLineArgs;
  i := 1;
  while i <= High(Arguments) do
  begin
    if Arguments[i][1] = '-' then begin
      // TODO: split into option name and option value + store the data
      ArgName := Arguments[i].Substring(2);
    end
    else if GetDefaultOption <> nil then begin
      GetDefaultOption.IsSet := True;
      case GetDefaultOption.&Type of
        otString: GetDefaultOption.Value := Arguments[i];
        else raise ECommandLineParser.Create('Unsupported default argument');
      end;
    end;
    Inc(I);
  end;
end;

{ TCommandLineOption }

constructor TCommandLineOption.Create(ID: TCommandLineOptionID;
  &Type: TCommandLineOptionType; Name: string);
begin
  inherited Create; 
  Self.ID := ID;
  Self.&Type := &Type;
  case &Type of
    otBool:        Self.Value := System.Object(False);
    otInt:         Self.Value := System.Object(0);
    otString:      Self.Value := '';
    otArrayList:   Self.Value := ArrayList.Create;
  end;
  Self.Name := Name;
  Self.Value := nil;
  Self.IsSet := False;
end;

end.

--- NEW FILE: fdcil.IO.Messages.Localize.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the GNU General Public License
Version 1.1 or later (the "License"); you may not use this file except in
compliance with the License. You may obtain a copy of the License at
http://www.gnu.org/copyleft/gpl.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

$Id: fdcil.IO.Messages.Localize.pas,v 1.1 2004/08/09 11:16:54 miracle2k Exp $

You may retrieve the latest version of this file at the fdcil homepage,
located at http://fdcil.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

unit fdcil.IO.Messages.Localize;

interface

resourcestring
  E_FILE_NOT_FOUND = 'File not found: ''{0}''';

implementation

end.

--- NEW FILE: fdcil.IO.Messages.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the GNU General Public License
Version 1.1 or later (the "License"); you may not use this file except in
compliance with the License. You may obtain a copy of the License at
http://www.gnu.org/copyleft/gpl.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

$Id: fdcil.IO.Messages.pas,v 1.1 2004/08/09 11:16:54 miracle2k Exp $

You may retrieve the latest version of this file at the fdcil homepage,
located at http://fdcil.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

unit fdcil.IO.Messages;

interface

type
  TMessageType = (mtFatal, mtError, mtHint);

  TMessageEmitter = class(System.Object)
  protected
    function MessageTypeToString(MessageType: TMessageType): string;
  public
    procedure Emit(MessageType: TMessageType; Message: string);
  end;

function MessageEmitter: TMessageEmitter;

implementation

var
  InternalMessageEmitter: TMessageEmitter = nil;

function MessageEmitter: TMessageEmitter;
begin
  if InternalMessageEmitter = nil then
    InternalMessageEmitter := TMessageEmitter.Create;
  Result := InternalMessageEmitter;
end;

{ TMessageEmitter }

procedure TMessageEmitter.Emit(MessageType: TMessageType; Message: string);
begin
  Console.WriteLine('[' + MessageTypeToString(MessageType) + '] ' + Message);
end;

function TMessageEmitter.MessageTypeToString(
  MessageType: TMessageType): string;
begin
  case MessageType of
    mtFatal: Result := 'Fatal Error';
    mtError: Result := 'Error';
    mtHint:  Result := 'Hint';
    else
      raise Exception.Create('Description for message type is missing');
  end;
end;

end.

--- NEW FILE: fdcil.SymbolTable.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the GNU General Public License
Version 1.1 or later (the "License"); you may not use this file except in
compliance with the License. You may obtain a copy of the License at
http://www.gnu.org/copyleft/gpl.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

$Id: fdcil.SymbolTable.pas,v 1.1 2004/08/09 11:16:54 miracle2k Exp $

You may retrieve the latest version of this file at the fdcil homepage,
located at http://fdcil.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

unit fdcil.SymbolTable;

interface

uses
  System.Collections;

type
  TSymbol = record
    IsSpecial: Boolean;
    Token: Integer;
  end;

  TSymbolTable = class(System.Object)
  private
    fSymbols: HashTable;
  protected
    function MakeSymbol(IsSpecial: Boolean; Token: Integer): TSymbol;
  public
    constructor Create;
    procedure Init;

    procedure AddKeyword(Name: string; Symbol: TSymbol);
    function QueryKeyword(Keyword: string): Integer;
  end;

implementation

uses
  fdcil.Tokens;

{ TSymbolTable }

procedure TSymbolTable.AddKeyword(Name: string; Symbol: TSymbol);
begin
  fSymbols.Add(Symbol, Name);
  fSymbols.Add(Name, Symbol);
end;

constructor TSymbolTable.Create;
begin
  inherited;
  fSymbols := Hashtable.Create;
end;

procedure TSymbolTable.Init;
begin
  AddKeyword('program',   MakeSymbol(True, T_PROGRAM));
  AddKeyword('unit',      MakeSymbol(True, T_UNIT));
  AddKeyword('library',   MakeSymbol(True, T_LIBRARY));
  AddKeyword('package',   MakeSymbol(True, T_PACKAGE));
  AddKeyword('begin',     MakeSymbol(True, T_BEGIN));
  AddKeyword('end',       MakeSymbol(True, T_END));
  AddKeyword('if',        MakeSymbol(True, T_IF));
  AddKeyword('then',      MakeSymbol(True, T_THEN));
  AddKeyword('else',      MakeSymbol(True, T_ELSE));
  AddKeyword('div',       MakeSymbol(True, T_INT_DIVIDE_OP));
  AddKeyword('mod',       MakeSymbol(True, T_MODULO));
  AddKeyword('uses',      MakeSymbol(True, T_USES));

  AddKeyword('<',         MakeSymbol(True, T_LT_OP));
  AddKeyword('>',         MakeSymbol(True, T_GT_OP));
end;

function TSymbolTable.MakeSymbol(IsSpecial: Boolean;
  Token: Integer): TSymbol;
begin
  Result.IsSpecial := IsSpecial;
  Result.Token := Token;
end;

function TSymbolTable.QueryKeyword(Keyword: string): Integer;
var
  HashValue: System.Object;
begin
  Result := T_NULL;
  HashValue := fSymbols.Item[Keyword];
  if HashValue <> nil then
    Result := TSymbol(HashValue).Token;
end;

end.

--- NEW FILE: fdcil.cfg ---
-$A-
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-vn
-AWinTypes=Borland.Vcl.Windows;WinProcs=Borland.Vcl.Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M4096,1048576
-K$00400000
-DIDE_DEBUG
-LU""

--- NEW FILE: fdcil.ExceptionHandling.pas ---
{-----------------------------------------------------------------------------
The contents of this file are subject to the GNU General Public License
Version 1.1 or later (the "License"); you may not use this file except in
compliance with the License. You may obtain a copy of the License at
http://www.gnu.org/copyleft/gpl.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

$Id: fdcil.ExceptionHandling.pas,v 1.1 2004/08/09 11:16:54 miracle2k Exp $

You may retrieve the latest version of this file at the fdcil homepage,
located at http://fdcil.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}

unit fdcil.ExceptionHandling;

interface

type
  EParserError = class(System.Exception);

implementation

end.