pax_javascript.pas

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

  end
  else
    result := Parse_MemberExpression(0);
end;

function TPaxJavaScriptParser.Parse_Arguments: Integer;
begin
  result := 0;
end;

function TPaxJavaScriptParser.Parse_LeftHandSideExpression: Integer;
begin
  result := Parse_NewExpression;
end;

function TPaxJavaScriptParser.Parse_PostfixExpression(Left: Integer): Integer;
var
  temp, r: Integer;
begin
  if Left <> 0 then
    result := Left
  else
    result := Parse_LeftHandSideExpression;

  if IsCurrText('++') then
  begin
    Call_SCANNER;
    temp := NewVar();
    Gen(OP_ASSIGN, temp, result, temp);
    r := NewVar();
    Gen(OP_PLUS, result, NewConst(1), r);
    Gen(OP_ASSIGN, result, r, result);
    result := temp;
  end
  else if IsCurrText('--') then
  begin
    Call_SCANNER;
    temp := NewVar();
    Gen(OP_ASSIGN, temp, result, temp);
    r := NewVar();
    Gen(OP_MINUS, result, NewConst(1), r);
    Gen(OP_ASSIGN, result, r, result);
    result := temp;
  end;
end;

function TPaxJavaScriptParser.Parse_UnaryExpression(Left: Integer): Integer;
begin
  if Left <> 0 then
  begin
    result := Parse_PostfixExpression(Left);
    Exit;
  end;

  if IsCurrText('++') then
  begin
    Call_SCANNER;
    result := Parse_UnaryExpression(0);
    GEN(OP_PLUS, result, NewConst(1), result);
  end
  else if IsCurrText('--') then
  begin
    Call_SCANNER;
    result := Parse_UnaryExpression(0);
    GEN(OP_MINUS, result, NewConst(1), result);
  end
  else if CurrToken.ID = OP_DESTROY_OBJECT then
  begin
    Call_SCANNER;
    result := Parse_UnaryExpression(0);
    GEN(OP_DESTROY_OBJECT, result, 0, 0);
  end
  else if IsCurrText('+') then
  begin
    Call_SCANNER;
    result := Parse_UnaryExpression(0);
  end
  else if CurrToken.ID = OP_TYPEOF then
  begin
    result := NewVar;
    Call_SCANNER;
    Gen(OP_TYPEOF, Parse_UnaryExpression(0), 0, result);
  end
  else if IsCurrText('-') then
  begin
    result := NewVar;
    Call_SCANNER;
    Gen(OP_UNARY_MINUS, Parse_UnaryExpression(0), 0, result);
  end
  else if IsCurrText('+') then
  begin
    result := NewVar;
    Call_SCANNER;
    Gen(OP_UNARY_PLUS, Parse_UnaryExpression(0), 0, result);
  end
  else if CurrToken.ID = SP_BITWISE_NOT then
  begin
    result := NewVar;
    Call_SCANNER;
    Gen(OP_TO_INTEGER, Parse_UnaryExpression(0), 0, result);
    Gen(OP_NOT, result, 0, result);
  end
  else if CurrToken.ID = SP_LOGICAL_NOT then
  begin
    result := NewVar;
    Call_SCANNER;
    Gen(OP_TO_BOOLEAN, Parse_UnaryExpression(0), 0, result);
    Gen(OP_NOT, result, 0, result);
  end
  else
    result := Parse_PostfixExpression(0);
end;

function TPaxJavaScriptParser.Parse_MultiplicativeExpression(Left: Integer): Integer;
var
  OP, ResID: Integer;
begin
  ResID := 0;
  result := Parse_UnaryExpression(Left);

  while (CurrToken.ID = OP_MULT) or
        (CurrToken.ID = OP_DIV) or
        (CurrToken.ID = OP_MOD) do
  begin
    OP := CurrToken.ID;

    if ResID = 0 then
      ResID := NewVar;

    Call_SCANNER;
    Gen(OP, result, Parse_UnaryExpression(0), ResID);
    result := ResID;
  end;
end;

function TPaxJavaScriptParser.Parse_AdditiveExpression(Left: Integer): Integer;
var
  OP, ResID: Integer;
