pax_basic.pas

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

function TPAXBasicParser.Parse_ArgumentExpression: Integer;
begin
  result := Parse_Expression;
end;

procedure TPAXBasicParser.SkipColons;
begin
  while IsCurrText(':') do
    Parse_Statement;
end;

procedure TPAXBasicParser.Call_SCANNER;
var
  S: String;
  TempID: Integer;
begin
  _Call_SCANNER;
  if IsCurrText('NULL') then
  begin
    CurrToken.ID := UndefinedID
  end
  else if CurrToken.TokenClass in [tcId, tcKeyword] then
  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;

procedure TPAXBasicParser._Call_SCANNER;
begin
  NewID := false;

  Scanner.ReadToken;
  CurrToken := Scanner.Token;

  if CurrToken.TokenClass = tcHtmlStringConst then
  begin
    GenHtml;
    Call_SCANNER;
    Exit;
  end;

  if CurrToken.TokenClass = tcId then
    if IsKeyword(CurrToken.Text) then
    begin
      CurrToken.TokenClass := tcKeyword;
      CurrToken.ID := 0;

      if IsCurrText('New') and IsNextText('(') then
        CurrToken.TokenClass := tcID;

      if IsCurrText('Long') then
      begin
        CurrToken.ID := typeINT64;
        CurrToken.TokenClass := tcId;
        Exit;
      end
      else if IsCurrText('byte') then
      begin
        CurrToken.ID := typeBYTE;
        CurrToken.TokenClass := tcId;
        Exit;
      end
      else if IsCurrText('sbyte') then
      begin
        CurrToken.ID := typeSHORTINT;
        CurrToken.TokenClass := tcId;
        Exit;
      end
      else if IsCurrText('short') then
      begin
        CurrToken.ID := typeSMALLINT;
        CurrToken.TokenClass := tcId;
        Exit;
      end
      else if IsCurrText('ushort') then
      begin
        CurrToken.ID := typeWORD;
        CurrToken.TokenClass := tcId;
        Exit;
      end
      else if IsCurrText('uint') then
      begin
        CurrToken.ID := typeCARDINAL;
        CurrToken.TokenClass := tcId;
        Exit;
      end
      else if IsCurrText('set') then
      begin
        CurrToken.ID := typeSET;
        CurrToken.TokenClass := tcId;
      end;
    end;

  if CurrToken.TokenClass = tcSeparator then
    if CurrToken.ID <> SP_EOF then
    begin
      SeparatorIds.Add(Pointer(CurrToken.ID));

      CurrToken.ID := SP_COLON;
      CurrToken.Text := ':';
      CurrToken.TokenClass := tcSPECIAL;
      Exit;
    end;

  if FieldSwitch then
  begin
    CurrToken.ID := NewField(CurrToken.Text);
    FieldSwitch := false;
    Exit;
  end;

  case CurrToken.TokenClass of
    tcIntegerConst, tcFloatConst:
    begin
      CurrToken.ID := SymbolTable.CodeNumberConst(CurrToken.Value);
      if CurrToken.TokenClass = tcFloatConst then
        TypeID[CurrToken.ID] := typeDOUBLE;
      if JavaScriptOperators then
        TypeID[CurrToken.ID] := typeVARIANT;
      Exit;
    end;
    tcStringConst:
    begin
      CurrToken.ID := SymbolTable.CodeStringConst(CurrToken.Text);
      if JavaScriptOperators then
        TypeID[CurrToken.ID] := typeVARIANT;
      Exit;
    end;
    tcId:
    if DeclareSwitch then
      with SymbolTable do
      begin
        CurrToken.ID := AppVariant(Undefined);
        Name[CurrToken.ID] := CurrToken.Text;
        Level[CurrToken.ID] := CurrLevel;
        Module[CurrToken.ID] := ModuleID;
        Position[CurrToken.ID] := CurrToken.Position - 1;

        NewID := true;
      end
    else
    begin
      CurrToken.ID := LookUpID(CurrToken.Text);
      if CurrToken.ID = 0 then
      begin
        with SymbolTable do
        begin
          CurrToken.ID := AppVariant(Undefined);
          Name[CurrToken.ID] := CurrToken.Text;
          Level[CurrToken.ID] := CurrLevel;
          Module[CurrToken.ID] := ModuleID;
          Position[CurrToken.ID] := CurrToken.Position - 1;

          NewID := true;
        end;
      end;
    end;
  end;
