dws2stringfunctions.pas

script language

{**********************************************************************}
{                                                                      }
{    "The contents of this file are subject to the Mozilla Public      }
{    License Version 1.1 (the "License"); you may not use this         }
{    file except in compliance with the License. You may obtain        }
{    a copy of the License at                                          }
{                                                                      }
{    http://www.mozilla.org/MPL/                                       }
{                                                                      }
{    Software distributed under the License is distributed on an       }
{    "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express       }
{    or implied. See the License for the specific language             }
{    governing rights and limitations under the License.               }
{                                                                      }
{    The Original Code is DelphiWebScriptII source code, released      }
{    January 1, 2001                                                   }
{                                                                      }
{    The Initial Developer of the Original Code is Matthias            }
{    Ackermann.                                                        }
{                                                                      }
{    Portions created by Matthias Ackermann are Copyright              }
{                        (C) 2000 Matthias Ackermann, Switzerland.     }
{    Portions created by Eric Grange are Copyright                     }
{                        (C) 2001 Eric Grange, France.                 }
{                                                                      }
{                                                                      }
{    All Rights Reserved.                                              }
{                                                                      }
{                                                                      }
{    Contributor(s):  Eric Grange                                      }
{                                                                      }
{    Compatibility:                                                    }
{       [x] D5 (WK)   [x] D6 (WK)    [x] K1 (WK)                       }
{**********************************************************************}

// dws2StringFunctions - Generated : 27.02.01 12:43:46

{$I dws2.inc}
unit dws2StringFunctions;

interface

uses Classes, dws2Functions, dws2Exprs, dws2Symbols;

type

  TIntToStrFunc = class(TInternalFunction)
    procedure Execute; override;
    function Optimize(FuncExpr: TExprBase): TExprBase; override;
  end;
  TIntToStrFuncExpr = class(TUnaryOpExpr)
    function Eval: Variant; override;
  end;

  TStrToIntFunc = class(TInternalFunction)
    procedure Execute; override;
    function Optimize(FuncExpr: TExprBase): TExprBase; override;
  end;
  TStrToIntFuncExpr = class(TUnaryOpExpr)
    function Eval: Variant; override;
  end;

  TStrToIntDefFunc = class(TInternalFunction)
    procedure Execute; override;
  end;

  TIntToHexFunc = class(TInternalFunction)
    procedure Execute; override;
  end;

  TFloatToStrFunc = class(TInternalFunction)
    procedure Execute; override;
    function Optimize(FuncExpr: TExprBase): TExprBase; override;
  end;
  TFloatToStrFuncExpr = class(TUnaryOpExpr)
    function Eval: Variant; override;
  end;

  TStrToFloatFunc = class(TInternalFunction)
    procedure Execute; override;
    function Optimize(FuncExpr: TExprBase): TExprBase; override;
  end;
  TStrToFloatFuncExpr = class(TUnaryOpExpr)
    function Eval: Variant; override;
  end;

  TStrToFloatDefFunc = class(TInternalFunction)
    procedure Execute; override;
  end;

  TChrFunc = class(TInternalFunction)
    procedure Execute; override;
  end;

  TOrdFunc = class(TInternalFunction)
    procedure Execute; override;
  end;

  TCharAtFunc = class(TInternalFunction)
    procedure Execute; override;
  end;

  TSetCharAtFunc = class(TInternalFunction)
    procedure Execute; override;
  end;

  TCopyFunc = class(TInternalFunction)
    procedure Execute; override;
  end;

  TDeleteFunc = class(TInternalFunction)
    procedure Execute; override;
  end;

  TInsertFunc = class(TInternalFunction)
    procedure Execute; override;
  end;

  TLowerCaseFunc = class(TInternalFunction)
    procedure Execute; override;
    function Optimize(FuncExpr: TExprBase): TExprBase; override;
  end;
  TLowerCaseFuncExpr = class(TUnaryOpExpr)
    function Eval: Variant; override;
  end;

  TAnsiLowerCaseFunc = class(TInternalFunction)
    procedure Execute; override;
    function Optimize(FuncExpr: TExprBase): TExprBase; override;
  end;
  TAnsiLowerCaseFuncExpr = class(TUnaryOpExpr)
    function Eval: Variant; override;
  end;

  TUpperCaseFunc = class(TInternalFunction)
    procedure Execute; override;
    function Optimize(FuncExpr: TExprBase): TExprBase; override;
  end;
  TUpperCaseFuncExpr = class(TUnaryOpExpr)
    function Eval: Variant; override;
  end;

  TAnsiUpperCaseFunc = class(TInternalFunction)
    procedure Execute; override;
    function Optimize(FuncExpr: TExprBase): TExprBase; override;
  end;
  TAnsiUpperCaseFuncExpr = class(TUnaryOpExpr)
    function Eval: Variant; override;
  end;

  TPosFunc = class(TInternalFunction)
    procedure Execute; override;
  end;

  TLengthFunc = class(TInternalFunction)
    procedure Execute; override;
    function Optimize(FuncExpr: TExprBase): TExprBase; override;
  end;
  TLengthFuncExpr = class(TUnaryOpExpr)
    function Eval: Variant; override;
  end;

  TSetLengthFunc = class(TInternalFunction)
    procedure Execute; override;
  end;

  TTrimLeftFunc = class(TInternalFunction)
    procedure Execute; override;
    function Optimize(FuncExpr: TExprBase): TExprBase; override;
  end;
  TTrimLeftFuncExpr = class(TUnaryOpExpr)
    function Eval: Variant; override;
  end;

  TTrimRightFunc = class(TInternalFunction)
    procedure Execute; override;
    function Optimize(FuncExpr: TExprBase): TExprBase; override;
  end;
  TTrimRightFuncExpr = class(TUnaryOpExpr)
    function Eval: Variant; override;
  end;

  TTrimFunc = class(TInternalFunction)
    procedure Execute; override;
    function Optimize(FuncExpr: TExprBase): TExprBase; override;
  end;
  TTrimFuncExpr = class(TUnaryOpExpr)
    function Eval: Variant; override;
  end;

  TCompareTextFunc = class(TInternalFunction)
    procedure Execute; override;
  end;

  TAnsiCompareTextFunc = class(TInternalFunction)
    procedure Execute; override;
  end;

  TCompareStrFunc = class(TInternalFunction)
    procedure Execute; override;
  end;

  TAnsiCompareStrFunc = class(TInternalFunction)
    procedure Execute; override;
  end;

  TIsDelimiterFunc = class(TInternalFunction)
    procedure Execute; override;
  end;

  TLastDelimiterFunc = class(TInternalFunction)
    procedure Execute; override;
  end;

  TQuotedStrFunc = class(TInternalFunction)
    procedure Execute; override;
    function Optimize(FuncExpr: TExprBase): TExprBase; override;
  end;
  TQuotedStrFuncExpr = class(TUnaryOpExpr)
    function Eval: Variant; override;
  end;

  TStringOfCharFunc = class(TInternalFunction)
    procedure Execute; override;
  end;
  
implementation

uses SysUtils;

const // type constants to make sure strings get reused by the compiler
  cFloat = 'Float';
  cInteger = 'Integer';
  cString = 'String';
  cBoolean = 'Boolean';

  { TIntToStrFunc }

procedure TIntToStrFunc.Execute;
begin
  Info.Result := IntToStr(Integer(Info['i']));
end;

function TIntToStrFunc.Optimize(FuncExpr: TExprBase): TExprBase;
begin
  with FuncExpr as TFuncExpr do
  begin
    if Args[0] is TConstExpr then
      result := TConstExpr.Create(Prog, Pos, Prog.TypString,
        IntToStr(Args[0].Eval))
    else
      result := TIntToStrFuncExpr.Create(Prog, Pos, Args[0]);
    Args.Clear;
    Free;
  end;
end;

function TIntToStrFuncExpr.Eval: Variant;
begin
  result := IntToStr(Expr.Eval);
end;

{ TStrToIntFunc }

procedure TStrToIntFunc.Execute;
begin
  Info.Result := StrToInt(Info['str']);
end;

function TStrToIntFunc.Optimize(FuncExpr: TExprBase): TExprBase;
begin
  with FuncExpr as TFuncExpr do
  begin
    if Args[0] is TConstExpr then
      result := TConstExpr.Create(Prog, Pos, Prog.TypInteger,
        StrToInt(Args[0].Eval))
    else
      result := TStrToIntFuncExpr.Create(Prog, Pos, Args[0]);
    Args.Clear;
    Free;
  end;
end;

function TStrToIntFuncExpr.Eval: Variant;
begin
  result := StrToInt(Expr.Eval);
end;

{ TStrToIntDefFunc }

procedure TStrToIntDefFunc.Execute;
begin
  Info.Result := StrToIntDef(Info['str'], Integer(Info['def']));
end;

{ TIntToHexFunc }

procedure TIntToHexFunc.Execute;
begin
  Info.Result := IntToHex(Integer(Info['v']), Integer(Info['digits']));
end;

{ TFloatToStrFunc }

procedure TFloatToStrFunc.Execute;
begin
  Info.Result := FloatToStr(Info['f']);
end;

function TFloatToStrFunc.Optimize(FuncExpr: TExprBase): TExprBase;
begin
  with FuncExpr as TFuncExpr do
  begin
    if Args[0] is TConstExpr then
      result := TConstExpr.Create(Prog, Pos, Prog.TypString,
        FloatToStr(Args[0].Eval))
    else
      result := TFloatToStrFuncExpr.Create(Prog, Pos, Args[0]);
    Args.Clear;
    Free;
  end;
end;

function TFloatToStrFuncExpr.Eval: Variant;
begin
  result := FloatToStr(Expr.Eval);
end;

{ TStrToFloatFunc }

procedure TStrToFloatFunc.Execute;
begin
  Info.Result := StrToFloat(Info['str']);
end;

function TStrToFloatFunc.Optimize(FuncExpr: TExprBase): TExprBase;
begin
  with FuncExpr as TFuncExpr do
  begin
    if Args[0] is TConstExpr then
      result := TConstExpr.Create(Prog, Pos, Prog.TypFloat,
        StrToFloat(Args[0].Eval))
    else
      result := TStrToFloatFuncExpr.Create(Prog, Pos, Args[0]);
    Args.Clear;
    Free;
  end;
end;

function TStrToFloatFuncExpr.Eval: Variant;
begin
  result := StrToFloat(Expr.Eval);
end;

{ TStrToFloatDefFunc }

procedure TStrToFloatDefFunc.Execute;
begin
  try
    Info.Result := StrToFloat(Info['str']);
  except
    Info.Result := Info['def'];
  end;
end;

{ TCopyFunc }

procedure TCopyFunc.Execute;
begin
  Info.Result := Copy(Info['str'], Integer(Info['index']),
    Integer(Info['len']));
end;

{ TDeleteFunc }

procedure TDeleteFunc.Execute;
var
  s: string;
begin
  s := Info['S'];
  Delete(s, Integer(Info['Index']), Integer(Info['Len']));
  Info['S'] := s;
end;

{ TInsertFunc }