pax_c.pas

来自「Delphi脚本控件」· PAS 代码 · 共 2,854 行 · 第 1/5 页
PAS
2,854 行
////////////////////////////////////////////////////////////////////////////
// PAXScript Interpreter
// Author: Alexander Baranovsky (ab@cable.netlux.org)
// ========================================================================
// Copyright (c) Alexander Baranovsky, 2003-2005. All rights reserved.
// Code Version: 3.0
// ========================================================================
// Unit: PAX_C.pas
// ========================================================================
////////////////////////////////////////////////////////////////////////////

{$I PaxScript.def}
unit PAX_C;

interface

uses
  SysUtils, Classes,
  BASE_CONSTS,
  BASE_SYS, BASE_SCANNER, BASE_PARSER, BASE_SCRIPTER, BASE_EXTERN, BASE_CLASS;

const  
  SP_INC = -1001;
  SP_DEC = -1002;

  SP_PLUS_ASSIGN = -1003;
  SP_MINUS_ASSIGN = -1004;
  SP_MULT_ASSIGN = -1005;
  SP_DIV_ASSIGN = -1006;
  SP_MOD_ASSIGN = -1007;
  SP_LEFT_SHIFT_ASSIGN = -1008;
  SP_RIGHT_SHIFT_ASSIGN = -1009;
  SP_UNSIGNED_RIGHT_SHIFT_ASSIGN = -1011;

  SP_BITWISE_AND = -1012;
  SP_BITWISE_OR = -1013;
  SP_BITWISE_XOR = -1014;

  SP_LOGICAL_AND = -1015;
  SP_LOGICAL_OR = -1016;

  SP_BITWISE_NOT = -1017;
  SP_LOGICAL_NOT = -1018;

  SP_COND = -1019;

  SP_OR_ASSIGN = -1020;
  SP_AND_ASSIGN = -1021;
type
  TSCScanner = class(TPAXScanner)
  public
    procedure ReadToken; override;
  end;

  TPAXCParser = class(TPAXParser)
  private
    ConstIds: TPAXIds;
    procedure ScanFIELD;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure Reset; override;
    procedure Call_SCANNER; override;
    function IsBaseType(const S: String): Boolean; override;

    function Parse_EvalExpression: Integer; override;
    function Parse_ArgumentExpression: Integer; override;

    function Parse_PrimaryExpression: Integer;
    function Parse_ObjectLiteral: Integer;
    function Parse_MemberExpression(ID: Integer; IsConstructor: boolean = false): Integer;
    function Parse_NewExpression: Integer;
    function Parse_LeftHandSideExpression: Integer;
    function Parse_PostfixExpression(Left: Integer): Integer;
    function Parse_UnaryExpression(Left: Integer): Integer;
    function Parse_MultiplicativeExpression(Left: Integer): Integer;
    function Parse_AdditiveExpression(Left: Integer): Integer;
    function Parse_ShiftExpression(Left: Integer): Integer;
    function Parse_RelationalExpression(Left: Integer): Integer;
    function Parse_EqualityExpression(Left: Integer): Integer;
    function Parse_BitwiseANDExpression(Left: Integer): Integer;
    function Parse_BitwiseXORExpression(Left: Integer): Integer;
    function Parse_BitwiseORExpression(Left: Integer): Integer;
    function Parse_LogicalANDExpression(Left: Integer): Integer;
    function Parse_LogicalORExpression(Left: Integer): Integer;
    function Parse_ConditionalExpression(Left: Integer): Integer;

    function Parse_AssignmentExpression: Integer;
    function Parse_Expression: Integer;

    function Parse_ModifierList: TPAXModifierList;
    procedure Parse_Statement;
    procedure Parse_Block;
    procedure Parse_IfStmt;
    procedure Parse_NamespaceStmt(ml: TPAXModifierList);
    procedure Parse_FunctionStmt(ml: TPAXModifierList;
                                 T: Integer = typeVARIANT;
                                 const DllName: String = '');
    procedure Parse_ReturnStmt;
    procedure Parse_HaltStmt;
    procedure Parse_VarStmt(IsField: Boolean; ml: TPAXModifierList;
                            T: Integer = 0;
                            IsLoopVar: Boolean = false);
    function Parse_VariableDeclaration(IsField: Boolean;
                       ml: TPAXModifierList; T: Integer;
                       IsLoopVar: Boolean = false): Integer;
    function Parse_ClassStmt(ClassML: TPAXModifierList; ck: TPAXClassKind): Integer;
    function Parse_EnumStmt: Integer;
    procedure Parse_ExpressionStmt;
    procedure Parse_WhileStmt;
    procedure Parse_DoStmt;
    procedure Parse_ForStmt;
    procedure Parse_ContinueStmt;
    procedure Parse_BreakStmt;
    procedure Parse_SwitchStmt;
    procedure Parse_WithStmt;
    procedure Parse_ThrowStmt;
    procedure Parse_TryStmt;

    procedure Parse_StmtList; override;
    procedure Parse_SourceElements;

    procedure Parse_Program; override;
  end;


