dxjs_parser.pas

Well known and usefull component for delphi 7

   if CurrToken.ID=WD_NEW then begin
      App_POSTFIX (OP_CREATE_OBJECT) ;
      Call_SCANNER;
      App_Postfix(CurrToken.ID); //715
      App_POSTFIX(OP_POP_RET); //715
      if (CurrToken.Text='Object') and (NextToken.Text='(') then begin
         ID:=CurrToken.ID;
         Call_SCANNER;
         Call_SCANNER;
         CurrToken.ID:=ID;
         CurrToken.Text:='Object';
         CurrToken.AClass:=ClassID;
      end;
      Parse_NewExpression;
      App_POSTFIX (OP_POP_RET) ;
   end
   else
      Parse_MemberExpression;
end;

function TParser.Parse_Arguments:Integer;
begin
   result:=0;
   Match (SP_ROUND_BRACKET_L) ;
   Call_SCANNER;
   if CurrToken.ID=SP_ROUND_BRACKET_R then Call_SCANNER
   else begin
      result:=Parse_ArgumentList;
      Match (SP_ROUND_BRACKET_R) ;
      Call_SCANNER;
   end;
end;

function TParser.Parse_ArgumentList:Integer;
begin
   Parse_AssignmentExpression;
   result:=1;
   while CurrToken.ID=SP_COMMA do begin
      Call_SCANNER;
      Parse_AssignmentExpression;
      Inc (result) ;
   end;
end;

procedure TParser.Parse_LeftHandSideExpression;
begin
/////// NOT IMPLEMENTED YET
/////// BRANCH
   Parse_NewExpression;
//  Parse_CallExpression;
end;

procedure TParser.Parse_PostfixExpression (Const Left:boolean) ;
var
   ID:Integer;
begin
   if Left then Parse_LeftHandSideExpression;
   Case CurrToken.ID of
      OP_INC:begin
         ID:=TJScript (JScript) .Postfix.Top;
         if ID<=0 then raise TScriptFailure.Create (peCannotAssign) ;
         IncList.Add (Pointer (ID) ) ;
         Call_SCANNER;
      end;
      OP_DEC:begin
         ID:=TJScript (JScript) .Postfix.Top;
         if ID<=0 then raise TScriptFailure.Create (peCannotAssign) ;
         DecList.Add (Pointer (ID) ) ;
         Call_SCANNER;
      end;
   End;
end;

procedure TParser.Parse_UnaryExpression (Const Left:boolean) ;
Var
   OP:Integer;

begin
   if Left=false then Parse_PostfixExpression (false)
   Else Case CurrToken.ID of
      WD_DELETE:begin
         Call_SCANNER;
         Parse_UnaryExpression (true) ;
         App_POSTFIX (OP_DELETE) ;
      end;
      WD_VOID:begin
         Call_SCANNER;
         Parse_UnaryExpression (true) ;
         App_POSTFIX (OP_VOID) ;
      end;
      WD_TYPEOF:begin
         Call_SCANNER;
         Parse_UnaryExpression (true) ;
         App_POSTFIX (OP_TYPEOF) ;
      end;
      OP_INC,OP_DEC,OP_BITWISE_NOT,OP_LOGICAL_NOT:begin
         OP := CurrToken.ID; // save CurrToken.ID
         Call_SCANNER;
         Parse_UnaryExpression (true) ;
         App_POSTFIX (OP) ;
      end;
      OP_PLUS:begin
         Call_SCANNER;
         Parse_UnaryExpression (true) ;
         App_POSTFIX (OP_PLUS1) ;
      end;
      OP_MINUS:begin
         Call_SCANNER;
         Parse_UnaryExpression (true) ;
         App_POSTFIX (OP_MINUS1) ;
      end;
      else Parse_PostfixExpression (true) ;
   end;
end;

procedure TParser.Parse_MultiplicativeExpression (Const Left:boolean) ;
var
   OP:Integer;
begin
   Parse_UnaryExpression (Left) ;
   OP:=CurrToken.ID;
   while (OP=OP_MULT) or (OP=OP_DIV) or (OP=OP_MOD) do begin
      Call_SCANNER;
      Parse_UnaryExpression (true) ;
      App_POSTFIX (OP) ;
      OP:=CurrToken.ID;
   end;
end;

procedure TParser.Parse_AdditiveExpression (Const Left:boolean) ;
var
   OP:Integer;
begin
   Parse_MultiplicativeExpression (Left) ;
   OP:=CurrToken.ID;
   while (OP=OP_PLUS) or (OP=OP_MINUS) do begin
      Call_SCANNER;
      Parse_MultiplicativeExpression (true) ;
      App_POSTFIX (OP) ;
      OP:=CurrToken.ID;
   end;
end;

procedure TParser.Parse_ShiftExpression (Const Left:boolean) ;
var
   OP:Integer;
