cs2_var.pas

Delphi script parser

unit CS2_VAR; {Cajscript 2.0 Variable management, Procedure management}
{$I CS2_DEF.INC}
interface
uses
  CS2_UTL;
type
  TCS2Error = Word;

const
  ENoError = 0;
  ECanNotReadProperty = 1;
  ECanNotWriteProperty = 2;
  EUnknownIdentifier = 3;
  EIdentifierExpected = 4;
  ESemicolonExpected = 5;
  EBeginExpected = 6;
  EDuplicateIdentifier = 7;
  EUnexpectedEndOfFile = 8;
  EColonExpected = 9;
  ESyntaxError = 10;
  EStringError = 11;
  EErrorInStatement = 12;
  EAssignmentExpected = 13;
  ETypeMismatch = 14;
  EErrorInExpression = 15;
  ERoundOpenExpected = 16;
  ERoundCloseExpected = 17;
  EVariableExpected = 18;
  ECommaExpected = 19;
  EThenExpected = 20;
  EPeriodExpected = 21;
  EParameterError = 22;
  EToExpected = 23;
  EDoExpected = 24;
  ERangeError = 25;
  EOfExpected = 26;
  EEndExpected = 27;
  EOutOfRange = 28;
  EOpenBlockExpected = 29;
  ECloseBlockExpected = 30;

const
  CSV_NONE = 0; { Void/ERROR }
  CSV_UByte = 1; { Byte }
  CSV_SByte = 2; { ShortInt }
  CSV_UInt16 = 3; { Word }
  CSV_SInt16 = 4; { Integer (Delphi : SmallInt) }
  CSV_UInt32 = 5; { Longint (Delphi : Cardinal) }
  CSV_SInt32 = 6; { Longint }
  CSV_Char = 7; { Char }
  CSV_String = 8; { String }
  CSV_Real = 9; { Real }
  CSV_Single = 10; { Single }
  CSV_Double = 11; { Double }
  CSV_Extended = 12; { Extended }
  CSV_Comp = 13; { Comp }
  CSV_Bool = 14; { Boolean }
  CSV_Var = 15; { variable }
  CSV_Array = 16; { array }

type
  PCajVariant = ^TCajVariant;
  TCajVariant = packed record
    VType: Word;
    Flags: Byte; {Readonly(Const) = 1}
{$IFNDEF SS}
    CV_Str: string;
{$ENDIF}
    case Word of
      CSV_UByte: (CV_UByte: Byte);
      CSV_SByte: (CV_SByte: ShortInt);
      CSV_Char: (CV_Char: Char);
      CSV_UInt16: (CV_UInt16: Word);

      CSV_SInt16: (CV_SInt16: {$IFDEF I32}SmallInt{$ELSE}Integer{$ENDIF});
      CSV_UInt32: (CV_UInt32: {$IFDEF I32}Cardinal{$ELSE}LongInt{$ENDIF});
      CSV_SInt32: (CV_SInt32: LongInt);
      CSV_String: ({$IFDEF SS}CV_Str: string{$ENDIF});
      CSV_Real: (CV_Real: Real);
      CSV_Single: (CV_Single: Single);
      CSV_Double: (CV_Double: Double);
      CSV_Extended: (CV_Extended: Extended);
      CSV_Comp: (CV_Comp: Comp);
      CSV_Bool: (CV_Bool: Boolean);
      CSV_Var: (CV_Var: Pointer); {Pointer to a CajVariant}
      CSV_Array: (CV_ArrVType: Word; CV_ArrItems: TifList);
  end;
{ Array:
  SubType(s): IntToStr(TypeNo);
}

function CreateCajVariant(VType, ArrVType: Word): PCajVariant;
procedure SetType(p: PCajVariant; FType: Word);

function CreateReal(const e: Extended): PCajVariant;
function CreateString(const s: string): PCajVariant;
function CreateInteger(i: LongInt): PCajVariant;
function CreateBool(b: Boolean): PCajVariant;

procedure DestroyCajVariant(p: PCajVariant);

type
  PVariableManager = ^TVariableManager;
  TVariableManager = packed record
    Names: TifStringList;
    Ptr: TifList;
  end;

function VM_Create(InheritFrom: PVariableManager): PVariableManager;
procedure VM_Destroy(p: PVariableManager);
function VM_Add(P: PVariableManager; D: PCajVariant; const Name: string):
PcajVariant;
procedure VM_Delete(p: PVariableManager; Idx: LongInt);
function VM_Get(p: PVariableManager; Idx: LongInt): PCajVariant;
procedure VM_SetName(p: PVariableManager; Idx: LongInt; S: string);
function VM_Count(p: PVariableManager): LongInt;
function VM_Find(p: PVariableManager; const Name: string): LongInt;
procedure VM_Clear(p: PVariableManager);