end;

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

procedure TPAXBasicParser.Match(const S: String);
var
  I: Integer;
begin
  if S = ':' then
  begin
    for I:=0 to SeparatorIds.Count - 1 do
      Gen(OP_SEPARATOR, ModuleID, Integer(SeparatorIds[I]), CurrLevel);
    SeparatorIDs.Clear;
  end;
  inherited;
end;

function TPAXBasicParser.Parse_OverloadableOperator: Integer;
begin
  if IsCurrText('=') then
    CurrToken.Text := '=='
  else if IsCurrText('<>') then
    CurrToken.Text := '!='
  else if IsCurrText('mod') then
    CurrToken.Text := '%'
  else if IsCurrText('shl') then
    CurrToken.Text := '<<'
  else if IsCurrText('shr') then
    CurrToken.Text := '>>';

  result := NewVar();
  Name[result] := CurrToken.Text;

  if OverloadableOperators.IndexOf(CurrToken.Text) = -1 then
    raise TPaxScriptFailure.Create(errOverloadableOperatorExpected);

  Call_SCANNER;
end;

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

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

    if IsCurrText('MyBase') then
      ma := maMyBase
    else
      ma := maMyClass;

    Call_SCANNER;
    Match('.');
    FieldSwitch := true;
    Call_SCANNER;
    result := Parse_Ident;
    GenRef(CurrThisID, ma, result);
  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('New')
  else if IsCurrText('AddressOf') 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('TerminalOf') then
  begin
    Call_SCANNER;
    ID := Parse_MemberExpression(0);
    result := NewVar;
    Gen(OP_GET_TERMINAL, ID, 0, result);
  end
  else if IsConstant then
  begin
    result := CurrToken.ID;
    if TypeID[result] = typeSTRING then
    begin
      result := Parse_StringLiteral;
    end
    else
      Call_SCANNER;
  end
  else if IsCurrText('.') then
  begin
    FieldSwitch := true;
    Call_SCANNER;
    result := Parse_Ident;
    GenRef(WithStack.Top, maAny, result);

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

function TPAXBasicParser.Parse_ObjectLiteral: Integer;
begin
  result := 0; // not implemented yet
end;

function TPAXBasicParser.Parse_MemberExpression(ID: Integer): Integer;
var
  SubID, RefID, NP, Vars: Integer;
  S: String;
  CallRec: TPaxCallRec;
  Rank: Integer;
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
        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
        if Rank = -1 then
          raise TPaxScriptFailure.Create(errCannotApplyToScalar);

        if CurrToken.Text = '(' then
          S := ')'
        else
          S := ']';

        SubID := result;

        Call_SCANNER;
        if IsCurrText(S) then
        begin
          NP := 0;
          Vars := 0;

          CallRec := TPaxCallRec.Create;
          CallRec.CallP := Scanner.PosNumber;
          CallRec.CallN := Code.Card + 1;
          TPaxBaseScripter(Scripter).CallRecList.AddObject(CallRec.CallN, CallRec);
        end
        else
          NP := Parse_ArgumentList(SubID, Vars);
        Match(S);

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

        result := NewVar;
        Gen(OP_CALL, SubID, NP, result);
        SetVars(Vars);

        Call_SCANNER;
      end;
    end;
end;

