qlexlib.pas

TxQuery is an SQL engine implemented in a TDataSet descendant component, that can parse SQL syntax,

Unit QLEXLIB;

(* Lex Library Unit for TP Lex Version 3.0, 6-17-91 AG *)
(* adapted to Delphi 3,4,5,6 6/8/2002 *)

{$I XQ_FLAG.INC}
Interface

Uses Classes;

Const
  nl = #10; (* newline character *)
  max_chars = maxint;
  intial_bufsize = 16384;

Type

  PCharArray = ^TCharArray;
  TCharArray = array [1..max_chars] of Char;

  TCustomLexer = Class
  private
    function GetBuf(Index: Integer): Char;
    procedure SetBuf(Index: Integer; Value: Char);
  Public
    //yyinput, yyoutput : Text;      (* input and output file            *)
    //yyerrorfile       : Text;      (* standard error file              *)
    yyinput, yyoutput: TStream; (* input and output file            *)
    yyerrorfile: TStream; (* standard error file              *)
    yyline: String; (* current input line               *)
    yylineno, yycolno: Integer; (* current input position           *)
    //yytext: String; (* matched text                     *)
    yyTextBuf         : PCharArray;
    yyTextLen         : Integer;
    yyTextBufSize     : Integer;
    (*   (should be considered r/o)     *)
{yyleng            : Byte         (* length of matched text *)
absolute yytext;                incompatible with Delphi 2.0       }

