base_parser.pas

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

    begin
      if DuplicateVars then
      begin
        CurrToken.ID := LookUpID(CurrToken.Text);
      end
      else
        CurrToken.ID := 0;

      if CurrToken.ID = 0 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;

    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 TPAXParser.IsKeyword(const S: String): boolean;
begin
  if UpCase then
    result := Keywords.IndexOf(UpperCase(S)) <> - 1
  else
    result := Keywords.IndexOf(S) <> - 1;
end;

function TPAXParser.IsConstant: boolean;
begin
  result := (CurrToken.TokenClass in [tcIntegerConst, tcFloatConst, tcStringConst]);
end;

function TPAXParser.CurrLevel: Integer;
begin
  result := LevelStack.Top;
end;

function TPAXParser.LookUpID(const Name: String): Integer;
var
  L: Integer;
begin
  L := LevelStack.Card;
  while L > 1 do
  begin
    result := SymbolTable.LookUpID(Name, LevelStack[L], UpCase);
    if result <> 0 then
      Exit;
    Dec(L);
  end;

  result := InUsing(Name);
  if result <> 0 then
    Exit;
  result := SymbolTable.LookUpID(Name, 0, UpCase);
end;

function TPAXParser.LookUpLocalID(const Name: String): Integer;
begin
  result := SymbolTable.LookUpID(Name, CurrLevel, UpCase);
end;

function TPAXParser.Parse_Rank: Integer;
begin
  result := 1;
  Match('[');
  Call_SCANNER;
  repeat
    if IsCurrText(',') then
    begin
      Inc(result);
      Call_SCANNER;
    end
    else if IsCurrText(']') then
      break
    else
      Match(']');
  until false;
  Call_SCANNER;
end;

function TPAXParser.Parse_Ident: Integer;
begin
  if CurrToken.TokenClass <> tcId then
    raise TPAXScriptFailure.Create(errIdentifierExpected);

  result := CurrToken.ID;
  Call_SCANNER;
end;

function TPAXParser.Parse_OverloadableOperator: Integer;
begin
  if OverloadableOperators.IndexOf(CurrToken.Text) = -1 then
    raise TPaxScriptFailure.Create(errOverloadableOperatorExpected);

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

procedure TPAXParser.Parse_GoToStmt;
begin
  Call_SCANNER;
  Gen(OP_EXIT, Parse_UseLabel, 0, 0);
end;

function TPAXParser.IsLabelId: boolean;
begin
  result := (CurrToken.TokenClass = tcId) and IsNextText(':');
end;

function TPAXParser.Parse_SetLabel: Integer;
begin
  result := Parse_Ident;

  Gen(OP_SET_LABEL, 0, 0, 0);

  with SymbolTable do
  begin
    if not IsUndefined(GetVariant(result)) then
      raise TPAXScriptFailure.Create(errLabelAlreadyDefined);

    Kind[result] := KindLABEL;
    PutVariant(result, LastCodeLine);
  end;
end;

function TPAXParser.Parse_UseLabel: Integer;
begin
  result := Parse_Ident;
  SymbolTable.Kind[result] := KindLABEL;
end;

function TPAXParser.Parse_Constant: Integer;
begin
  result := CurrToken.ID;
  Call_SCANNER;
end;

function TPAXParser.LA(I: Integer): Char;
begin
  result := Scanner.LA(I);
end;

function TPAXParser.CurrClassID: Integer;
var
  I: Integer;
begin
  result := 0;

  for I:= LevelStack.Card downto 1 do
  if I > 1 then
    if Kind[LevelStack[I]] = kindTYPE then
    begin
      result := LevelStack[I];
      Exit;
    end;
end;

function TPAXParser.CurrMethodID: Integer;
var
  I, ID: Integer;
begin
  result := 0;

  for I:= LevelStack.Card downto 1 do
  if I > 1 then
    if SymbolTable.Kind[LevelStack[I]] = kindTYPE then
    if I <> LevelStack.Card then
    begin
      ID := LevelStack[I + 1];
      if SymbolTable.Kind[ID] = kindSUB then
        result := ID;
      Exit;
    end;
