pascal_parser.pas

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

  if IsCurrText('=') then
  begin
    Call_SCANNER;
    if CurrToken.Text = '-' then
    begin
      Call_SCANNER;
      D.DefParamList.Add(- CurrToken.Value);
    end
    else if StrEql('Low', CurrToken.Text) then
    begin
      Call_SCANNER; // low
      Call_SCANNER; // (
      if StrEql(CurrToken.Text, 'integer') then
        D.DefParamList.Add(Low(Integer))
      else if StrEql(CurrToken.Text, 'byte') then
        D.DefParamList.Add(Low(byte))
      else if StrEql(CurrToken.Text, 'smallint') then
        D.DefParamList.Add(Low(smallint))
      else if StrEql(CurrToken.Text, 'shortint') then
        D.DefParamList.Add(Low(shortint))
      else if StrEql(CurrToken.Text, 'char') then
        D.DefParamList.Add(Low(char))
      else if StrEql(CurrToken.Text, 'word') then
        D.DefParamList.Add(Low(word))
      else if StrEql(CurrToken.Text, 'cardinal') then
        D.DefParamList.Add(Low(cardinal));
      Call_SCANNER; // val
    end
    else if StrEql('High', CurrToken.Text) then
    begin
      Call_SCANNER; // high
      Call_SCANNER; // (
      if StrEql(CurrToken.Text, 'integer') then
        D.DefParamList.Add(high(Integer))
      else if StrEql(CurrToken.Text, 'byte') then
        D.DefParamList.Add(high(byte))
      else if StrEql(CurrToken.Text, 'smallint') then
        D.DefParamList.Add(high(smallint))
      else if StrEql(CurrToken.Text, 'shortint') then
        D.DefParamList.Add(high(shortint))
      else if StrEql(CurrToken.Text, 'char') then
        D.DefParamList.Add(high(char))
      else if StrEql(CurrToken.Text, 'word') then
        D.DefParamList.Add(high(word))
      else if StrEql(CurrToken.Text, 'cardinal') then
        D.DefParamList.Add(high(cardinal));
      Call_SCANNER; // val
    end
    else
    begin
      if CurrToken.Text = '[' then
      begin
        S := '[';
        Call_SCANNER;
        if CurrToken.Text <> ']' then
        begin
          repeat
            S := S + CurrToken.Text;
            Call_SCANNER; // ',' or ']'
            if CurrToken.Text = ']' then
              break
            else
            begin
              S := S + CurrToken.Text;
              Call_SCANNER;
            end;
          until false;
        end;
        S := S + ']';
        D.DefParamList.Add(S);
      end
      else
        D.DefParamList.Add(CurrToken.Value);
    end;
    Call_SCANNER;
  end;
end;

procedure TPascalParser.Parse_FormalParameters;
begin
  NP := 1;
  Parse_FormalParameter;
  while IsCurrText(';') do
  begin
    Inc(NP);
    Call_SCANNER;
    Parse_FormalParameter;
  end;
end;

procedure TPascalParser.Parse_Heading;
var
  I, ResType, ExtraTypeID, Size: Integer;
  StrType: String;
  b: boolean;
