pax_javascript.pas

来自「Delphi脚本控件」· PAS 代码 · 共 2,775 行 · 第 1/5 页

          begin
            result := true;
            Exit;
          end;
    end;
  end;
end;

procedure TPaxJavaScriptParser.Match(const S: String);
begin
  if (S = ';') and (CurrToken.Text <> S) then
  begin
    Scanner.BuffToken := CurrToken;

    CurrToken.Text := ';';
    CurrToken.ID := SP_SEMICOLON;
    Exit;
  end;

  inherited;
end;

constructor TPaxJavaScriptParser.Create;
begin
  inherited;

  JavaScriptOperators := true;

  Scanner := TPaxJavaScriptScanner.Create(Self);

  UpCase := false;

  NewLine := false;

  LeftSideID := 0;

  with Keywords do
  begin
    Add('base');
    Add('break');
    Add('case');
    Add('catch');
    Add('class');
    Add('continue');
    Add('delete');
    Add('do');
    Add('else');
    Add('false');
    Add('finally');
    Add('for');
    Add('function');
    Add('get');
    Add('goto');
    Add('if');
    Add('in');
    Add('instanceof');

    Add('namespace');
    Add('new');
    Add('out');
    Add('public');
    Add('private');
    Add('reduced');
    Add('ref');
    Add('return');
    Add('set');
    Add('static');
    Add('structure');
    Add('switch');
//    Add('THIS');
    Add('throw');
    Add('true');
    Add('try');
    Add('typeof');
    Add('var');
    Add('void');
    Add('using');
    Add('while');
    Add('with');

    Add('print');
    Add('println');
    Add('property');
  end;
end;

function TPAXJavaScriptParser.Gen(Op, Arg1, Arg2, Res: Integer): Integer;
begin
  Code.RemoveNops;

  if Op = OP_PLUS then
    Op := Op_PLUS_EX
  else if Op = OP_MINUS then
    Op := Op_MINUS_EX
  else if Op = OP_UNARY_MINUS then
    Op := Op_UNARY_MINUS_EX
  else if Op = OP_MULT then
    Op := Op_MULT_EX
  else if Op = OP_DIV then
    Op := Op_DIV_EX
  else if Op = OP_MOD then
    Op := Op_MOD_EX
  else if Op = OP_LEFT_SHIFT then
    Op := Op_LEFT_SHIFT_EX
  else if Op = OP_RIGHT_SHIFT then
    Op := Op_RIGHT_SHIFT_EX
  else if Op = OP_UNSIGNED_RIGHT_SHIFT then
    Op := Op_UNSIGNED_RIGHT_SHIFT_EX
  else if Op = OP_EQ then
    Op := Op_EQ_EX
  else if Op = OP_NE then
    Op := Op_NE_EX
  else if Op = OP_ID then
    Op := Op_ID_EX
  else if Op = OP_NI then
    Op := Op_NI_EX
  else if Op = OP_LT then
    Op := Op_LT_EX
  else if Op = OP_LE then
    Op := Op_LE_EX
  else if Op = OP_GT then
    Op := Op_GT_EX
  else if Op = OP_GE then
    Op := Op_GE_EX;

  result := inherited Gen(Op, Arg1, Arg2, Res);
end;

procedure TPAXJavaScriptParser.Call_SCANNER;
var
  L1, L2: Integer;
begin
  L1 := Scanner.LineNumber;
  inherited;
  L2 := Scanner.LineNumber;
  NewLine := L2 > L1;

  if IsCurrText('null') then
  begin
    CurrToken.ID := UndefinedID;
    CurrToken.TokenClass := tcId;
  end;
end;

destructor TPAXJavaScriptParser.Destroy;
begin
  inherited;
end;

procedure TPaxJavaScriptParser.Reset;
begin
  inherited;
end;

function TPaxJavaScriptParser.Parse_EvalExpression: Integer;
begin
//  result := Parse_LeftHandSideExpression;
  result := Parse_Expression;
end;

function TPaxJavaScriptParser.Parse_ArgumentExpression: Integer;
begin
  result := Parse_AssignmentExpression;
end;

///////  EXPRESSIONS /////////////////////////////////////////////////////////

function TPaxJavaScriptParser.Parse_ArgumentList(SubID: Integer; var Vars: Integer;
                                    CheckCall: Boolean = true;
                                    Erase: Boolean = true): Integer;

procedure _ParseExpr;
var
  TempID, ExprID, K1, K2: Integer;
begin
  Inc(result);
  K1 := Code.Card;
  ExprID := Parse_ArgumentExpression;
  Code.RemoveNops;
  K2 := Code.Card;
  if K2 - K1 > 0 then
  begin
    TempID := NewVar;
    Gen(OP_ASSIGN_SIMPLE, TempID, ExprID, TempID);
    Gen(OP_PUSH, TempID, 0, 0);
  end
  else
    Gen(OP_PUSH, ExprID, 0, 0);
