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 + -
显示快捷键?