pax_c.pas

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

    Add('property');
    Add('uint');
    Add('variant');
  end;
end;

destructor TPAXCParser.Destroy;
begin
  ConstIds.Free;
  inherited;
end;

procedure TPAXCParser.Reset;
begin
  inherited;
  ConstIds.Clear;
end;


procedure TPAXCParser.Call_SCANNER;
var
  S: String;
  TempID: Integer;
begin
  inherited;

  if CurrToken.TokenClass in [tcId, tcKeyword] then
  begin
     if IsCurrText('null') then
     begin
       CurrToken.ID := UndefinedID;
       CurrToken.TokenClass := tcId;
    end
    else if IsCurrText('int') then
    begin
      CurrToken.ID := typeINTEGER;
      CurrToken.TokenClass := tcId;
    end
    else if IsCurrText('uint') then
    begin
      CurrToken.ID := typeCARDINAL;
      CurrToken.TokenClass := tcId;
    end
    else if IsCurrText('byte') then
    begin
      CurrToken.ID := typeBYTE;
      CurrToken.TokenClass := tcId;
    end
    else if IsCurrText('sbyte') then
    begin
      CurrToken.ID := typeSHORTINT;
      CurrToken.TokenClass := tcId;
    end
    else if IsCurrText('short') then
    begin
      CurrToken.ID := typeSMALLINT;
      CurrToken.TokenClass := tcId;
    end
    else if IsCurrText('ushort') then
    begin
      CurrToken.ID := typeWORD;
      CurrToken.TokenClass := tcId;
    end
    else if IsCurrText('long') then
    begin
      CurrToken.ID := typeINT64;
      CurrToken.TokenClass := tcId;
    end
    else if IsCurrText('bool') then
    begin
      CurrToken.ID := typeBOOLEAN;
      CurrToken.TokenClass := tcId;
    end
    else if IsCurrText('double') then
    begin
      CurrToken.ID := typeDOUBLE;
      CurrToken.TokenClass := tcId;
    end
    else if IsCurrText('string') then
    begin
      CurrToken.ID := typeSTRING;
      CurrToken.TokenClass := tcId;
    end
    else if IsCurrText('float') then
    begin
      CurrToken.ID := typeSINGLE;
      CurrToken.TokenClass := tcId;
    end
    else if IsCurrText('decimal') then
    begin
      CurrToken.ID := typeCURRENCY;
      CurrToken.TokenClass := tcId;
    end
    else if IsCurrText('variant') then
    begin
      CurrToken.ID := typeVARIANT;
      CurrToken.TokenClass := tcId;
    end
    else if IsCurrText('void') then
    begin
      CurrToken.ID := typeVARIANT;
      CurrToken.TokenClass := tcId;
    end
    else if IsCurrText('set') then
    begin
      CurrToken.ID := typeSET;
      CurrToken.TokenClass := tcId;
    end
    else
    begin
      S := FindTypeAlias(CurrToken.Text, UpCase);
      if S <> '' then
      begin
        CurrToken.Text := S;
        TempID := SymbolTable.LookUpID(S, 0, UpCase);
        if TempID > 0 then
          CurrToken.ID := TempID
        else
          Name[CurrToken.ID] := S;
      end;
    end;
  end;
end;

function TPAXCParser.IsBaseType(const S: String): Boolean;
begin
  result := inherited IsBaseType(S);
  if result then
    Exit;
  result := (S = 'int') or
            (S = 'uint') or
            (S = 'sbyte') or
            (S = 'short') or
            (S = 'ushort') or
            (S = 'long') or
            (S = 'bool') or
            (S = 'double') or
            (S = 'string') or
            (S = 'variant') or
            (S = 'void') or
            (S = 'set');
end;

procedure TPAXCParser.ScanFIELD;
begin
  FieldSwitch := true;
  Call_SCANNER;
  if IsCurrText('~') then
  begin
    FieldSwitch := true;
    Call_SCANNER;
    CurrToken.Text := '~' + CurrToken.Text;
    CurrToken.ID := SymbolTable.Card;
    Name[CurrToken.ID] := CurrToken.Text;
  end;
end;

function TPAXCParser.Parse_EvalExpression: Integer;
begin
  result := Parse_LeftHandSideExpression;
end;

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

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

function TPAXCParser.Parse_PrimaryExpression: Integer;
var
  SubID, ID: Integer;
  IsArrayItem: Boolean;
  CallRec: TPaxCallRec;
  T: Integer;