end;

var
  I: Integer;
  S: String;
begin
  Vars := 0;
  result := 0;
  ArgumentListSwitch := true;
  if Erase then
  begin
    S := Name[SubId];
    I := ArrayParamMethods.IndexOf(S);
    if I = -1 then
      ArgumentListSwitch := false;
  end;

  _ParseExpr;
  while IsCurrText(',') do
  begin
    Call_SCANNER;
    _ParseExpr;
  end;

  ArgumentListSwitch := false;
  if Erase then
  begin
    S := Name[SubId];
    I := ArrayParamMethods.IndexOf(S);
    if I = -1 then
      ArrayArgumentList.Clear;
  end;
end;

function TPaxJavaScriptParser.Parse_PrimaryExpression: Integer;
var
  SubID, ID: Integer;
  IsArrayItem: Boolean;
begin
  if IsCurrText('(') then // (Expression)
  begin
    Call_SCANNER;
    result := Parse_Expression;
    Match(')');
    Call_SCANNER;
  end
  else if IsCurrText('base') then // (base access)
  begin
    if CurrClassID = 0 then
      raise TPAXScriptFailure.Create(errStatementIsNotAllowedHere);
    if CurrSubID <> CurrMethodID then
      raise TPAXScriptFailure.Create(errStatementIsNotAllowedHere);

    Call_SCANNER;
    Match('.');
    FieldSwitch := true;
    Call_SCANNER;
    result := Parse_Ident;
    GenRef(CurrThisID, maMyBase, result);
  end
  else if IsCurrText('this') then // (base access)
  begin
    if CurrClassID = 0 then
      raise TPAXScriptFailure.Create(errStatementIsNotAllowedHere);
    if CurrSubID <> CurrMethodID then
      raise TPAXScriptFailure.Create(errStatementIsNotAllowedHere);

    if IsNextText('.') then
    begin
      Call_SCANNER;
      Match('.');
      FieldSwitch := true;
      Call_SCANNER;
      result := Parse_Ident;
      GenRef(CurrThisID, maMyClass, result);
    end
    else
    begin
      result := Parse_Ident;
    end;
  end
  else if IsCurrText('[') then // (array literal)
    result := Parse_ArrayLiteral
  else if IsCurrText('{') then // (object literal)
    result := Parse_ObjectLiteral
  else if IsCurrText('/') then // (regexp literal)
    result := Parse_RegExpr('RegExp')
  else if IsCurrText('&') then
  begin
    result := NewVar;
    Call_SCANNER;
    if IsCallOperator then
      RemoveLastOperator;

    IsArrayItem := IsNextText('[') or IsNextText('(');

    SubID := Parse_MemberExpression(0);
    if IsCallOperator and (not IsArrayItem) then
       RemoveLastOperator;
    Gen(OP_ASSIGN_ADDRESS, result, SubID, result);
  end
  else if IsCurrText('*') then
  begin
    Call_SCANNER;
    ID := Parse_MemberExpression(0);
    result := NewVar;
    Gen(OP_GET_TERMINAL, ID, 0, result);
  end
  else if IsCurrText('true') then
  begin
    result := NewConst(true);
    Call_SCANNER;
  end
  else if IsCurrText('function') then
  begin
    result := Parse_FunctionStmt([]);
    while Kind[result] <> KindTYPE do
      Dec(result);
  end
  else if IsCurrText('false') then
  begin
    result := NewConst(false);
    Call_SCANNER;
  end
  else if IsConstant then
  begin
    result := CurrToken.ID;
    if TypeID[result] = typeSTRING then
    begin
      result := Parse_StringLiteral;
    end
    else
      Call_SCANNER;
  end
  else
  begin
    if IsNextText('.') and IsNext2Text('arguments') then
    begin
      Call_SCANNER;
      Call_SCANNER;
      result := Parse_Ident;
      Exit;
    end;
    result := Parse_Ident;
    result := GenEvalWith(result);
  end;
end;

function TPaxJavaScriptParser.Parse_ArrayLiteral: Integer;
var
  L, K, ArgID: Integer;
begin
  // '['

  K := 0;
  result := NewVar;

  if ArgumentListSwitch then
    ArrayArgumentList.Add(result);


  Gen(OP_PUSH, 0, 0, 0);
  L := LastCodeLine;

  Gen(OP_CREATE_ARRAY, result, 1, 0);

  Call_SCANNER;
  if not IsCurrText(']') then
  begin
    Gen(OP_PUSH, NewConst(K), 0, 0);
    ArgID := Parse_AssignmentExpression;
    Gen(OP_PUSH, ArgID, 0, 0);
    Gen(OP_PUT_PROPERTY, result, 2, 0);

    while IsCurrText(',') do
    begin
      Inc(K);

      Call_SCANNER;
      Gen(OP_PUSH, NewConst(K), 0, 0);
      ArgID := Parse_AssignmentExpression;
      Gen(OP_PUSH, ArgID, 0, 0);
      Gen(OP_PUT_PROPERTY, result, 2, 0);
    end;
  end
  else
    K := -1;

  Code.Prog[L].Arg1 := NewConst(K);

  Match(']');
  Call_SCANNER;