begin
  D.NP := 0;
  ResType := 0;
  SetLength(D.Types, 100);
  SetLength(D.ExtraTypes, 100);
  SetLength(D.StrTypes, 100);
  SetLength(D.ParamNames, 100);
  SetLength(D.ByRefs, 100);
  SetLength(D.Consts, 100);
  SetLength(D.Sizes, 100);
  for I:=0 to Length(D.Sizes) - 1 do D.Sizes[I] := -1;

  Scanner.SourceCode := D.Header;
  Call_SCANNER;

  if IsCurrText('class') then
  begin
    D.ml := D.ml + [modSTATIC];
    Call_SCANNER;
  end;

  if IsCurrText('function') then
  begin
    D.TypeSub := tsFunction;
  end
  else if IsCurrText('procedure') then
  begin
    D.TypeSub := tsProcedure;
  end
  else if IsCurrText('constructor') then
  begin
    D.TypeSub := tsConstructor;
  end
  else if IsCurrText('destructor') then
  begin
    D.TypeSub := tsDestructor;
  end
  else
    Match('function');

  Call_SCANNER;
  D.Name := Parse_Ident;

  if IsCurrText('(') then
  begin
    Call_SCANNER;
    if not IsCurrText(')') then
      Parse_FormalParameters;
    Match(')');
    Call_SCANNER;
  end;

  b := false;
  for I:=0 to D.NP - 1 do
    if D.ExtraTypes[I] = typeDYNAMICARRAY then
    begin
      b := true;
      break;
    end;

  if b then
  begin
    I := ArrayParamMethods.IndexOf(D.Name);
    if I = -1 then
      ArrayParamMethods.Add(D.Name);
  end;

  case D.TypeSub of
    tsFunction:
    begin
      Match(':');
      Call_SCANNER;
      ResultType := CurrToken.Text;
      D.ResultType := CurrToken.Text;
      StrType := Parse_Type(ResType, ExtraTypeID, Size);

      D.Types[D.NP] := ResType;
      D.ByRefs[D.NP] := true;
      D.Consts[D.NP] := false;
      D.Sizes[D.NP] := Size;
      D.StrTypes[D.NP] := StrType;
      D.ExtraTypes[D.NP] := ExtraTypeID;

      if IsDynamicArrayType then
      begin
        IsDynamicArrayType := false;
        D.ReturnsDynamicArray := true;
      end;
    end;
    tsConstructor:
    begin
      D.Types[D.NP] := typeCLASS;
      D.ByRefs[D.NP] := true;
      D.Consts[D.NP] := false;
    end;
  end;

  SetLength(D.Types, D.NP + 1);
  SetLength(D.ExtraTypes, D.NP + 1);
  SetLength(D.StrTypes, D.NP + 1);
  SetLength(D.ParamNames, D.NP + 1);
  SetLength(D.ByRefs, D.NP + 1);
  SetLength(D.Consts, D.NP + 1);
  SetLength(D.Sizes, D.NP + 1);

  while IsCurrText(';') do
  begin
   Call_SCANNER;
   if IsCurrText('cdecl') then begin
     D.CallConv := _ccCDecl;
     Call_SCANNER;
   end
   else if IsCurrText('pascal') then begin
     D.CallConv := _ccPascal;
     Call_SCANNER;
   end
   else if IsCurrText('stdcall') then begin
     D.CallConv := _ccStdCall;
     Call_SCANNER;
   end
   else if IsCurrText('safecall') then begin
     D.CallConv := _ccSafeCall;
     Call_SCANNER;
   end
   else if IsCurrText('virtual') then begin
     D.ml := D.ml + [modVIRTUAL];
     Call_SCANNER;
   end
   else if IsCurrText('override') then begin
     D.ml := D.ml + [modVIRTUAL];
     Call_SCANNER;
   end
   else if IsCurrText('dynamic') then begin
     D.ml := D.ml + [modVIRTUAL];
     Call_SCANNER;
   end
   else if IsCurrText('overload') or IsCurrText('register') then begin
     Call_SCANNER;
   end;
 end;

end;

function TPascalParser.Parse_Property(var ReadName, WriteName: String;
                                      var Def: Boolean; DefList: TPAXDefinitionList): String;
begin
  ReadName := '';
  WriteName := '';
  Def := false;

  Match('property');

  Call_SCANNER;
  result := Parse_Ident;

  if IsCurrText('[') then
  begin
    Call_SCANNER;
    D := TPAXMethodDefinition.Create(nil, '', nil, 0, nil, false);
    D.DefList := DefList;
    SetLength(D.Types, 100);
    SetLength(D.ExtraTypes, 100);
    SetLength(D.StrTypes, 100);
    SetLength(D.ParamNames, 100);
    SetLength(D.ByRefs, 100);
    SetLength(D.Consts, 100);
    SetLength(D.Sizes, 100);
    try
      Parse_FormalParameters;
    finally
      D.Free;
    end;
    Match(']');
    Call_SCANNER;
  end;

  Match(':');

  Call_SCANNER;
  ResultType := CurrToken.Text;
  Parse_Ident;

  repeat
    if IsCurrText('index') then
    begin
      Call_SCANNER;
      Parse_Ident;
    end
    else if IsCurrText('read') then
    begin
      Call_SCANNER;
      ReadName := Parse_Ident;
    end
    else if IsCurrText('write') then
    begin
      Call_SCANNER;
      WriteName := Parse_Ident;
    end
    else if IsCurrText('stored') then
    begin
      Call_SCANNER;
      Parse_Ident;
    end
    else if IsCurrText('default') then
    begin
      Call_SCANNER;
      Parse_Ident;
    end
    else if IsCurrText('nodefault') then
    begin
      Call_SCANNER;
    end
    else if IsCurrText('implements') then
    begin
      Call_SCANNER;
      Parse_Ident;
    end
    else
      Match('implements');

     if IsCurrText(';') then
       Break;

     if IsCurrText('EOF') then
       Break;
  until false;
  if IsCurrText(';') then
  begin
    Call_SCANNER;
    Def := IsCurrText('default');
  end;
end;

procedure TPascalParser.ParseUsesClause(Output: TStrings);
var
  S: String;
begin
  Match('uses');
  Call_SCANNER;
  repeat
    S := Parse_Ident;
    Output.Add(S);

    if IsCurrText(',') then
      Call_SCANNER
    else if IsCurrText(';') then
      break
    else
      Match(';');
  until false;
end;

end.