end;

function TPAXParser.CurrThisID: Integer;
var
  MemberRec: TPAXMemberRec;
  ID: Integer;
begin
  result := CurrMethodID;
  if result <> 0 then
  begin
    ID := CurrClassID;
    MemberRec := ClassList.FindMember(ID, SymbolTable.NameIndex[result], maMyClass);

    if MemberRec = nil then
      raise TPaxScriptFailure.Create(errPropertyIsNotFound);

    if MemberRec.IsStatic then
      result := 0
    else
      result := SymbolTable.GetThisID(result);
  end;
end;

function TPAXParser.GetOuterSubID(SubID: Integer): Integer;
var
  I, J, ID: Integer;
begin
  result := -1;
  for I:=2 to LevelStack.Card do
    if LevelStack[I] = SubID then
    begin
      J := I - 1;
      while J > 0 do
      begin
        ID := LevelStack[J];
        if ID <= 0 then
          Exit;
        if SymbolTable.Kind[ID] = KindSUB then
        begin
          result := ID;
          Exit;
        end;
        Dec(J);
      end;
    end;
end;

function TPAXParser.IsNestedSub(SubID: Integer): Boolean;
begin
  result := GetOuterSubID(SubID) > 0;
end;

function TPAXParser.CurrResultID: Integer;
var
  MemberRec: TPAXMemberRec;
  ID: Integer;
begin
  result := CurrSubID;
  if IsNestedSub(result) then
  begin
    result := SymbolTable.GetResultID(result);
    Exit;
  end;

  if result > 0 then
  begin
    ID := CurrClassID;
    MemberRec := ClassList.FindMember(ID, SymbolTable.NameIndex[result], maMyClass);
    if MemberRec = nil then
      result := 0
    else if MemberRec.ID = 0 then
      result := 0
    else
      result := SymbolTable.GetResultID(MemberRec.ID);
  end;
end;

function TPAXParser.CurrClassRec: TPAXClassRec;
begin
  result := ClassList.FindClass(CurrClassID);
end;

function TPAXParser.CurrSubID: Integer;
var
  I: Integer;
begin
  result := 0;

  for I:= LevelStack.Card downto 1 do
  if I > 1 then
    if SymbolTable.Kind[LevelStack[I]] = kindSUB then
    begin
      result := LevelStack[I];
      Exit;
    end;
end;

function TPAXParser.ToInteger(ID: Integer): Integer;
begin
  result := NewVar;
  Gen(OP_TO_INTEGER, ID, 0, result);
end;

function TPAXParser.ToBoolean(ID: Integer): Integer;
begin
  result := NewVar;
  Gen(OP_TO_BOOLEAN, ID, 0, result);
end;

function TPAXParser.ToString(ID: Integer): Integer;
begin
  result := NewVar;
  Gen(OP_TO_STRING, ID, 0, result);
end;

function TPAXParser.IsCallOperator(var Arg1, Arg2, Res: Integer): boolean;
var
  I: Integer;
begin
  I := LastCodeLine;
  if I <= 0 then
  begin
    result := false;
    Exit;
  end;
  with Code do
  begin
    result := (Prog[I].Op = OP_CALL);
    Arg1 := Prog[I].Arg1;
    Arg2 := Prog[I].Arg2;
    Res := Prog[I].Res;
  end;
end;

function TPAXParser.IsCallOperator: boolean;
var
  I: Integer;
begin
  I := LastCodeLine;
  if I <= 0 then
  begin
    result := false;
    Exit;
  end;
  with Code do
    result := Prog[I].Op = OP_CALL;
end;

procedure TPAXParser.RemoveLastOperator;
var
  I: Integer;
begin
  I := LastCodeLine;
  if I <= 0 then
    Exit;
  Code.Card := I - 1;
end;

function TPAXParser.LastCodeLine: Integer;
var
  I: Integer;
begin
  with Code do
  begin
    I := Card;
    while I > 1 do
      if Prog[I].Op = OP_SEPARATOR then
        Dec(I)
      else
      begin
        result := I;
        Exit;
      end;
    result := 0;
  end;