type
  TRegisteredProc = function(ID: Pointer;
    const ProcName: string; Params: PVariableManager;
    res: PCajVariant): TCS2Error;

  PProcedureManager = ^TProcedureManager;
  TProcedureManager = packed record
    Names: TifStringList;
    Ptr: TifList;
  end;
  {Spec: RESTYPE NAME PARAM1NAME PARAM1TYPE PARAM2NAME PARAM2TYPE
  an ! before the paramname means is VARIABLE
  }

function PM_Create: PProcedureManager;
procedure PM_Destroy(p: PProcedureManager);
procedure PM_Clear(p: PProcedureManager);
procedure PM_Add(p: PProcedureManager; const Spec: string; Addr: Pointer);
procedure PM_Delete(p: PProcedureManager; I: LongInt);
function PM_Find(p: PProcedureManager; const Name: string): Integer;
function PM_Get(p: PProcedureManager; i: LongInt): Pointer;
function PM_GetSpec(p: PProcedureManager; i: LongInt): string;

function DoMinus(p: PCajVariant): Boolean;
function DoNot(p: PCajVariant): Boolean;
type
  TPerformType = (PtSet, ptMinus, PtPlus, PtMul, ptDiv, PtIntDiv, PtIntMod,
    PtAnd,
    ptOr, ptXor, PtShl, PtShr, PtGreater, PtLess, PtEqual, PtNotEqual,
    PtGreaterEqual, PtLessEqual);
function Perform(V1: pCajVariant; v2: pCajVariant; T: TPerformType): Boolean;

procedure SetInteger(p: PCajVariant; I: LongInt);
procedure SetReal(p: PCajVariant; i: Extended);
procedure SetString(p: PCajVariant; const I: string);

function IsStringType(v: PCajVariant): Boolean;
function IsIntRealType(v: PCajVariant): Boolean;
function IsIntegerType(v: PCajVariant): Boolean;
function IsBooleanType(v: PCajVariant): Boolean;
function IsRealType(v: PCajVariant): Boolean;

function GetStr(v: PCajVariant): string;
function GetReal(v: PCajVariant): Extended;
function GetInt(v: PCajVariant): LongInt;
function GetBool(v: PCajVariant): Boolean;

function GetVarLink(V: PCajVariant): PCajVariant;
{Always use this function when using VM_Get}
function GetArrayItem(Arr: PCajVariant; FieldNo: Longint): PCajVariant;

function ErrorToString(e: TCS2Error): string;

implementation

function ErrorToString(e: TCS2Error): string;
begin
  case e of
    ENoError: ErrorToString := 'no error';
    ECanNotReadProperty: ErrorToString := 'can not read property';
    ECanNotWriteProperty: ErrorToString := 'can not write property';
    EUnknownIdentifier: ErrorToString := 'unknown identifier';
    EIdentifierExpected: ErrorToString := 'identifier expected';
    ESemicolonExpected: ErrorToString := 'semicolon expected';
    EBeginExpected: ErrorToString := 'begin expected';
    EDuplicateIdentifier: ErrorToString := 'duplicate identifier';
    EUnexpectedEndOfFile: ErrorToString := 'unexpected end of file';
    EColonExpected: ErrorToString := 'colon expected';
    ESyntaxError: ErrorToString := 'syntax error';
    EStringError: ErrorToString := 'string error';
    EErrorInStatement: ErrorToString := 'error in statement';
    EAssignmentExpected: ErrorToString := 'assignment expected';
    ETypeMismatch: ErrorToString := 'type mismatch';
    EErrorInExpression: ErrorToString := 'error in expression';
    ERoundOpenExpected: ErrorToString := 'round open expected';
    ERoundCloseExpected: ErrorToString := 'round close expected';
    EVariableExpected: ErrorToString := 'variable expected';
    ECommaExpected: ErrorToString := 'comma expected';
    EThenExpected: ErrorToString := 'then expected';
    EPeriodExpected: ErrorToString := 'period expected';
    EParameterError: ErrorToString := 'parameter error';
    EToExpected: ErrorToString := 'to expected';
    EDoExpected: ErrorToString := 'do expected';
    ERangeError: ErrorToString := 'range error';
    EOfExpected: ErrorToString := 'of expected';
    EEndExpected: ErrorToString := 'end expected';
    EOutOfRange: ErrorToString := 'out of range';
    EOpenBlockExpected: ErrorToString := 'open block expected';
    ECloseBlockExpected: ErrorToString := 'close block expected';
  else
    ErrorToString := 'unknown error';
  end;
end;