begin
  ResID := 0;
  result := Parse_MultiplicativeExpression(Left);

  while IsCurrText('+') or IsCurrText('-') do
  begin
    OP := CurrToken.ID;

    if ResID = 0 then
      ResID := NewVar;

    Call_SCANNER;
    Gen(OP, result, Parse_MultiplicativeExpression(0), ResID);
    result := ResID;
  end;
end;

function TPaxJavaScriptParser.Parse_ShiftExpression(Left: Integer): Integer;
var
  OP, ResID: Integer;
begin
  ResID := 0;
  result := Parse_AdditiveExpression(Left);

  while (CurrToken.ID = OP_LEFT_SHIFT) or
        (CurrToken.ID = OP_RIGHT_SHIFT) or
        (CurrToken.ID = OP_UNSIGNED_RIGHT_SHIFT) do
  begin
    OP := CurrToken.ID;

    if ResID = 0 then
      ResID := NewVar;

    Call_SCANNER;
    Gen(OP, result, Parse_AdditiveExpression(0), ResID);
    result := ResID;
  end;
end;

function TPaxJavaScriptParser.Parse_RelationalExpression(Left: Integer): Integer;
var
  OP, ResID: Integer;
begin
  ResID := 0;
  result := Parse_ShiftExpression(Left);

  while (CurrToken.ID = OP_LT) or
        (CurrToken.ID = OP_GT) or
        (CurrToken.ID = OP_LE) or
        (CurrToken.ID = OP_GE) do
  begin
    OP := CurrToken.ID;

    if ResID = 0 then
      ResID := NewVar;

    Call_SCANNER;
    Gen(OP, result, Parse_ShiftExpression(0), ResID);
    result := ResID;
  end;
end;

function TPaxJavaScriptParser.Parse_EqualityExpression(Left: Integer): Integer;
var
  OP, ResID: Integer;
begin
  ResID := 0;
  result := Parse_RelationalExpression(Left);

  while (CurrToken.ID = OP_EQ) or
        (CurrToken.ID = OP_NE) or
        (CurrToken.ID = OP_ID) or
        (CurrToken.ID = OP_NI) or
        (CurrToken.ID = OP_IN) or
        (CurrToken.ID = OP_INSTANCEOF) do
  begin
    OP := CurrToken.ID;

    if ResID = 0 then
      ResID := NewVar;

    Call_SCANNER;
    Gen(OP, result, Parse_RelationalExpression(0), ResID);
    Result := ResID;
  end;
end;

function TPaxJavaScriptParser.Parse_BitwiseANDExpression(Left: Integer): Integer;
var
  ResID: Integer;
begin
  ResID := 0;
  result := Parse_EqualityExpression(Left);

  while CurrToken.ID = SP_BITWISE_AND do
  begin
    Call_SCANNER;
    if ResID = 0 then
    begin
      ResID := NewVar;
      Gen(OP_AND, ToInteger(result), ToInteger(Parse_EqualityExpression(0)), ResID);
    end
    else
      Gen(OP_AND, result, ToInteger(Parse_EqualityExpression(0)), ResID);
    result := ResID;
  end;
end;

function TPaxJavaScriptParser.Parse_BitwiseXORExpression(Left: Integer): Integer;
var
  ResID: Integer;
begin
  ResID := 0;
  result := Parse_BitwiseANDExpression(Left);

  while CurrToken.ID = SP_BITWISE_XOR do
  begin
    Call_SCANNER;
    if ResID = 0 then
    begin
      ResID := NewVar;
      Gen(OP_XOR, ToInteger(result), ToInteger(Parse_BitwiseANDExpression(0)), ResID);
    end
    else
      Gen(OP_XOR, result, ToInteger(Parse_BitwiseANDExpression(0)), ResID);
    result := ResID;
  end;
end;

function TPaxJavaScriptParser.Parse_BitwiseORExpression(Left: Integer): Integer;
var
  ResID: Integer;
begin
  ResID := 0;
  result := Parse_BitwiseXORExpression(Left);

  while CurrToken.ID = SP_BITWISE_OR do
  begin
    Call_SCANNER;
    if ResID = 0 then
    begin
      ResID := NewVar;
      Gen(OP_OR, ToInteger(result), ToInteger(Parse_BitwiseXORExpression(0)), ResID);
    end
    else
      Gen(OP_OR, result, ToInteger(Parse_BitwiseXORExpression(0)), ResID);
    result := ResID;
  end;