begin
   Parse_AdditiveExpression (Left) ;
   OP:=CurrToken.ID;
   while (OP=OP_BITWISE_LEFT_SHIFT) or
      (OP=OP_BITWISE_RIGHT_SHIFT) or
      (OP=OP_BITWISE_UNSIGNED_RIGHT_SHIFT) do begin
      Call_SCANNER;
      Parse_AdditiveExpression (true) ;
      App_POSTFIX (OP) ;
      OP:=CurrToken.ID;
   end;
end;

procedure TParser.Parse_RelationalExpression (Const Left:boolean) ;
var
   OP:Integer;
begin
   Parse_ShiftExpression (Left) ;
   OP:=CurrToken.ID;
   if OP=WD_INSTANCEOF then OP:=OP_INSTANCEOF;
   while (OP=OP_LT) or
      (OP=OP_GT) or
      (OP=OP_LE) or
      (OP=OP_GE) or
      (OP=OP_INSTANCEOF) do begin
      Call_SCANNER;
      Parse_ShiftExpression (true) ;
      App_POSTFIX (OP) ;
      OP:=CurrToken.ID;
      if OP=WD_INSTANCEOF then OP:=OP_INSTANCEOF
      else if OP=WD_IN then OP:=OP_IN;
   end;
end;

procedure TParser.Parse_EqualityExpression (Const Left:boolean) ;
var
   OP:Integer;
begin
   Parse_RelationalExpression (Left) ;
   OP:=CurrToken.ID;
   while (OP=OP_EQ) or
      (OP=OP_NE) or
      (OP=OP_ID) or
      (OP=OP_NI) do begin
      Call_SCANNER;
      Parse_RelationalExpression (true) ;
      App_POSTFIX (OP) ;
      OP:=CurrToken.ID;
   end;
end;

procedure TParser.Parse_BitwiseANDExpression (Const Left:boolean) ;
begin
   Parse_EqualityExpression (Left) ;
   while CurrToken.ID=OP_BITWISE_AND do begin
      Call_SCANNER;
      Parse_EqualityExpression (true) ;
      App_POSTFIX (OP_BITWISE_AND) ;
   end;
end;

procedure TParser.Parse_BitwiseXORExpression (Const Left:boolean) ;
begin
   Parse_BitwiseANDExpression (Left) ;
   while CurrToken.ID=OP_BITWISE_XOR do begin
      Call_SCANNER;
      Parse_BitwiseANDExpression (true) ;
      App_POSTFIX (OP_BITWISE_XOR) ;
   end;
end;

procedure TParser.Parse_BitwiseORExpression (Const Left:boolean) ;
begin
   Parse_BitwiseXORExpression (Left) ;
   while CurrToken.ID=OP_BITWISE_OR do begin
      Call_SCANNER;
      Parse_BitwiseXORExpression (true) ;
      App_POSTFIX (OP_BITWISE_OR) ;
   end;
end;

procedure TParser.Parse_LogicalANDExpression (Const Left:boolean) ;
begin
   Parse_BitwiseORExpression (Left) ;
   while CurrToken.ID=OP_LOGICAL_AND do begin
      Call_SCANNER;
      Parse_BitwiseORExpression (true) ;
      App_POSTFIX (OP_LOGICAL_AND) ;
   end;
end;

procedure TParser.Parse_LogicalORExpression (Const Left:boolean) ;
begin
   Parse_LogicalANDExpression (Left) ;
   while CurrToken.ID=OP_LOGICAL_OR do begin
      Call_SCANNER;
      Parse_LogicalANDExpression (true) ;
      App_POSTFIX (OP_LOGICAL_OR) ;
   end;
end;

procedure TParser.Parse_ConditionalExpression (Const Left:boolean) ;
var
   L,LF:Integer;
begin
   Parse_LogicalORExpression (Left) ;
   while CurrToken.ID=OP_COND do begin
      LF:=AppLabel;
      App_POSTFIX (LF) ;
      App_POSTFIX (OP_GO_FALSE) ;
      Call_SCANNER;
      Parse_AssignmentExpression;
      Match (SP_COLON) ;
      L:=AppLabel;
      App_POSTFIX (L) ;
      App_POSTFIX (OP_GO) ;
      SetLabelHere (LF) ;
      Call_SCANNER;
      Parse_AssignmentExpression;
      SetLabelHere (L) ;
   end;
end;

procedure TParser.Parse_AssignmentExpression;
var
   OP:Integer;
begin
   if (CurrToken.ID=WD_DELETE) or
      (CurrToken.ID=WD_VOID) or
      (CurrToken.ID=WD_TYPEOF) or
      (CurrToken.ID=OP_INC) or
      (CurrToken.ID=OP_DEC) or
      (CurrToken.ID=OP_PLUS) or
      (CurrToken.ID=OP_MINUS) or
      (CurrToken.ID=OP_BITWISE_NOT) or
      (CurrToken.ID=OP_LOGICAL_NOT) then begin
      Parse_ConditionalExpression (true) ;
   end
   Else Begin
      Parse_LeftHandSideExpression;
      if AssignmentOperators.IndexOf (Pointer (CurrToken.ID) ) =-1 then
         Parse_ConditionalExpression (false)
      else begin
         OP:=Parse_AssignmentOperator;
         Parse_AssignmentExpression;
         App_POSTFIX (OP) ;
      End;
   end;