begin
  if IsCurrText('(') then // (Expression)
  begin
    Call_SCANNER;
    result := Parse_Expression;
    Match(')');
    Call_SCANNER;

    if CurrToken.TokenClass <> tcSpecial then // type cast
    begin
      T := result;
      result := NewVar;
      Gen(OP_PUSH, Parse_UnaryExpression(0), 0, 0);
      Gen(OP_CALL, T, 1, result);

      CallRec := TPaxCallRec.Create;
      CallRec.CallP := Scanner.PosNumber;
      CallRec.CallN := Code.Card;
      TPaxBaseScripter(Scripter).CallRecList.AddObject(CallRec.CallN, CallRec);
    end;
  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('.');
    ScanFIELD;
//    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('.');
      ScanFIELD;
//      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('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
    result := Parse_Ident;
    GenEvalWith(result);
  end;
end;

function TPAXCParser.Parse_ObjectLiteral: Integer;
begin
  result := 0;
end;

function TPAXCParser.Parse_MemberExpression(ID: Integer; IsConstructor: boolean = false): Integer;
var
  SubID, RefID, Vars, Rank, K: Integer;
  CallRec: TPaxCallRec;
label
  Again;
begin
  if ID = 0 then
    result := Parse_PrimaryExpression
  else
    result := ID;

  Rank := SymbolTable.Rank[result];
  while CurrToken.Text[1] in ['(','[','.'] do
    case CurrToken.Text[1] of
      '[':
      begin
//        if Rank = -1 then
//          raise TPaxScriptFailure.Create(errCannotApplyToScalar);

        SubID := result;
        result := NewVar;

        Call_SCANNER;
        K := Parse_ArgumentList(SubID, Vars, true, false);
        Gen(OP_CALL, SubID, K, result);
        SetVars(Vars);

        Match(']');

        if (Rank > 0) and (K <> Rank) then
           raise TPaxScriptFailure.Create(errRankMismatch);

        Call_SCANNER;
      end;
      '.':
      begin
        ScanFIELD;
//        FieldSwitch := true;
//        Call_SCANNER;

        if IsKeyword(CurrToken.Text) then
        begin
          RefID := NewVar;
          Name[RefID] := CurrToken.Text;
          Call_SCANNER;
        end
        else
          RefID := Parse_Ident;

        GenRef(result, maAny, RefID);
        result := RefID;

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

        Call_SCANNER;
        if IsCurrText(')') then
        begin
          if IsConstructor then
            Gen(OP_CALL_CONSTRUCTOR, SubID, 0, result)
          else
            Gen(OP_CALL, SubID, 0, result);
          CallRec := TPaxCallRec.Create;
          CallRec.CallP := Scanner.PosNumber;
          CallRec.CallN := Code.Card;
          TPaxBaseScripter(Scripter).CallRecList.AddObject(CallRec.CallN, CallRec);
        end
        else
        begin
          if IsConstructor then
            Gen(OP_CALL_CONSTRUCTOR, SubID, Parse_ArgumentList(SubID, Vars), result)
          else
            Gen(OP_CALL, SubID, Parse_ArgumentList(SubID, Vars), result);
          SetVars(Vars);
        end;
        IsConstructor := false;

        Match(')');

        Call_SCANNER;
      end;
    end;
end;

function TPAXCParser.Parse_NewExpression: Integer;
var
  ClassID, ObjectID, RefID: Integer;
begin
  if IsCurrText('new') then
  begin
    Call_SCANNER;
    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, true);
    end
    else
      result := ObjectID;
  end
  else
    result := Parse_MemberExpression(0);
end;

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

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

  if CurrToken.ID = SP_INC 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 CurrToken.ID = SP_DEC 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 TPAXCParser.Parse_UnaryExpression(Left: Integer): Integer;
begin
  if Left <> 0 then
  begin
    result := Parse_PostfixExpression(Left);
    Exit;
  end;

  if CurrToken.ID = SP_INC then
  begin
    Call_SCANNER;
    result := Parse_UnaryExpression(0);
    GEN(OP_PLUS, result, NewConst(1), result);
  end
  else if CurrToken.ID = SP_DEC 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_HOST, result, 0, 0);
    GEN(OP_DESTROY_OBJECT, result, 0, 0);
  end
  else if CurrToken.ID = OP_PLUS then
  begin
    result := NewVar;
    Call_SCANNER;
    Gen(OP_UNARY_PLUS, Parse_UnaryExpression(0), 0, result);
  end
  else if CurrToken.ID = OP_MINUS then
  begin
    result := NewVar;
    Call_SCANNER;
    Gen(OP_UNARY_MINUS, 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 if IsCurrText('(') then
    result := Parse_PrimaryExpression
  else
    result := Parse_PostfixExpression(0);
end;

function TPAXCParser.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 TPAXCParser.Parse_AdditiveExpression(Left: Integer): Integer;
var
  OP, ResID: Integer;
begin
  ResID := 0;
  result := Parse_MultiplicativeExpression(Left);

  while (CurrToken.ID = OP_PLUS) or
        (CurrToken.ID = OP_MINUS) 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 TPAXCParser.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;