implementation

procedure TSCScanner.ReadToken;
begin
  inherited;

  repeat

    if BuffToken.Text <> '' then
    begin
      Token := BuffToken;
      BuffToken.Text := '';
      Exit;
    end;

    GetNextChar;

    Token.TokenClass := tcNone;

    case c of
      #8, #9, #10, #13, #32: ScanWhiteSpace;
      #255: ScanEOF;
      '0'..'9': ScanDigits;
      '$': ScanHexDigits;
      'A'..'Z', 'a'..'z', '_':
      begin
        ScanIdentifier;

        if StrEql(Token.Text, 'in') then
        begin
          Token.TokenClass := tcSpecial;
          Token.ID := OP_IN;
        end
        else if StrEql(Token.Text, 'instanceof') then
        begin
          Token.TokenClass := tcSpecial;
          Token.ID := OP_INSTANCEOF;
        end
        else if StrEql(Token.Text, 'delete') then
        begin
          Token.TokenClass := tcSpecial;
          Token.ID := OP_DESTROY_OBJECT;
        end;
      end;
      '+':
      begin
        ScanPlus;
        case LA(1) of
          '+':
          begin
            GetNextChar;
            Token.Text := '++';
            Token.ID := SP_INC;
          end;
          '=':
          begin
            GetNextChar;
            Token.Text := '+=';
            Token.ID := SP_PLUS_ASSIGN;
          end;
        end;
      end;
      '-':
      begin
        ScanMinus;
        case LA(1) of
          '-':
          begin
            GetNextChar;
            Token.Text := '--';
            Token.ID := SP_DEC;
          end;
          '=':
          begin
            GetNextChar;
            Token.Text := '-=';
            Token.ID := SP_MINUS_ASSIGN;
          end;
        end;
      end;
      '*':
      begin
        ScanMult;
        if LA(1) = '=' then
        begin
          GetNextChar;
          Token.Text := '*=';
          Token.ID := SP_MULT_ASSIGN;
        end;
      end;
      '/':
      begin
        if LA(1) = '*' then
        begin
          repeat
            GetNextChar;

            if c in [#10,#13] then
            begin
              IncLineNumber;
              PosNumber := -1;

              if c = #13 then
                GetNextChar;
            end;

          until ((LA(1) = '*') and (LA(2) = '/')) or (LA(1) = #255);
          GetNextChar;
          GetNextChar;
          Continue;
        end
        else if LA(1) = '/' then
        begin
          repeat
            GetNextChar;
          until LA(1) in [#13, #10];
          Continue;
        end;

        ScanDiv;
        if LA(1) = '=' then
        begin
          GetNextChar;
          Token.Text := '/=';
          Token.ID := SP_DIV_ASSIGN;
        end;
      end;
      '=':
      begin
        ScanEQ;
        Token.ID := OP_ASSIGN;
        if LA(1) = '=' then
        begin
          GetNextChar;
          Token.Text := '==';
          Token.ID := OP_EQ;
        end;
      end;
      '>':
      begin
        ScanGT;
        case LA(1) of
         '=':
          begin
            GetNextChar;
            Token.Text := '>=';
            Token.ID := OP_GE;
          end;
         '>':
          begin
            GetNextChar;
            Token.Text := '>>';
            Token.ID := OP_RIGHT_SHIFT;
            case LA(1) of
              '=':
              begin
                GetNextChar;
                Token.Text := '>>=';
                Token.ID := SP_RIGHT_SHIFT_ASSIGN;
              end;
              '>':
              begin
                GetNextChar;
                Token.Text := '>>>';
                Token.ID := OP_UNSIGNED_RIGHT_SHIFT;
                if LA(1) = '=' then
                begin
                  GetNextChar;
                  Token.Text := '>>>=';
                  Token.ID := SP_UNSIGNED_RIGHT_SHIFT_ASSIGN;
                end;
              end;
            end;
          end;
        end;
      end;
      '<':
      case ScannerState of
        scanText:
        begin
          if LA(1) = '?' then
          begin
            GetNextChar;
            GetNextChar;
            ScanIdentifier;

            if not StrEql('pax', Trim(Token.Text)) then
              raise TPAXScriptFailure.Create(errIllegalCharacter);

            ScannerState := scanProg;
            Continue;
          end
          else if LA(1) = '%' then
          begin
            GetNextChar;
            ScannerState := scanProg;

            if LA(1) = '=' then
            begin
              GetNextChar;
              BuffToken.Text := 'print';
            end;

            Continue;
          end
          else if LA(1) in ['a'..'z','A'..'Z'] then
            ScanHtmlString(c)
          else
            raise TPAXScriptFailure.Create(errIllegalCharacter);
        end;
        scanProg:
        begin
          ScanLT;
          case LA(1) of
            '=':
            begin

              GetNextChar;
              Token.Text := '<=';
              Token.ID := OP_LE;
            end;
           '<':
            begin
              GetNextChar;
              Token.Text := '<<';
              Token.ID := OP_LEFT_SHIFT;
              if LA(1) = '=' then
              begin
                GetNextChar;
                Token.Text := '<<=';
                Token.ID := SP_LEFT_SHIFT_ASSIGN;
              end;
            end;
          end;
        end;
      end;
      ':': ScanColon;
      '!':
      begin
        Token.Text := c;
        Token.ID := SP_LOGICAL_NOT;
        Token.TokenClass := tcSpecial;

        if LA(1) = '=' then
        begin
          GetNextChar;
          Token.Text := '!=';
          Token.ID := OP_NE;
        end
      end;
      '%':
      case ScannerState of
        scanText:
          raise TPAXScriptFailure.Create(errIllegalCharacter);
        scanProg:
        if LA(1) = '>' then
        begin
          ScannerState := scanText;
          GetNextChar;
          ScanHtmlString('');
        end
        else
        begin
          ScanMod;
          if LA(1) = '=' then
          begin
            GetNextChar;
            Token.Text := '%=';
            Token.ID := SP_MOD_ASSIGN;
          end;
        end;
      end;
      '~':
      begin
        Token.Text := c;
        Token.ID := SP_BITWISE_NOT;
        Token.TokenClass := tcSpecial;
      end;
      '?':
      begin
        case ScannerState of
          ScanText:
            raise TPAXScriptFailure.Create(errIllegalCharacter);
          ScanProg:
          begin
            if LA(1) = '>' then
            begin
              ScannerState := scanText;
              GetNextChar;
              ScanHtmlString('');
            end
            else
            begin
              Token.Text := c;
              Token.ID := SP_COND;
              Token.TokenClass := tcSpecial;
            end;
          end;
        end;
      end;
      '|':
      begin
        Token.Text := c;
        Token.ID := SP_BITWISE_OR;
        Token.TokenClass := tcSpecial;
        if LA(1) = '|' then
        begin
          GetNextChar;
          Token.Text := '||';
          Token.ID := SP_LOGICAL_OR;
        end
        else if LA(1) = '=' then
        begin
          GetNextChar;
          Token.Text := '|=';
          Token.ID := SP_OR_ASSIGN;
        end;
      end;
      '&':
      begin
        Token.Text := c;
        Token.ID := SP_BITWISE_AND;
        Token.TokenClass := tcSpecial;
        if LA(1) = '&' then
        begin
          GetNextChar;
          Token.Text := '&&';
          Token.ID := SP_LOGICAL_AND;
        end
        else if LA(1) = '=' then
        begin
          GetNextChar;
          Token.Text := '|=';
          Token.ID := SP_AND_ASSIGN;
        end;
      end;
      '#':
      if LookForward then
      begin
        repeat
          GetNextChar;
        until LA(1) in [#13, #10];
        continue;
      end
      else
      begin
        ScanCondDir('#', ['a'..'z','A'..'Z','_','0'..'9']);
        continue;
      end;
      ';': ScanSemiColon;
      '(': ScanLeftRoundBracket;
      ')': ScanRightRoundBracket;
      '[': ScanLeftBracket;
      ']': ScanRightBracket;
      '{': ScanLeftBrace;
      '}': ScanRightBrace;
      ',': ScanComma;
      '.': ScanPoint;
      '''': ScanString('''');
      '"': ScanString('"');
    else
      raise TPAXScriptFailure.Create(errIllegalCharacter);
    end;

    if Token.TokenClass <> tcNone then
      Exit;

  until false;
end;

constructor TPAXCParser.Create;
begin
  ConstIds := TPAXIds.Create(false);
  inherited;

  Scanner := TSCScanner.Create(Self);

  UpCase := false;

  with Keywords do
  begin
    Add('base');
    Add('break');
    Add('bool');
    Add('byte');
    Add('case');
    Add('catch');
    Add('cdecl');
    Add('class');
    Add('const');
    Add('continue');
    Add('delete');
    Add('do');
    Add('double');
    Add('else');
    Add('extern');
    Add('false');
    Add('finally');
    Add('for');
    Add('function');
    Add('get');
    Add('goto');
    Add('enum');
    Add('if');
    Add('in');
    Add('int');
    Add('long');
    Add('float');
    Add('decimal');
    Add('namespace');
    Add('new');
    Add('operator');
    Add('override');
    Add('out');
    Add('pascal');
    Add('public');
    Add('private');
    Add('ref');
    Add('reduced');
    Add('register');
    Add('return');
    Add('safecall');
    Add('sbyte');
    Add('set');
    Add('short');
    Add('static');
    Add('stdcall');
    Add('string');
    Add('structure');
    Add('switch');
//    Add('THIS');
    Add('throw');
    Add('true');
    Add('try');
    Add('typeof');
    Add('var');
    Add('virtual');
    Add('void');
    Add('ushort');
    Add('using');
    Add('while');
    Add('with');

    Add('print');
    Add('println');
pax_c.pas - 源码说明

本页面展示了「Delphi脚本控件」中的 pax_c.pas 源码文件，采用 PAS 编程语言编写，共 2,854 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。
虫虫下载站收录了大量与Delphi相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。
⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?