end;

function TParser.Parse_AssignmentOperator:Integer;
begin
   result:=CurrToken.ID;
   if AssignmentOperators.IndexOf (Pointer (result) ) =-1 then
      Match (OP_ASSIGN) ;
   Call_SCANNER;
end;

procedure TParser.Parse_Expression;
begin
   Parse_AssignmentExpression;
   while CurrToken.ID=SP_COMMA do begin
      App_POSTFIX (OP_POP_RET) ;
      Call_SCANNER;
      Parse_AssignmentExpression;
   end;
end;

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

procedure TParser.Parse_Statement;
var
   K1,K2:Integer;
begin
   Case CurrToken.ID of
      SP_BRACE_L:Parse_Block; // Block
      WD_VAR:begin// VariableStatement
         Parse_VariableDeclarationList;
         Match (SP_SEMICOLON) ;
         Call_SCANNER;
      end;
      SP_SEMICOLON:begin// EmptyStatement
         EmptyStatement;
         Match (SP_SEMICOLON) ;
         Call_SCANNER;
      end;
      WD_IF:Parse_IfStatement;
      WD_FOR:Parse_ForStatement;
      WD_DO:begin
         Parse_DoStatement;
         if CurrToken.ID=SP_SEMICOLON then Call_SCANNER;
      end;
      WD_WHILE:Parse_WhileStatement;
      WD_CONTINUE:Parse_ContinueStatement;
      WD_BREAK:Parse_BreakStatement;
      WD_RETURN:begin
         Parse_ReturnStatement;
         Match (SP_SEMICOLON) ;
         Call_SCANNER;
      end;
      WD_WITH:Parse_WithStatement;
      WD_SWITCH:Parse_SwitchStatement;
      WD_PRINT:begin// PrintStatement
         Parse_PrintStatement;
         Match (SP_SEMICOLON) ;
         Call_SCANNER;
      end;
      WD_PAUSE:begin// PauseStatement
         App_POSTFIX (OP_PAUSE) ;
         Call_SCANNER;
         Match (SP_SEMICOLON) ;
         Call_SCANNER;
      end;
      WD_THROW:Parse_ThrowStatement;
      WD_TRY:Parse_TryStatement;
      SP_COLON:begin
         StatementLabel:=CurrToken.Text;
         Call_SCANNER;// skip ":"
         Call_SCANNER;
         Parse_Statement;
      end;
      else begin
         K1:=IncList.Count;
         K2:=DecList.Count;
         Parse_ExpressionStatement;
         App_POSTFIX (OP_POP_RET) ;
         AppIncList (K1) ;
         AppDecList (K2) ;
         Match (SP_SEMICOLON) ;
         Call_SCANNER;
      end;
   end; {case}
end;

procedure TParser.Parse_Block;
begin
// SP_BRACE_L
   Call_SCANNER;
   if CurrToken.ID<>SP_BRACE_R then
      repeat
         Parse_Statement;
         if CurrToken.ID=SP_BRACE_R then Break;
      until false;
   Match (SP_BRACE_R) ;
   Call_SCANNER;
end;

procedure TParser.Parse_VariableDeclarationList;
begin
// WD_VAR
   IsDeclareSwitch:=true;
   Call_SCANNER;
   IsDeclareSwitch:=false;
   Parse_VariableDeclaration;
   while CurrToken.ID=SP_COMMA do begin
      IsDeclareSwitch:=true;
      Call_SCANNER;
      IsDeclareSwitch:=false;
      Parse_VariableDeclaration;
   end;
end;

procedure TParser.Parse_VariableDeclaration;
begin
   Parse_Identifier;
   if CurrToken.ID=OP_ASSIGN then begin
      Call_SCANNER;
      Parse_AssignmentExpression;
      App_POSTFIX (OP_ASSIGN) ;
   end;
   App_POSTFIX (OP_POP_RET) ;
end;

procedure TParser.EmptyStatement;
begin
end;

procedure TParser.Parse_IfStatement;
var
   L,LF,K1,K2:Integer;
begin
  // WD_IF
   K1:=IncList.Count;
   K2:=DecList.Count;
   L:=AppLabel;
   LF:=AppLabel;
   Call_SCANNER;
   Match (SP_ROUND_BRACKET_L) ;
   Call_SCANNER;
   Parse_Expression;
   AppIncList (K1) ;
   AppDecList (K2) ;
   App_POSTFIX (LF) ;
   App_POSTFIX (OP_GO_FALSE) ;
   Match (SP_ROUND_BRACKET_R) ;
   Call_SCANNER;
   Parse_Statement;
   App_POSTFIX (L) ;
   App_POSTFIX (OP_GO) ;
   if CurrToken.ID=WD_ELSE then begin
      SetLabelHere (LF) ;
      Call_SCANNER;
      Parse_Statement;
   end
   else
      SetLabelHere (LF) ;