pax_javascript.pas
来自「Delphi脚本控件」· PAS 代码 · 共 2,775 行 · 第 1/5 页
PAS
2,775 行
////////////////////////////////////////////////////////////////////////////
// PAXScript Interpreter
// Author: Alexander Baranovsky (ab@cable.netlux.org)
// ========================================================================
// Copyright (c) Alexander Baranovsky, 2003-2005. All rights reserved.
// Code Version: 3.0
// ========================================================================
// Unit: PAX_JAVASCRIPT.pas
// ========================================================================
////////////////////////////////////////////////////////////////////////////
{$I PaxScript.def}
unit PAX_JAVASCRIPT;
interface
uses
SysUtils, Classes,
BASE_CONSTS,
BASE_SYS, BASE_SCANNER, BASE_PARSER, BASE_SCRIPTER, BASE_CLASS;
const
SP_INC = -1001;
SP_DEC = -1002;
SP_PLUS_ASSIGN = -1003;
SP_MINUS_ASSIGN = -1004;
SP_MULT_ASSIGN = -1005;
SP_DIV_ASSIGN = -1006;
SP_MOD_ASSIGN = -1007;
SP_LEFT_SHIFT_ASSIGN = -1008;
SP_RIGHT_SHIFT_ASSIGN = -1009;
SP_UNSIGNED_RIGHT_SHIFT_ASSIGN = -1011;
SP_BITWISE_AND = -1012;
SP_BITWISE_OR = -1013;
SP_BITWISE_XOR = -1014;
SP_LOGICAL_AND = -1015;
SP_LOGICAL_OR = -1016;
SP_BITWISE_NOT = -1017;
SP_LOGICAL_NOT = -1018;
SP_COND = -1019;
SP_OR_ASSIGN = -1020;
SP_AND_ASSIGN = -1021;
type
TpaxJavaScriptScanner = class(TPAXScanner)
public
procedure ReadToken; override;
function UsesIdent(const IdentName: String): Boolean;
end;
TPaxJavaScriptParser = class(TPAXParser)
private
NewLine: Boolean;
FunctionObjectID: Integer;
LeftSideID: Integer;
public
constructor Create; override;
destructor Destroy; override;
procedure Reset; override;
procedure Match(const S: String); override;
procedure Call_SCANNER; override;
function Gen(Op, Arg1, Arg2, Res: Integer): Integer; override;
procedure GenDestroyLocalVars; override;
function Parse_EvalExpression: Integer; override;
function Parse_ArgumentExpression: Integer; override;
function Parse_ArgumentList(SubID: Integer; var Vars: Integer;
CheckCall: Boolean = true;
Erase: Boolean = true): Integer; override;
function Parse_PrimaryExpression: Integer;
function Parse_ArrayLiteral: Integer; override;
function Parse_ObjectLiteral: Integer;
function Parse_MemberExpression(ID: Integer): Integer;
function Parse_NewExpression: Integer;
function Parse_Arguments: Integer;
function Parse_LeftHandSideExpression: Integer;
function Parse_PostfixExpression(Left: Integer): Integer;
function Parse_UnaryExpression(Left: Integer): Integer;
function Parse_MultiplicativeExpression(Left: Integer): Integer;
function Parse_AdditiveExpression(Left: Integer): Integer;
function Parse_ShiftExpression(Left: Integer): Integer;
function Parse_RelationalExpression(Left: Integer): Integer;
function Parse_EqualityExpression(Left: Integer): Integer;
function Parse_BitwiseANDExpression(Left: Integer): Integer;
function Parse_BitwiseXORExpression(Left: Integer): Integer;
function Parse_BitwiseORExpression(Left: Integer): Integer;
function Parse_LogicalANDExpression(Left: Integer): Integer;
function Parse_LogicalORExpression(Left: Integer): Integer;
function Parse_ConditionalExpression(Left: Integer): Integer;
function Parse_AssignmentExpression: Integer;
function Parse_Expression: Integer;
function Parse_ModifierList: TPAXModifierList;
procedure Parse_Statement;
procedure Parse_Block;
procedure Parse_IfStmt;
procedure Parse_NamespaceStmt(ml: TPAXModifierList);
function Parse_FunctionStmt(ml: TPAXModifierList): Integer;
procedure Parse_ReturnStmt;
procedure Parse_HaltStmt;
function Parse_VarStmt(IsField: Boolean; ml: TPAXModifierList;
IsLoopVar: Boolean = false): Integer;
function Parse_VariableDeclaration(IsField: Boolean; ml: TPAXModifierList;
IsLoopVar: Boolean = false): Integer;
procedure Parse_ExpressionStmt;
procedure Parse_WhileStmt;
procedure Parse_DoStmt;
procedure Parse_ForStmt;
procedure Parse_ContinueStmt;
procedure Parse_BreakStmt;
procedure Parse_SwitchStmt;
procedure Parse_WithStmt;
procedure Parse_ThrowStmt;
procedure Parse_TryStmt;
procedure Parse_StmtList; override;
procedure Parse_SourceElements;
procedure CreateGlobalObjects;
procedure Parse_Program; override;
end;
implementation
uses
BASE_EXTERN;
procedure TPaxJavaScriptScanner.ReadToken;
begin
inherited;
repeat
if BuffToken.Text <> '' then
begin
Token := BuffToken;
BuffToken.Text := '';
Exit;
end;
GetNextChar;
Token.TokenClass := tcNone;
case c of
#8, #9, #10, #13, #32: ScanWhiteSpace;
#255: ScanEOF;
'0'..'9': ScanDigits;
'$': ScanHexDigits;
'A'..'Z', 'a'..'z', '_':
begin
ScanIdentifier;
if StrEql(Token.Text, 'in') then
begin
Token.TokenClass := tcSpecial;
Token.ID := OP_IN;
end
else if StrEql(Token.Text, 'instanceof') then
begin
Token.TokenClass := tcSpecial;
Token.ID := OP_INSTANCEOF;
end
else if StrEql(Token.Text, 'typeof') then
begin
Token.TokenClass := tcSpecial;
Token.ID := OP_TYPEOF;
end
else if StrEql(Token.Text, 'delete') then
begin
Token.TokenClass := tcSpecial;
Token.ID := OP_DESTROY_OBJECT;
end;
end;
'+':
begin
ScanPlus;
case LA(1) of
'+':
begin
GetNextChar;
Token.Text := '++';
Token.ID := SP_INC;
end;
'=':
begin
GetNextChar;
Token.Text := '+=';
Token.ID := SP_PLUS_ASSIGN;
end;
end;
end;
'-':
begin
ScanMinus;
case LA(1) of
'-':
begin
GetNextChar;
Token.Text := '--';
Token.ID := SP_DEC;
end;
'=':
begin
GetNextChar;
Token.Text := '-=';
Token.ID := SP_MINUS_ASSIGN;
end;
end;
end;
'*':
begin
ScanMult;
if LA(1) = '=' then
begin
GetNextChar;
Token.Text := '*=';
Token.ID := SP_MULT_ASSIGN;
end;
end;
'/':
begin
if LA(1) = '*' then
begin
repeat
GetNextChar;
if c in [#10,#13] then
begin
IncLineNumber;
PosNumber := -1;
if c = #13 then
GetNextChar;
end;
until ((LA(1) = '*') and (LA(2) = '/')) or (LA(1) = #255);
GetNextChar;
GetNextChar;
Continue;
end
else if LA(1) = '/' then
begin
repeat
GetNextChar;
until LA(1) in [#13, #10];
Continue;
end;
ScanDiv;
if LA(1) = '=' then
begin
GetNextChar;
Token.Text := '/=';
Token.ID := SP_DIV_ASSIGN;
end;
end;
'=':
begin
ScanEQ;
Token.ID := OP_ASSIGN;
if LA(1) = '=' then
begin
GetNextChar;
Token.Text := '==';
Token.ID := OP_EQ;
if LA(1) = '=' then
begin
GetNextChar;
Token.Text := '==';
Token.ID := OP_ID;
end;
end;
end;
'>':
begin
ScanGT;
case LA(1) of
'=':
begin
GetNextChar;
Token.Text := '>=';
Token.ID := OP_GE;
end;
'>':
begin
GetNextChar;
Token.Text := '>>';
Token.ID := OP_RIGHT_SHIFT;
case LA(1) of
'=':
begin
GetNextChar;
Token.Text := '>>=';
Token.ID := SP_RIGHT_SHIFT_ASSIGN;
end;
'>':
begin
GetNextChar;
Token.Text := '>>>';
Token.ID := OP_UNSIGNED_RIGHT_SHIFT;
if LA(1) = '=' then
begin
GetNextChar;
Token.Text := '>>>=';
Token.ID := SP_UNSIGNED_RIGHT_SHIFT_ASSIGN;
end;
end;
end;
end;
end;
end;
'<':
case ScannerState of
scanText:
begin
if LA(1) = '?' then
begin
GetNextChar;
GetNextChar;
ScanIdentifier;
if not StrEql('pax', Trim(Token.Text)) then
raise TPAXScriptFailure.Create(errIllegalCharacter);
ScannerState := scanProg;
Continue;
end
else if LA(1) = '%' then
begin
GetNextChar;
ScannerState := scanProg;
if LA(1) = '=' then
begin
GetNextChar;
BuffToken.Text := 'print';
end;
Continue;
end
else if LA(1) in ['a'..'z','A'..'Z'] then
ScanHtmlString(c)
else
raise TPAXScriptFailure.Create(errIllegalCharacter);
end;
scanProg:
begin
ScanLT;
case LA(1) of
'=':
begin
GetNextChar;
Token.Text := '<=';
Token.ID := OP_LE;
end;
'<':
begin
GetNextChar;
Token.Text := '<<';
Token.ID := OP_LEFT_SHIFT;
if LA(1) = '=' then
begin
GetNextChar;
Token.Text := '<<=';
Token.ID := SP_LEFT_SHIFT_ASSIGN;
end;
end;
end;
end;
end;
':': ScanColon;
'!':
begin
Token.Text := c;
Token.ID := SP_LOGICAL_NOT;
Token.TokenClass := tcSpecial;
if LA(1) = '=' then
begin
GetNextChar;
Token.Text := '!=';
Token.ID := OP_NE;
if LA(1) = '=' then
begin
GetNextChar;
Token.Text := '!==';
Token.ID := OP_NI;
end;
end
end;
'%':
case ScannerState of
scanText:
raise TPAXScriptFailure.Create(errIllegalCharacter + ' ' + c);
scanProg:
if LA(1) = '>' then
begin
ScannerState := scanText;
GetNextChar;
ScanHtmlString('');
end
else
begin
ScanMod;
if LA(1) = '=' then
begin
GetNextChar;
Token.Text := '%=';
Token.ID := SP_MOD_ASSIGN;
end;
end;
end;
'~':
begin
Token.Text := c;
Token.ID := SP_BITWISE_NOT;
Token.TokenClass := tcSpecial;
end;
'?':
begin
case ScannerState of
ScanText:
raise TPAXScriptFailure.Create(errIllegalCharacter);
ScanProg:
begin
if LA(1) = '>' then
begin
ScannerState := scanText;
GetNextChar;
ScanHtmlString('');
end
else
begin
Token.Text := c;
Token.ID := SP_COND;
Token.TokenClass := tcSpecial;
end;
end;
end;
end;
'|':
begin
Token.Text := c;
Token.ID := SP_BITWISE_OR;
Token.TokenClass := tcSpecial;
if LA(1) = '|' then
begin
GetNextChar;
Token.Text := '||';
Token.ID := SP_LOGICAL_OR;
end
else if LA(1) = '=' then
begin
GetNextChar;
Token.Text := '|=';
Token.ID := SP_OR_ASSIGN;
end;
end;
'&':
begin
Token.Text := c;
Token.ID := SP_BITWISE_AND;
Token.TokenClass := tcSpecial;
if LA(1) = '&' then
begin
GetNextChar;
Token.Text := '&&';
Token.ID := SP_LOGICAL_AND;
end
else if LA(1) = '=' then
begin
GetNextChar;
Token.Text := '|=';
Token.ID := SP_AND_ASSIGN;
end;
end;
'#':
if LookForward then
begin
repeat
GetNextChar;
until LA(1) in [#13, #10];
continue;
end
else
begin
ScanCondDir('#', ['a'..'z','A'..'Z','_','0'..'9']);
continue;
end;
';': ScanSemiColon;
'(': ScanLeftRoundBracket;
')': ScanRightRoundBracket;
'[': ScanLeftBracket;
']': ScanRightBracket;
'{': ScanLeftBrace;
'}': ScanRightBrace;
',': ScanComma;
'.': ScanPoint;
// '\': ScanBackslash;
'''': ScanString('''');
'"': ScanString('"');
else
raise TPAXScriptFailure.Create(errIllegalCharacter + ' ' + c);
end;
if Token.TokenClass <> tcNone then
Exit;
until false;
end;
function TPaxJavaScriptScanner.UsesIdent(const IdentName: String): Boolean;
var
I, K: Integer;
Ch: Char;
InComments: Boolean;
begin
result := false;
InComments := false;
K := 0;
for I:=P to Length(Buff) do
begin
Ch := Buff[I];
case Ch of
'/': if Buff[I+1] = '/' then
begin
InComments := true;
end;
#10:
begin
InComments := false;
end;
'{':
Inc(K);
'}':
begin
Dec(K);
if K = 0 then
Exit;
end;
else
if Ch = IdentName[1] then
if not InComments then
if Copy(Buff, I, Length(IdentName)) = IdentName then
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?