end;


function TPAXJavaScriptParser.Parse_LogicalANDExpression(Left: Integer): Integer;
begin
  result := Parse_BitwiseORExpression(Left);

  while CurrToken.ID = SP_LOGICAL_AND do
  begin
    Call_SCANNER;
    if ShortEvalSwitch then
    begin
      result := Parse_ShortEvalAND(result, nil, Parse_BitwiseORExpression);
    end
    else
    begin
      result := BinOp(OP_AND, result, Parse_BitwiseORExpression(0));
    end;
  end;
end;

function TPAXJavaScriptParser.Parse_LogicalORExpression(Left: Integer): Integer;
begin
  result := Parse_LogicalANDExpression(Left);

  while CurrToken.ID = SP_LOGICAL_OR do
  begin
    Call_SCANNER;
    if ShortEvalSwitch then
    begin
      result := Parse_ShortEvalOR(result, nil, Parse_LogicalANDExpression);
    end
    else
    begin
      result := BinOp(OP_OR, result, Parse_LogicalANDExpression(0));
    end;
  end;
end;

function TPaxJavaScriptParser.Parse_ConditionalExpression(Left: Integer): Integer;
var
  L, LF: Integer;
begin
  result := Parse_LogicalORExpression(Left);

  while CurrToken.ID = SP_COND do
  begin
    LF := NewLabel;
    L := NewLabel;

    Gen(OP_GO_FALSE, LF, result, 0);

    result := NewVar;

    Call_SCANNER;
    Gen(OP_ASSIGN, result, Parse_AssignmentExpression, result);
    Match(':');

    Gen(OP_GO, L, 0, 0);

    SetLabelHere(LF);

    Call_SCANNER;
    Gen(OP_ASSIGN, result, Parse_AssignmentExpression, result);

    SetLabelHere(L);
  end;
end;

function TPaxJavaScriptParser.Parse_AssignmentExpression: Integer;
var
  OP, Arg1, Arg2, Res, L1, L2, L: Integer;
  IsreducedAssignment: Boolean;
begin
  if IsCurrText('delete') or
     IsCurrText('void') or
     IsCurrText('typeof') or
     IsCurrText('(') or
     IsCurrText('++') or
     IsCurrText('--') or
     IsCurrText('+') or
     IsCurrText('-') or
     (CurrToken.ID = SP_BITWISE_NOT) or
     (CurrToken.ID = SP_LOGICAL_NOT) then

  begin
    result := Parse_ConditionalExpression(0);
    Exit;
  end;

  L1 := LastCodeLine + 1;

  Gen(OP_NOP, 0, 0, 0);

  IsReducedAssignment := false;
  if IsCurrText('reduced') then
  begin
    IsreducedAssignment := true;
    Call_SCANNER;
    result := Parse_LeftHandSideExpression;
  end
  else
    result := Parse_LeftHandSideExpression;

  LeftSideID := result;