function GetArrayItem(Arr: PCajVariant; FieldNo: Longint): PCajVariant;
begin
  Arr := GetVarLink(Arr);
  if Arr^.VType <> CSV_Array then
  begin
    GetArrayItem := nil;
    Exit;
  end;
  if (FieldNo < 0) or (FieldNo > Arr^.CV_ArrItems.Count - 1) then
  begin
    GetArrayItem := nil;
    Exit;
  end;
  GetArrayItem := Arr^.CV_ArrItems.GetItem(FieldNo);
end;

function GetVarLink(V: PCajVariant): PCajVariant;
begin
  if Assigned(v) then
    while v^.VType = CSV_Var do
    begin
      if Assigned(V^.CV_Var) then
        v := V^.Cv_Var
      else
        Break;
    end;
  GetVarLink := v;
end;

procedure SetType(p: PCajVariant; FType: Word);
var
  i: Longint;
begin
  if p^.Vtype = CSV_String then
    p^.cv_Str := ''
  else
    if p^.Vtype = CSV_Array then
    begin
      for i := 0 to p^.CV_ArrItems.count - 1 do
      begin
        DestroyCajVariant(p^.CV_ArrItems.GetItem(i));
      end;
      p^.CV_ArrItems.Destroy;
    end;
  p^.VType := FType;
  if FType = CSV_Array then begin
    p^.CV_ArrVType := CSV_UByte;
    p^.CV_ArrItems.Create;
  end;
end;


function CreateCajVariant(VType, ArrVType: Word): PCajVariant;
{
  Creates an instance of a CajVariant.
}
var
  p: PCajVariant;
begin
  New(p);
  p^.VType := VType;
  p^.Flags := 0;
  if VType = CSV_Var then
    p^.CV_Var := nil
  else if VType = CSV_Array then
  begin
    p^.CV_ArrVType := ArrVType;
    p^.CV_ArrItems.Create;
  end;
  CreateCajVariant := p;
end;

function CreateReal(const e: Extended): PCajVariant;
var
  p: PCajVariant;
begin
  p := CreateCajVariant(CSV_Extended, 0);
  p^.Cv_Extended := e;
  CreateReal := p;
end;

function CreateString(const s: string): PCajVariant;
var
  p: PCajVariant;
begin
  p := CreateCajVariant(CSV_String, 0);
  p^.Cv_Str := s;
  CreateString := p;
end;

function CreateInteger(i: LongInt): PCajVariant;
var
  p: PCajVariant;
begin
  p := CreateCajVariant(CSV_SInt32, 0);
  p^.Cv_sInt32 := i;
  CreateInteger := p;
end;

function CreateBool(b: Boolean): PCajVariant;
var
  p: PCajVariant;
begin
  p := CreateCajVariant(CSV_Bool, 0);
  p^.Cv_Bool := b;
  Createbool := p;
end;

procedure DestroyCajVariant(p: PCajVariant);
{ Destroys an instance of a CajVariant.}
var
  i: Longint;
begin
  if Assigned(p) then
  begin
    if P^.Vtype = CSV_Array then
    begin
      for i := 0 to p^.CV_ArrItems.count - 1 do
      begin
        DestroyCajVariant(p^.CV_ArrItems.GetItem(i));
      end;
      p^.CV_ArrItems.Destroy;
    end;
    Dispose(p);
  end;
end;

function VM_Create(InheritFrom: PVariableManager): PVariableManager;
{Creates an instance of a VariableManger}
var
  p: PVariableManager;
  i: Integer;
begin
  New(p);
  p^.names.Create;
  p^.Ptr.Create;
  if Assigned(InheritFrom) then
  begin
    for i := 0 to InheritFrom^.names.count - 1 do
    begin
      p^.names.Add(InheritFrom^.names.GetItem(i));
      p^.Ptr.Add(InheritFrom^.Ptr.GetItem(i));
    end;
  end;
  VM_Create := p;
end;

procedure VM_Destroy(p: PVariableManager);
{Destroys an instance of a VariableManager}
var
  i: Integer;
begin
  for i := 0 to p^.Ptr.count - 1 do
  begin
    DestroyCajVariant(p^.Ptr.GetItem(i));
  end;
  p^.names.Destroy;
  p^.Ptr.Destroy;
  Dispose(p);
end;

function VM_Add(P: PVariableManager; D: PCajVariant; const Name: string):
PCajVariant;
var
  i: Integer;
begin
  for i := 0 to p^.Names.Count - 1 do
  begin
    if p^.names.GetItem(i) = Name then
    begin
      VM_Add := nil;
      Exit;
    end;
  end;
  p^.Names.Add(Name);
  p^.Ptr.Add(D);
  VM_Add := D;