ezlexlib.pas

很管用的GIS控件

Unit EzLexLib;

// The changes made to this library are for increased performance

(* Standard Lex library unit for TP Lex Version 3.0.
   2-11-91 AG *)

(* Extended by Thierry Coq, sept. 1997                                        *)
(* adapted to Delphi 3                                                        *)
(* Notes :                                                                    *)
(*         - input and output files cannot be used by non-console Delphi      *)
(*           applications, so streams have to be used.                        *)
(*         - the current lexlib library is not object, and therefore one      *)
(*           cannot load several lexers, for example.                         *)
(*           => The lexlib interface is transformed into a Lexer object       *)
(*              which can then be extended by the lex program.                *)

Interface

(* The Lex library unit supplies a collection of variables and routines
   needed by the lexical analyzer routine yylex and application programs
   using Lex-generated lexical analyzers. It also provides access to the
   input/output streams used by the lexical analyzer and the text of the
   matched string, and provides some utility functions which may be used
   in actions.

   This `standard' version of the LexLib unit is used to implement lexical
   analyzers which read from and write to MS-DOS files (using standard input
   and output, by default). It is suitable for many standard applications
   for lexical analyzers, such as text conversion tools or compilers.

   However, you may create your own version of the LexLib unit, tailored to
   your target applications. In particular, you may wish to provide another
   set of I/O functions, e.g., if you want to read from or write to memory
   instead to files, or want to use different file types. *)

(* Variables:

   The variable yytext contains the current match, yyleng its length.
   The variable yyline contains the current input line, and yylineno and
   yycolno denote the current input position (line, column). These values
   are often used in giving error diagnostics (however, they will only be
   meaningful if there is no rescanning across line ends).

   The variables yyinput and yyoutput are the text files which are used
   by the lexical analyzer. By default, they are assigned to standard
   input and output, but you may change these assignments to fit your
   target application (use the Turbo Pascal standard routines assign,
   reset, and rewrite for this purpose). *)

(* Adaptation to Delphi 3 and object-oriented approach :
   - a TCustomLexer class is created from the previous LexLib standard lib,
   - it inherits from TComponent in order to reuse it.
   - files (Text) are transformed into streams.
   *)
Uses Classes;

Const
  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           *)
    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;
    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( const 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; const aline: String );
Procedure write( aStream: TStream; const aLine: String );

Implementation

uses
  math;

const
  nl = #10; (* newline character *)

(* utility procedures *)

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

Procedure readln( aStream: TStream; Var aLine: String );
Var
  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
  // ??????
  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
          Inc (i);
          CheckBuffer;
          Move (uncar, Buf [i - 1], 1);
          SetLength (aLine, i);
          Move (Buf^, aLine [1], i);
        end
        else
        begin
          //aLine := aBuffer;
          SetLength (aLine, i);
          Move (Buf^, aLine [1], i);
        end;
      End
      Else
        Case unCar Of
          #10:
            Begin
              if i>0 then
              begin
                SetLength (aLine, i);
                Move (Buf^, aLine [1], i);
              end else
                aLine:='';
              trouve := true;
            End;
          #13:
            Begin
              aStream.read( unCar, 1 );
              If unCar = #10 Then
              Begin
                if i>0 then
                begin
                  SetLength (aLine, i);
                  Move (Buf^, aLine [1], i);
                end else
                  aLine:= '';
                trouve := true;
              End
              Else
              Begin
                Inc (i, 2);
                CheckBuffer;
                CRBuf := #13 + unCar;
                Move (CRBuf [1], Buf [i - 2], 2);
              End;
            End;
        Else
          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; const aline: String );
Const
  FINLIGNE: Array[1..2] Of char = ( #13, #10 );
Begin
  // ??????
  write( aStream, aLine );
  aStream.write( FINLIGNE, 2 );
End;