function TPAXBasicParser.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);

    TypeID[ObjectID] := ClassID;

    if IsCurrText('(') then
    begin
      result := NewRef;
      Name[result] := 'New';
      GenRef(ObjectID, maMyClass, result);
      result := Parse_MemberExpression(result);
    end
    else
      result := ObjectID;
  end
  else
    result := Parse_MemberExpression(0);
end;

function TPAXBasicParser.Parse_PowerExpression: Integer;
var
  ResID: Integer;
begin
  ResID := 0;
  result := Parse_NewExpression;

  while CurrToken.ID = OP_POWER do
  begin
    if ResID = 0 then
      ResID := NewVar;

    Call_SCANNER;
    Gen(OP_POWER, result, Parse_NewExpression, ResID);

    result := ResID;
  end;
end;

function TPAXBasicParser.Parse_UnaryMinusExpression: Integer;
begin
  if CurrToken.ID = OP_MINUS then
  begin
    result := NewVar;
    Call_SCANNER;
    Gen(OP_UNARY_MINUS, Parse_UnaryMinusExpression, 0, result);
  end
  else if CurrToken.ID = OP_PLUS then
  begin
    result := NewVar;
    Call_SCANNER;
    Gen(OP_UNARY_PLUS, Parse_UnaryMinusExpression, 0, result);
  end
  else
    result := Parse_PowerExpression;
end;

function TPAXBasicParser.Parse_MultiplicativeExpression: Integer;
var
  OP, ResID: Integer;
begin
  ResID := 0;
  result := Parse_UnaryMinusExpression;

  while
    (CurrToken.ID = OP_MULT) or
    (CurrToken.ID = OP_DIV) or
    (CurrToken.ID = OP_INT_DIV)
  do
  begin
    OP := CurrToken.ID;
    if ResID = 0 then
      ResID := NewVar;

    Call_SCANNER;
    Gen(OP, result, Parse_UnaryMinusExpression, ResID);

    result := ResID;
  end;
end;

function TPAXBasicParser.Parse_ModExpression: Integer;
var
  ResID: Integer;
begin
  ResID := 0;
  result := Parse_MultiplicativeExpression;

  while CurrToken.ID = OP_MOD do
  begin
    if ResID = 0 then
      ResID := NewVar;

    Call_SCANNER;
    Gen(OP_MOD, result, Parse_MultiplicativeExpression, ResID);

    result := ResID;
  end;
end;

function TPAXBasicParser.Parse_AdditiveExpression: Integer;
var
  OP, ResID: Integer;
begin
  ResID := 0;
  result := Parse_ModExpression;

  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_ModExpression, ResID);

    result := ResID;
  end;
end;

function TPAXBasicParser.Parse_ConcatenationExpression: Integer;
var
  ResID: Integer;
begin
  ResID := 0;
  result := Parse_AdditiveExpression;

  while CurrToken.ID = SP_CONCAT do
  begin
    Call_SCANNER;
    if ResID = 0 then
    begin
      ResID := NewVar;
      Gen(OP_PLUS, result, Parse_AdditiveExpression, ResID);
    end
    else
      Gen(OP_PLUS, result, Parse_AdditiveExpression, ResID);

    result := ResID;
  end;
end;

function TPAXBasicParser.Parse_EqualityExpression: Integer;
var
  OP, ResID: Integer;
begin
  ResID := 0;
  result := Parse_ConcatenationExpression;

  while
    (CurrToken.ID = OP_EQ) or
    (CurrToken.ID = OP_NE) or
    (CurrToken.ID = OP_GT) or
    (CurrToken.ID = OP_LT) or
    (CurrToken.ID = OP_GE) or
    (CurrToken.ID = OP_LE) or
    (CurrToken.ID = OP_IN_SET)
  do
  begin
    OP := CurrToken.ID;
    if ResID = 0 then
      ResID := NewVar;

    Call_SCANNER;
    Gen(OP, result, Parse_ConcatenationExpression, ResID);

    result := ResID;
  end;
end;

function TPAXBasicParser.Parse_Expression: Integer;
var
  OP, ResID, A: Integer;