unit DelphiToken;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StringOperations;
const
WM_TOKENERROR = WM_USER + 2034;
const
CHR_SYMHEADER = 1; //当第1位为1时,可以做为标识符的字符//
CHR_NUMHEADER = 2; //当第2位为1时,可以做为数字的字符//
CHR_SYMGLOBAL = 4; //当第3位为1时,可以做为//
CHR_NUMGLOBAL = 8;
CHR_QUOTE = 16; //当第4位为1时,可以做为字符串界符//
CHR_WHITE = 32; //当第5位为1时,可以做为空白符//
const
bs = 8; (* BackSpace字符 *)
tab = 9; (* TAB字符 *)
nl = 10; (* NewLine字符 *)
cr = 13; (* Return字符*)
ff = 12; (* form feed 字符 *)
const
LEN_OPRSYMTAB = 13;
LEN_BNDSYMTAB = 8;
type
TCharClass=(
ccUnknown,
ccSymbolHeader,
ccSymbolGlobal,
ccNumberHeader,
ccNumberGlobal,
ccQuote,
ccToDo,
ccWhite
);
TCharClasses=Set of TCharClass;
TDKeywordID=(
DKW_AND, //and
DKW_ARRAY, //array
DKW_BEGIN, //begin
DKW_BOOL, //bool
DKW_BYTE, //byte
DKW_CALL, //call
DKW_CARDINAL, //cardinal
DKW_CASE, //case
DKW_CDECL, //cdecl
DKW_CHAR, //char
DKW_CLASS, //class
DKW_CONSTANT, //constant
DKW_COMP, //comp
DKW_CONST, //const
DKW_CURRENCY, //currency
DKW_DIV, //div
DKW_DO, //do
DKW_DOUBLE, //double
DKW_ELSE, //else
DKW_END, //end
DKW_EXCEPT, //except
DKW_EXTENTED, //extented
DKW_FALSE, //false
DKW_FILE, //file
DKW_FINALIZATION, //finalization
DKW_FINALLY, //finally
DKW_FOR, //for
DKW_IF, //if
DKW_IN, //in
DKW_INITIALIZATION, //initialization
DKW_INPUT, //input
DKW_INTEGER, //integer
DKW_INTERFACE, //interface
DKW_INT64, //int64
DKW_IMPLEMENTATION, //implementation
DKW_IMPLEMENTS, //implements
DKW_LIBRARY, //library
DKW_LONGINT, //longint
DKW_LONGWORD, //longword
DKW_MOD, //mod
DKW_NOT, //not
DKW_OF, //of
DKW_OR, //or
DKW_OUTPUT, //output
DKW_PASCAL, //pascal
DKW_PRIVATE, //private
DKW_PROCEDURE, //procedure
DKW_PROGRAM, //program
DKW_PROTECTED, //protected
DKW_PUBLIC, //public
DKW_PUBLISHED, //published
DKW_RAISE, //raise
DKW_READ, //read
DKW_REAL, //real
DKW_REAL48, //real48
DKW_REGISTER, //register
DKW_REPEAT, //repeat
DKW_PROPERTY, //property
DKW_SAFECALL, //safecall
DKW_SINGLE, //single
DKW_SET, //set
DKW_SMALLINT, //smallint
DKW_SHORTINT, //shortint
DKW_STDCALL, //stdcall
DKW_THEN, //then
DKW_TO, //to
DKW_TRY, //try
DKW_TRUE, //true
DKW_TYPE, //type
DKW_UNIT, //unit
DKW_UNTIL, //until
DKW_USES, //uses
DKW_VAR, //var
DKW_WHILE, //while
DKW_WORD, //word
DKW_WRITE //write
);
TDKeywordType=(
kwtUnknown,
kwtControl,
kwtOperator,
kwtInt,
kwtFloat,
kwtBool,
kwtChar
);
PKeyword=^TDKeyword;
TDKeyword=record
id:TDKeywordID;
str:string;
type_:TDKeywordType;
end;
TDKeywordList = class
private
FList:TList;
function GetItemCount:Integer;
function GetItem(Index:Integer):PKeyword;
public
constructor Create;
destructor Destroy;override;
procedure Add(Value:PKeyword);overload;
function Add:PKeyword;overload;
function AddAndInit(const id:TDKeywordID; str:string;
type_:TDKeywordType):PKeyword;overload;
procedure Insert(const Index:Integer;Value:PKeyword);overload;
function Insert(const Index:Integer):PKeyword;overload;
procedure Delete(const Index:Integer);
procedure Clear;
function IndexOf(const Keyword:TDKeywordID):Integer;
function FindKey(const Keyword:TDKeywordID):PKeyword;
function Lookup(const AStr:string; const bCase:Boolean;
var KeyInfo:PKeyword):Boolean;
procedure LoadFromFile(const FileName:string);
procedure SaveToFile(const FileName:string);
procedure LoadFromStream(Stream:TStream);
procedure SaveToStream(Stream:TStream);
property ItemCount:Integer read GetItemCount;
property Items[Index:Integer]:PKeyword read GetItem;
end;
TCharSet=set of Char;
TTokenType=(
//UnknownToken类型//
ttUnknown,
//一般Token类型//
tTDKeyword,
ttSymbol,
ttInt,
ttFloat,
ttString,
//操作符Token类型 //
ttAddr, // @
ttPointer, // ^
ttAdd, // +
ttSub, // -
ttMul, // *
ttDiv, // /
ttMod, // %
ttEQ, // =
ttLT, // <
ttGT, // >
ttNE, // <>
ttLE, // <=
ttGE, // >=
ttSV, // :=
//界符Token类型//
ttRET, // :
ttDot, // .
ttComma, // ,
ttSE, // ;
ttLParen, // (
ttRParen, // )
ttLArray, // [
ttRArray, // ]
//行结束符//
ttLineEnd,
//文件结束符//
ttCodeEnd);
TSystemToken=record
id:TTokenType;
str:string;
end;
PToken = ^TDToken;
TDToken = record
tok_position: PChar; //词的开始位置//
tok_length: Integer; //词的长度//
tok_string: string; //词的内容//
tok_type: TTokenType; //词类型//
tok_keyword:PKeyword; //如果为关键字,则执行关键字信息//
tok_line: Integer;
tok_lineposition: Integer;
end;
TDTokenList = class
private
FList:TList;
function GetItemCount:Integer;
function GetItem(Index:Integer):PToken;
public
constructor Create;
destructor Destroy;override;
procedure Add(Value:PToken);overload;
function Add:PToken;overload;
procedure Insert(const Index:Integer;Value:PToken);overload;
function Insert(const Index:Integer):PToken;overload;
procedure Delete(const Index:Integer);
procedure Clear;
property ItemCount:Integer read GetItemCount;
property Items[Index:Integer]:PToken read GetItem;
end;
TErrorPostType=(epException, epMessage);
TDTokenAnalyzer=class
private
FText: string;
FToken: TDToken;
FPosition:PChar; //当前指针//
FSourcePtr: PChar; //指针分析完词后的位置//
FLineNumber: Integer; //行号//
FLine_Position: Integer; //行内索引号//
FPrior_Line_Position: Integer;
FOnBuildToken: TNotifyEvent;
FMsgHandle: THandle;
FErrorPost: TErrorPostType;
FGenNormalString: Boolean;
{描述:
返回到上一个字符,必须使用该方法返回到上一个字符。
参数:
c: 返回到上一个字符前的当前字符}
procedure return_cha