end;

function TPaxJavaScriptParser.Parse_ObjectLiteral: Integer;
var
  RefID, ClassID: Integer;
begin
// Match "{"

  result := NewVar;
  RefID := NewVar;
  ClassID := NewVar;

  Name[ClassID] := 'Object';
  Name[RefID] := 'Object';

  Gen(OP_EVAL_WITH, 0, 0, ClassID);
  Gen(OP_CREATE_OBJECT, ClassID, 0, result);

  GenRef(result, maAny, RefID);
  Gen(OP_CALL, RefID, 0, result);

  Call_SCANNER;

  if not IsCurrText('}') then
  repeat
    Gen(OP_PUSH, CurrToken.ID, 0, 0);

    Call_SCANNER;
    Match(':');

    Call_SCANNER;
    Gen(OP_PUSH, Parse_AssignmentExpression, 0, 0);

    Gen(OP_PUT_PROPERTY, result, 2, 0);

    if IsCurrText(',') then
      Call_SCANNER
    else
      Break;
  until False;

  Match('}');
  Call_SCANNER;
end;

function TPaxJavaScriptParser.Parse_MemberExpression(ID: Integer): Integer;
var
  SubID, RefID, Vars: Integer;
label
  Again;
begin
  if ID = 0 then
    result := Parse_PrimaryExpression
  else
    result := ID;

  while CurrToken.Text[1] in ['(','[','.'] do
    case CurrToken.Text[1] of
      '[':
      begin

        SubID := result;
        result := NewVar;

        Call_SCANNER;
        Gen(OP_CALL, SubID, Parse_ArgumentList(SubID, Vars, true, false), result);
//        Code.Prog[Code.Card].AltArg1 := 1; // get property
        SymbolTable.JSIndex[SubId] := true;

        SetVars(Vars);

        Match(']');

        Call_SCANNER;
      end;
      '.':
      begin
        if IsNextText('arguments') then
        begin
          Call_SCANNER;
          result := CurrToken.ID;
          Gen(OP_EVAL_WITH, 0, 0, result);
          Call_SCANNER;
        end
        else
        begin
          FieldSwitch := true;
          Call_SCANNER;
          RefID := Parse_Ident;
          GenRef(result, maAny, RefID);
          result := RefID;

  //        if not (CurrToken.Text[1] in ['(', '[']) then
  //          Gen(OP_CALL, result, 0, result);
        end;
      end;
      '(':
      begin
        SubID := result;
        result := NewVar;

        Call_SCANNER;
        if IsCurrText(')') then
          Gen(OP_CALL, SubID, 0, result)
        else
        begin
          Gen(OP_CALL, SubID, Parse_ArgumentList(SubID, Vars), result);
          SetVars(Vars);
        end;

        Match(')');

        Call_SCANNER;
      end;
    end;
end;

function TPaxJavaScriptParser.Parse_NewExpression: Integer;
var
  ClassID, ObjectID, RefID, SubID: Integer;
  reg_exp, temp: Boolean;
begin
  temp := false;
  
  if IsCurrText('new') then
  begin
    Call_SCANNER;

    reg_exp := StrEql('RegExp', CurrToken.Text);
    if reg_exp then
    begin
      temp := Backslash;
      Backslash := false;
    end;

    ClassID := Parse_Ident;
    ClassID := GenEvalWith(ClassID);

    while IsCurrText('.') do
    begin
      FieldSwitch := true;
      Call_SCANNER;
      RefID := Parse_Ident;
      GenRef(ClassID, maAny, RefID);
      ClassID := RefID;
    end;

    ObjectID := NewVar;
    Gen(OP_CREATE_OBJECT, ClassID, 0, ObjectID);

    if IsCurrText('(') then
    begin
      result := NewRef;
      Name[result] := Name[ClassID];
      GenRef(ObjectID, maMyClass, result);
      result := Parse_MemberExpression(result);
    end
    else if IsCurrText(';') or NewLine then
    begin
      result := NewRef;
      Name[result] := Name[ClassID];
      GenRef(ObjectID, maMyClass, result);
      SubID := result;
      result := NewVar;
      Gen(OP_CALL, SubID, 0, result);
    end
    else
      result := ObjectID;

    TypeID[result] := ClassID;

    if reg_exp then
    begin
      Backslash := temp;
    end;