//  if CurrToken.TokenClass <> tcSpecial then
//    Match('=');
  if IsCurrText(')') then
    Exit;
  if IsCurrText(']') then
    Exit;
  if IsCurrText(';') then
    Exit;

  if CurrToken.ID = OP_ASSIGN then
  begin
   Call_SCANNER;

   if IsreducedAssignment then
     Parse_ReducedAssignment(result)
   else if IsCallOperator(Arg1, Arg2, Res) then
   begin
     if IsCurrText('&') and (Arg2 > 0) then
     begin
       Code.Prog[LastCodeLine].Op := OP_GET_ITEM_EX;
       result := Parse_AssignmentExpression;
       Code.Prog[LastCodeLine].Res := Res;
     end
     else
     begin
       RemoveLastOperator;
       result := Parse_AssignmentExpression;
       Gen(OP_PUSH, result, 0, 0);
       Gen(OP_PUT_PROPERTY, Arg1, Arg2 + 1, 0);
     end;
   end
   else
   begin

     if CurrSubID > 0 then
     begin
       L := SymbolTable.Level[result];
       if L <> SymbolTable.RootNamespaceID then
       begin
         SymbolTable.SetLocal(result);
         LocalVars.Add(result);
       end;
     end
     else
     begin
       if Kind[result] = kindVAR then
         if CurrClassRec.FindMember(NameIndex[result], maAny) = nil then
            CurrClassRec.AddField(result, [modSTATIC]);
     end;

     Gen(OP_ASSIGN, result, Parse_AssignmentExpression, result);
   end;
  end
  else if (CurrToken.ID = SP_PLUS_ASSIGN) or
          (CurrToken.ID = SP_MINUS_ASSIGN) or
          (CurrToken.ID = SP_MULT_ASSIGN) or
          (CurrToken.ID = SP_DIV_ASSIGN) or
          (CurrToken.ID = SP_MOD_ASSIGN) or
          (CurrToken.ID = SP_OR_ASSIGN) or
          (CurrToken.ID = SP_AND_ASSIGN) or
          (CurrToken.ID = SP_LEFT_SHIFT_ASSIGN) or
          (CurrToken.ID = SP_RIGHT_SHIFT_ASSIGN) or
          (CurrToken.ID = SP_UNSIGNED_RIGHT_SHIFT_ASSIGN) then
  begin
    OP := 0;
    case CurrToken.ID of
      SP_PLUS_ASSIGN: OP := OP_PLUS;
      SP_MINUS_ASSIGN: OP := OP_MINUS;
      SP_MULT_ASSIGN: OP := OP_MULT;
      SP_DIV_ASSIGN: OP := OP_DIV;
      SP_MOD_ASSIGN: OP := OP_MOD;
      SP_OR_ASSIGN: OP := OP_OR;
      SP_AND_ASSIGN: OP := OP_AND;
      SP_LEFT_SHIFT_ASSIGN: OP := OP_LEFT_SHIFT;
      SP_RIGHT_SHIFT_ASSIGN: OP := OP_RIGHT_SHIFT;
      SP_UNSIGNED_RIGHT_SHIFT_ASSIGN: OP := OP_UNSIGNED_RIGHT_SHIFT;
    end;

    Call_SCANNER;
    if IsCallOperator(Arg1, Arg2, Res) then
    begin
      L2 := LastCodeLine - 1;
      Res := NewVar;
      Gen(OP, result, Parse_AssignmentExpression, Res);
      InsertCode(L1, L2);
      Gen(OP_PUSH, Res, 0, 0);
      Gen(OP_PUT_PROPERTY, Arg1, Arg2 + 1, 0);
      result := Res;
    end
    else
      Gen(OP, result, Parse_AssignmentExpression, result);
  end
  else
  begin
    result := Parse_ConditionalExpression(result);
  end;
end;

function TPaxJavaScriptParser.Parse_Expression: Integer;
begin
  result := Parse_AssignmentExpression;
  while CurrToken.ID = SP_COMMA do
  begin
    Call_SCANNER;
    result := Parse_AssignmentExpression;
  end;
end;

///////  STATEMENTS /////////////////////////////////////////////////////////

function TPaxJavaScriptParser.Parse_ModifierList: TPAXModifierList;
label
  Again;
begin
  result := [];

Again:

  if IsCurrText('public') then
  begin
    result := result + [modPUBLIC];
    Call_SCANNER;
    Goto Again;
  end;
  if IsCurrText('private') then
  begin
    result := result + [modPRIVATE];
    Call_SCANNER;
    Goto Again;
  end;
  if IsCurrText('static') then
  begin
    result := result + [modSTATIC];
    Call_SCANNER;
    Goto Again;
  end;
end;

procedure TPaxJavaScriptParser.Parse_Statement;
var
  ml: TPAXModifierList;
begin
  ml := Parse_ModifierList;

  if IsLabelID then
  begin
    StatementLabel := CurrToken.Text;
    Parse_SetLabel;
    Match(':');
    Call_SCANNER;
  end;

  if IsCurrText('{') then
  begin
    Parse_Block;
    Call_SCANNER;
  end
  else if IsCurrText(';') then
    Call_SCANNER
  else if IsCurrText('namespace') then
    Parse_NamespaceStmt(ml)
  else if IsCurrText('function') then
    Parse_FunctionStmt(ml)