end;

procedure TPAXParser.InsertCode(L1, L2: Integer);
var
  I: Integer;
begin
  with Code do
    for I:=L1 to L2 do
      if Prog[I].Op <> OP_SEPARATOR then
      begin
        Inc(Card);
        Prog[Card] := Prog[I];
      end;
end;

function TPAXParser.Parse_ByRef: Integer;
begin
  Call_SCANNER;
  result := Parse_Ident;
  SymbolTable.ByRef[result] := 1;
end;

function ExtractModuleName(const S: String): String;
var
  P: Integer;
begin
  P := Pos('.', S);
  if P = 0 then
    result := S
  else
    result := Copy(S, 1, P - 1);
end;

procedure TPAXParser.Parse_ImportsStmt;
var
  I, ID, RefID: Integer;
  S, FullName, ModuleName: String;
  L: TStringList;
begin
  CurrClassRec.UsingInitList.Add(LastCodeLine);

  L := TStringList.Create;
  try

  // match "imports"
  repeat
    S := '';

    Gen(OP_SKIP, 0, 0, 0);
    if not UpCase then
      Gen(OP_UPCASE_ON, 0, 0, 0);

    Call_SCANNER;
    ModuleName := CurrToken.Text + FileExt;
    I := L.IndexOf(ModuleName);
    if I >= 0 then
      raise Exception.Create(Format(errIdentifierIsRedeclared, [ModuleName]));

    L.Add(ModuleName);
    ID := Parse_Ident;
    ID := GenEvalWith(ID);

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

    Gen(OP_USE_NAMESPACE, UsingList.Push(ID), 0, 0);

    if IsCurrText('in') then
    begin
      Call_SCANNER;
      ModuleName := CurrToken.Text;
      FullName := TPaxBaseScripter(Scripter).FindFullName(ModuleName);
      if FullName = '' then
         FullName := ModuleName;

      Gen(OP_ON_USES, NewVar(ModuleName), NewVar(FullName), 0);

      with TPaxBaseScripter(Scripter) do
        if Assigned(OnUsedModule) then
        begin
          I := Modules.IndexOf(ModuleName);
          if I <> -1 then
            S := Modules.Items[I].Text;

          OnUsedModule(TPaxBaseScripter(scripter).Owner, ExtractModuleName(ModuleName), FullName, S);
        end
        else
          ModuleName := CurrToken.Text;

      Parse_Constant;

      TPaxBaseScripter(Scripter).AddExtraModule(ModuleName, S, SyntaxCheckOnly, LanguageName);
    end
    else if NamespaceAsModule then
    begin
      with TPaxBaseScripter(Scripter) do
        if Assigned(OnUsedModule) then
        begin
          I := Modules.IndexOf(ModuleName);
          if I <> -1 then
            S := Modules.Items[I].Text;

          OnUsedModule(TPaxBaseScripter(scripter).Owner, ExtractModuleName(ModuleName), FullName, S);
        end
        else
        begin
        end;

      TPaxBaseScripter(Scripter).AddExtraModule(ModuleName, S, SyntaxCheckOnly, LanguageName);
    end;

    if not IsCurrText(',') then
      Break;
  until false;

  if not UpCase then
    Gen(OP_UPCASE_OFF, 0, 0, 0);
  Gen(OP_HALT_OR_NOP, 0, 0, 0);

  finally
    L.Free;
  end;
end;

function TPAXParser.InUsing(const MemberName: String): Integer;
var
  I, ClassID: Integer;
  ClassRec: TPAXClassRec;
  MemberRec: TPAXMemberRec;
begin
  result := 0;

  ClassRec := CurrClassRec;
  MemberRec := ClassRec.MemberList.GetMemberRec(MemberName, UpCase);
  if MemberRec <> nil then
    if MemberRec.IsStatic then
    begin
      result := MemberRec.ID;
      Exit;
    end;

  for I:=UsingList.Card downto 1 do
  begin
    ClassID := UsingList[I];
    ClassRec := ClassList.FindClass(ClassID);
    if ClassRec <> nil then
    begin