(* I/O routines:

The following routines get_char, unget_char and put_char are used to
implement access to the input and output files. Since \n (newline) for
Lex means line end, the I/O routines have to translate MS-DOS line ends
(carriage-return/line-feed) into newline characters and vice versa. Input
is buffered to allow rescanning text (via unput_char).

The input buffer holds the text of the line to be scanned. When the input
buffer empties, a new line is obtained from the input stream. Characters
can be returned to the input buffer by calls to unget_char. At end-of-
file a null character is returned.

The input routines also keep track of the input position and set the
yyline, yylineno, yycolno variables accordingly.

Since the rest of the Lex library only depends on these three routines
(there are no direct references to the yyinput and yyoutput files or
to the input buffer), you can easily replace get_char, unget_char and
put_char by another suitable set of routines, e.g. if you want to read
from/write to memory, etc. *)

    Function get_char: Char;
    (* obtain one character from the input file (null character at end-of-
       file) *)

    Procedure unget_char( c: Char );
    (* return one character to the input file to be reread in subsequent
       calls to get_char *)

    Procedure put_char( c: Char );
    (* write one character to the output file *)

  (* Utility routines: *)

    Procedure echo;
    (* echoes the current match to the output stream *)

    Procedure yymore;
    (* append the next match to the current one *)

    Procedure yyless( n: Integer );
    (* truncate yytext to size n and return the remaining characters to the
       input stream *)

    Procedure reject;
    (* reject the current match and execute the next one *)

    (* reject does not actually cause the input to be rescanned; instead,
       internal state information is used to find the next match. Hence
       you should not try to modify the input stream or the yytext variable
       when rejecting a match. *)

    Procedure returni( n: Integer );
    Procedure returnc( c: Char );
    (* sets the return value of yylex *)

    Procedure start( state: Integer );
    (* puts the lexical analyzer in the given start state; state=0 denotes
       the default start state, other values are user-defined *)

  (* yywrap:

     The yywrap function is called by yylex at end-of-file (unless you have
     specified a rule matching end-of-file). You may redefine this routine
     in your Lex program to do application-dependent processing at end of
     file. In particular, yywrap may arrange for more input and return false
     in which case the yylex routine resumes lexical analysis. *)

    Function yywrap: Boolean;
    (* The default yywrap routine supplied here closes input and output
       files and returns true (causing yylex to terminate). *)

  (* The following are the internal data structures and routines used by the
     lexical analyzer routine yylex; they should not be used directly. *)

    Function yylex: Integer; Virtual; Abstract;
    (* this function must be overriden by the Lexer descendent in order
       to provide the lexing service *)
    constructor Create;
    destructor Destroy; override;
    procedure CheckBuffer(Index : integer);
    procedure CheckyyTextBuf(Size : integer);
    procedure GetyyText(var s : string);
    property Buf[Index: Integer]: Char read GetBuf write SetBuf;

  Protected
    yystate: Integer; (* current state of lexical analyzer *)
    yyactchar: Char; (* current character *)
    yylastchar: Char; (* last matched character (#0 if none) *)
    yyrule: Integer; (* matched rule *)
    yyreject: Boolean; (* current match rejected? *)
    yydone: Boolean; (* yylex return value set? *)
    yyretval: Integer; (* yylex return value *)
    bufptr: Integer;
    //buf: Array[1..max_chars] Of Char;
    bufSize : Integer;
    FBuf : PCharArray;

    Procedure yynew;
    (* starts next match; initializes state information of the lexical
       analyzer *)

    Procedure yyscan;
    (* gets next character from the input stream and updates yytext and
       yyactchar accordingly *)

    Procedure yymark( n: Integer );
    (* marks position for rule no. n *)

    Procedure yymatch( n: Integer );
    (* declares a match for rule number n *)

    Function yyfind( Var n: Integer ): Boolean;
    (* finds the last match and the corresponding marked position and
       adjusts the matched string accordingly; returns:
       - true if a rule has been matched, false otherwise
       - n: the number of the matched rule *)

    Function yydefault: Boolean;
    (* executes the default action (copy character); returns true unless
       at end-of-file *)

    Procedure yyclear;
    (* reinitializes state information after lexical analysis has been
       finished *)

    Procedure fatal( msg: String );
    (* writes a fatal error message and halts program *)

  End; (* TCustomLexeer *)

Function eof( aStream: Tstream ): boolean;
Procedure readln( aStream: TStream; Var aLine: String );
Procedure writeln( aStream: TStream; aline: String );
Procedure write( aStream: TStream; aLine: String );

Implementation

uses
  math;

(* utility procedures *)

Function eof( aStream: Tstream ): boolean;
Begin
  result := aStream.position >= aStream.size;
End;

Procedure readln( aStream: TStream; Var aLine: String );
Var
  //aBuffer: String;
  CRBuf : string [2];
  trouve: boolean;
  unCar: Char;
  Buf : PChar;
  BufSize : Integer;
  i : Integer;

  procedure CheckBuffer;
  begin
    repeat
      if i >= BufSize then
      begin
        BufSize := max (BufSize * 2, 256);
        ReallocMem (Buf, BufSize);
      end;
    until i < BufSize;
  end;

Begin
  // ??????
  //aBuffer := '';
  BufSize := 256;
  i := 0;
  GetMem (Buf, BufSize);
  try
    trouve := false;
    Repeat
      aStream.read( unCar, 1 );
      If aStream.Position >= aStream.Size Then
      Begin
        trouve := true;
        if not (unCar in [#10,#13]) then
        begin
          //aLine := aBuffer+unCar
          Inc (i);
          CheckBuffer;
          Move (uncar, Buf [i - 1], 1);
          SetLength (aLine, i);
          Move (Buf^, aLine [1], i);
        end else
        begin
          if i > 0 then
          begin
            SetLength (aLine, i);
            Move (Buf^, aLine [1], i);
          end else
            aLine:='';
        end;
      End
      Else
        Case unCar Of
          #10:
            Begin
              //aLine := aBuffer;
              if i>0 then
              begin
                SetLength (aLine, i);
                Move (Buf^, aLine [1], i);
                trouve := true;
              end else
                aLine:= '';
            End;
          #13:
            Begin
              aStream.read( unCar, 1 );
              If unCar = #10 Then
              Begin
                //aLine := aBuffer;
                if i > 0 then
                begin
                  SetLength (aLine, i);
                  Move (Buf^, aLine [1], i);
                  trouve := true;
                end else
                  aLine:='';
              End
              Else
              Begin
                Inc (i, 2);
                CheckBuffer;
                CRBuf := #13 + unCar;
                Move (CRBuf [1], Buf [i - 2], 2);
                //aBuffer := aBuffer + #13 + unCar;
              End;
            End;
        Else
          //aBuffer := aBuffer + unCar;
        begin
          Inc (i);
          CheckBuffer;
          Move (unCar, Buf [i - 1], 1);
          //aBuffer := aBuffer+unCar;
        end;

        End;
    Until trouve;
  finally
    FreeMem (Buf, BufSize);
  end;
End;

Procedure writeln( aStream: TStream; aline: String );
Const
  FINLIGNE: Array[1..2] Of char = ( #13, #10 );
Begin
  // ??????
  write( aStream, aLine );
  aStream.write( FINLIGNE, 2 );
End;

Procedure write( aStream: TStream; aLine: String );
Const
  WRITEBUFSIZE = 8192;
Var
  aBuffer: Array[1..WRITEBUFSIZE] Of char;
  j, nbuf: integer;
  k, nreste: integer;
Begin
  nbuf := length( aLine ) Div WRITEBUFSIZE;
  nreste := length( aLine ) - ( nbuf * WRITEBUFSIZE );
  For j := 0 To nbuf - 1 Do
  Begin
    For k := 1 To WRITEBUFSIZE Do
      aBuffer[k] := aLine[j * WRITEBUFSIZE + k];
    aStream.write( aBuffer, WRITEBUFSIZE );
  End;
  For k := 1 To nreste Do
    aBuffer[k] := aLine[nbuf * WRITEBUFSIZE + k];
  aStream.write( aBuffer, nreste );
End;