unit uparseadorsupersimple;
(***
  Autor: rch (2013)
  la intención es tener un parseador super-simple de expresiones.
****)
{$mode delphi}
{xDEFINE DEBUG}

interface

uses
  Classes, SysUtils, xmatdefs, matreal, uHistoVarsOps;

type
  TTipoToken = (
    TTK_Ninguno, // -- ninguno --
    TTK_Oper, // +, -, *, =, :=, etc.
    TTK_Func, // nombre(
    TTK_Apertura, // (
    TTK_Cierre,  // )
    TTk_Array, // nombre[
    TTK_Cierre_Array, // ]
    TTK_Var,   // algun_texto
    TTK_Const_S,  // String, "texto entre comillas"
    TTK_Const_F,   // Float,  1.23
    TTK_Const_I,   // Integer, Constante Entera
    TTK_Const_B,  // Boolean, Constante Booleana  0, 1
    TTK_Const_D,  // double (DateTime) representa fecha como TDateTime de pascal.
    TTK_Const_V, // TVectR
    TTK_Const_M, // TMatR
    TTK_Const_C // TCronVarCursorFila
    );



type

  { TTokensLst }

  TTokensLst = class(TList)
    procedure writeln; // solo para debug, lista los tokens Tipo ; valor
    destructor Destroy; override;
  end;

  { TNodoToken }

  TNodoToken = class
    {$IFDEF TOKEN_DEBUG}
    cnt_token: integer;
    {$ENDIF}
    tipo: TTipoToken;
    val: string;
    constructor Create(xTipo: TTipoToken; xVal: string);
    {$IFDEF TOKEN_DEBUG}
    destructor destroy; override;
    {$ENDIF}

  end;

type
  TExprRes = record
    case tipo: char of
      'B': (val_B: boolean);
      'I': (val_I: integer);
      'F': (val_F: double);
      'S': (val_S: shortstring);
      'D': (val_D: TDateTime);
      'V': (val_V: TVectR);
      'M': (val_M: TMatR);
      'C': (val_C: TCronVar);
  end;


  TExprLst = class;
  { TExpresion }

  TExpresion = class
    val: TExprRes;
    procedure evaluar; virtual;

    function crearDerivada(variable:TNodoToken): TExpresion; virtual;
    function crearClon: TExpresion; virtual;
    // Retorna la versión serializada de la expresión.
    function Serialize: string; virtual; abstract;
    //  Retorna la versión serializada de la expresión en un formato más human friendly
    function Serialize2: string; virtual;

    function ValAsStr: string;
    function ValAsFloat: extended;
    function ValAsInt: integer;
    function ValAsBool: boolean;
    function ValAsVectR: TVectR;
    function ValAsMatR: TMatR;
    function ValAsCronVar: TCronVar;

    // debe ser sobrescrito en cada clase descendiente
    //   class function Simbolo: string; virtual; abstract;
  end;

  { TExprLst }

  TExprLst = class(TExpresion)
    lst: TList;
    constructor Create;
    procedure add(aExpr: TExpresion);
    procedure evaluar; override;
    function crearDerivada(variable: TNodoToken): TExprLst; override;
    function crearClon: TExpresion; override;
    function Serialize: string; override;
    function Serialize2: string; override;
    destructor Destroy; override;
  private

    function GetExpr(const i: longint): TExpresion;
  public
    property Items[i: longint]: TExpresion read GetExpr; default;
  end;

  TExprInt = class(TExpresion)
  end;

  TExprNum = class(TExpresion)
  end;

  TExprStr = class(TExpresion)
  end;

  { TConst_I }

  TConst_I = class(TExprInt)
    constructor Create(valorInicial: integer);
    function Serialize: string; override;
    function crearDerivada(variable: TNodoToken): TExpresion; override;
    function crearClon: TExpresion; override;
  end;

  { TConst_F }

  TConst_F = class(TExprNum)
    constructor Create(valorInicial: double);
    function Serialize: string; override;
    function crearDerivada(variable: TNodoToken): TExpresion; override;
    function crearClon: TExpresion; override;
  end;


  { TConst_B }

  TConst_B = class(TExpresion)
    constructor Create(valorInicial: boolean);
    function Serialize: string; override;
    function crearDerivada(variable: TNodoToken): TExpresion; override;
    function crearClon: TExpresion; override;
  end;

  { TConst_D }

  TConst_D = class(TExpresion)
    constructor Create(valorInicial: TDateTime);
    function Serialize: string; override;
    function crearClon: TExpresion; override;

  end;

  { TConst_S }

  TConst_S = class(TExprStr)
    constructor Create(valorInicial: string);
    function Serialize: string; override;
    function crearClon: TExpresion; override;
  end;


  { TConst_V }

  TConst_V = class(TExprStr)
    constructor Create(valorInicial: TVectR);
    function Serialize: string; override;
  end;

  { TConst_M }

  TConst_M = class(TExprStr)
    constructor Create(valorInicial: TMatR);
    function Serialize: string; override;
  end;

  { TConst_C }

  TConst_C = class(TExprStr)
    constructor Create(valorInicial: TCronVar);
    function Serialize: string; override;
  end;


  { TVar }

  TVar = class(TExpresion)
    id: string;
    flg_asignada: boolean;
    constructor Create(id: string; valorInicial: double; flg_asignada: boolean = true );
    function crearDerivada(variable: TNodoToken): TExpresion; override; overload;
    function crearClon: TExpresion; override;
    function Serialize: string; override;
    //    class function Simbolo: string; override; // debe ser sobrescrito en cada clase descendiente
  end;




  { Esta clase permite definir el PROTOTIPO de un OPERADOR }

  { TOperProcDef }

  TOperProcDef_ = class
    nombre: shortstring;
    tiposSalidas: shortstring;
    tiposEntradas: shortstring;
    {$IFDEF CREAR_EXPRESION_DERIVADA}
    lst_opers:TList;
    {$ENDIF}
    procedure evaluar( {%H-}salida: TExpresion; {%H-}entradas: TExprLst); virtual;
    {$IFDEF CREAR_EXPRESION_DERIVADA}
    function crearDerivada(variable: TNodoToken;parametros: TExprLst):TExpresion; virtual;
    {$ENDIF}
    constructor Create(xNombre, xTiposSalidas, xTiposEntradas: shortstring);
    destructor Destroy; override;
  end;


  { TOperProc }

  TOperProc = class(TExpresion)
    template: TOperProcDef_;
    parametros: TExprLst;
    constructor Create( template: TOperProcDef_; parametros: TExprLst);
    function crearClon: TExpresion; override;
    procedure evaluar; override;
    {$IFDEF CREAR_EXPRESION_DERIVADA}
    function crearDerivada(variable:TNodoToken): TExpresion; override;
    {$ENDIF}
    function Serialize: string; override;
    function Serialize2: string; override;
    destructor Destroy; override;
  end;


  { TEvaluadorExpresionesSimples }
  TEvaluadorExpresionesSimples = class

    CatalogoOperadoresBinomicos: TList;
    CatalogoFuncionesEstandar: TList;
    CatalogoFuncionesDeUsuario: TList;
    CatalogoVariables: TList;

    function tokenParser(s: string): TTokensLst;
    function TipoTokenName(tipo: TTipoToken): string;

    // Crea una expresión a partir de la lista de tokens.
    // vacía la lista de tokens.
    // retorna nil si la lista es vacía.
    function GetFullExpresion(var tokens: TTokensLst): TExpresion;

    // funciones de búsqueda en los catálogos
    function FindFuncDef(nombreFunc: string): TOperProcDef_;
    function FindOperDef(nombreOper: string): TOperProcDef_;


    // Ejecuta la secuencia de sentencias y retorna el núemro real
    // resultado de la última sentencia.
    // La ejecución se realiza en el contexto actual y si las sentencias definen
    // variables las mismas quedan definidas.
    // Si el resultado no es asignable a un número real retorna false;
    function Ejecutar(var res: double; str: string): boolean;

    function FindVar(var_id: string): TVar;

    // Verifica si hay variables no-definidas
    function VariablesNoDefinidas: string;

    procedure ClearVars; // Elimina todas las variables definidas.

    function CrearExprFunc(nombreFunc: shortString; parametros: TExprLst): TExpresion;
    function CrearExprOperBi(nombreOper: shortString; a, b: TExpresion): TExpresion;

    constructor Create(auto_regsitrar_basicas: boolean = True);
    destructor Destroy; override;

    // Para ejecutar repetidas veces el mismo scrtip puede llamar
    // aScript:= GetExprLst( str ) y luego ejecutar aScript.evaluar;
    function GetExprLst(str: string): TExprLst;

    function Evaluar(var res: double; const str: string): boolean; overload;
    function Evaluar(var res: integer; const str: string): boolean; overload;
    function Evaluar(var res: boolean; const str: string): boolean; overload;
    function Evaluar(var res: string; const str: string): boolean; overload;

  private
    // Evalua una serie de sentencias (str) y retorna la  Expresion evaluada
    // correspondiente a la última de las sentencias.
    function Evaluar(const str: string): TExpresion;

    function GetNextExpresionList( var tokens: TTokensLst ): TExprLst;
    function GetNextExpresion(var tokens: TTokensLst): TExpresion;

    // Retorna el próximo token de la lista y lo quita de la misma.
    function GetNextToken(var tokens: TTokensLst): TNodoToken;
  end;



function TipoTokenToStr(tipo: TTipoToken): string;

// busca el ";" como serparador de sentencias
function next_sentencia(var s: string): string;

// Conviente un texto de un campo memo en un string parseable
// por el evaluador, y quita los comentarios de cada línea. // en adelante.
function MemoToStr(memo_text: string; Delimiter: Char = ','): string;


implementation

uses
  uoperadoresbinomicosbasicos,
  ufuncionesbasicas;

const
  Separadores = [#0..' ', '(', '+', '-', '*', ')', '%', '>', '=',
    '<', '/', '^', ',', ';', ':', '[', ']'];
  DigitosYPunto = ['0'..'9', '.'];

  {$IFDEF DEBUG}
var
  cnt_tokens: integer;
  {$ENDIF}


function MemoToStr( memo_text: string; Delimiter: Char = ',' ): string;
var
  ss: TStringList;
  ts: string;
  klin: integer;
  iPosBarraBarra: integer;
begin
  ss := TStringList.Create;
  //ss.Delimiter:= #10;
  ss.DelimitedText := memo_text;
  for klin := 0 to ss.Count - 1 do
  begin
    ts := trim(ss[klin]);
    iPosBarraBarra := pos('//', ts);
    if iPosBarraBarra > 0 then
      ts := copy(ts, 1, iPosBarraBarra - 1);
    ss[klin] := trim(ts);
  end;
  ss.LineBreak := ' ';
  Result := ss.Text;
  ss.Free;
end;

function TipoTokenToStr(tipo: TTipoToken): string;
begin
  case tipo of
    TTK_Ninguno: Result := 'Ninguno';
    TTK_Oper: Result := 'Operador';
    TTK_Func: Result := 'Función';
    TTK_Apertura: Result := 'Apertura_(';
    TTK_Cierre: Result := ')_Cierre';
    TTk_Array: Result := 'Array_[';
    TTK_Cierre_Array: Result := ']_Array';
    TTK_Var: Result := 'Var';
    TTK_Const_S: Result := 'Const_S';
    TTK_Const_F: Result := 'Const_F';
    TTK_Const_I: Result := 'Const_I';
    TTK_Const_B: Result := 'Const_B';
    TTK_Const_D: Result := 'Const_D';
    TTK_Const_V: Result := 'Const_V';
    TTK_Const_M: Result := 'Const_M';
    TTK_Const_C: Result := 'Const_C';

    else
      raise Exception.Create('Tipo Token desconocido: ' + IntToStr(Ord(tipo)));
  end;
end;

{ TConst_C }

constructor TConst_C.Create(valorInicial: TCronVar);
begin
  inherited Create;
  val.tipo := 'C';
  val.val_C := valorInicial;
end;

function TConst_C.Serialize: string;
begin
  Result := val.val_C.Serialize;
end;

{ TConst_M }

constructor TConst_M.Create(valorInicial: TMatR);
begin
  inherited Create;
  val.tipo := 'M';
  val.val_M := valorInicial;
end;

function TConst_M.Serialize: string;
begin
  Result := val.val_M.serialize;
end;

{ TConst_V }

constructor TConst_V.Create(valorInicial: TVectR);
begin
  inherited Create;
  val.tipo := 'V';
  self.val.val_V := valorInicial;
end;

function TConst_V.Serialize: string;
begin
  Result := val.val_V.serialize;
end;


procedure TExpresion.evaluar;
begin
  // Nada, pero lo defino para que no quede sin definir.
end;


function TExpresion.crearDerivada(variable: TNodoToken): TExpresion;
begin
  Result:=nil;
end;

function TExpresion.crearClon: TExpresion;
var
  res:TExpresion;
begin
  res:=TExpresion.Create;
  res.val:=self.val;
  Result:=res;
end;

function TExpresion.Serialize2: string;
begin
  Result:=Serialize; // si no está definido que use el de serialize (sirve para las constantes, variables)
end;

function TExpresion.ValAsStr: string;
begin
  case val.tipo of
    'B': if val.val_B then
        Result := '1'
      else
        Result := '0';
    'I': Result := IntToStr(val.val_I);
    'F': Result := FloatToStr(val.val_F);
    'S': Result := val.val_S;
    'D': Result := DateTimeToStr(val.val_D);
    'V', 'M', 'C': Result := '';
    else
      raise Exception.Create('TExpresion.ValAsStr, tipo: ' + val.tipo + ' desconocido');
  end;
end;

function TExpresion.ValAsFloat: extended;
begin
  case val.tipo of
    'B': if val.val_B then
        Result := 1
      else
        Result := 0;
    'I': Result := val.val_I;
    'F': Result := val.val_F;
    'S': Result := StrToFloat(val.val_S);
    'D': Result := double(val.val_D);
    'V', 'M', 'C': Result := 0;
    else
      raise Exception.Create('TExpresion.ValAsFloat, tipo: ' + val.tipo + ' desconocido');
  end;
end;

function TExpresion.ValAsInt: integer;
begin
  case val.tipo of
    'B': if val.val_B then
        Result := 1
      else
        Result := 0;
    'I': Result := val.val_I;
    'F': Result := round(val.val_F);
    'S': Result := StrToInt(val.val_S);
    'D': Result := round(val.val_D);
    'V', 'M', 'C': Result := 0;
    else
      raise Exception.Create('TExpresion.ValAsInt, tipo: ' + val.tipo + ' desconocido');
  end;
end;

function TExpresion.ValAsBool: boolean;
var
  c: char;
begin
  case val.tipo of
    'B': Result := val.val_B;
    'I': Result := val.val_I <> 0;
    'F': Result := val.val_F <> 0;
    'S':
    begin
      if length(val.val_S) > 0 then
      begin
        c := upCase(val.val_S[1]);
        Result := c in ['1', 'V', 'T'];
      end
      else
        Result := False;
    end;
    'D': Result := double(val.val_D) <> 0;
    'V': Result := not val.val_V.isnull;
    'M': Result := not val.val_M.isnull;
    'C': Result := not val.val_C.isnull;
    else
      raise Exception.Create('TExpresion.ValAsBool, tipo: ' + val.tipo + ' desconocido');
  end;
end;

function TExpresion.ValAsVectR: TVectR;
var
  aval: NReal;
  res: TVectR;
begin
  if val.tipo = 'V' then
    Result := val.val_V
  else
  begin
    aval := ValAsFloat;
    res := TVectR.Create_init(1);
    res.pon_e(1, aval);
    Result := res;
  end;
end;

function TExpresion.ValAsMatR: TMatR;
var
  res: TMatR;
begin
  if val.tipo = 'M' then
    Result := val.val_M
  else
  begin
    res := TMatR.Create_Init(1, 0);
    res.pm[1].Free;
    res.pm[1] := ValAsVectR;
    res.nc := res.pm[1].n;
    Result := res;
  end;
end;

function TExpresion.ValAsCronVar: TCronVar;
var
  res: TCronVar;
  m: TMatR;
begin
  if val.tipo = 'C' then
    Result := val.val_C
  else
  begin
    res := TCronVar.Create('_expr_');
    m := ValAsMatR;
    res.inicializar(m.nc, m.nf, 0, 1);
    res.GetCursorFila.CopyFromMatR(m);
    m.Free;
    Result := res;
  end;
end;


constructor TOperProcDef_.Create(xNombre, xTiposSalidas, xTiposEntradas: shortstring);
begin
  inherited Create;
  nombre := xNombre;
  tiposSalidas := xTiposSalidas;
  tiposEntradas := xTiposEntradas;
  {$IFDEF CREAR_EXPRESION_DERIVADA}
  lst_opers:=TList.Create;
  {$ENDIF}
end;

destructor TOperProcDef_.Destroy;
{$IFDEF CREAR_EXPRESION_DERIVADA}
var
  kOper, NOpers:Integer;
  aOper:TOperProcDef_;
{$ENDIF}
begin
  {$IFDEF CREAR_EXPRESION_DERIVADA}
  NOpers:=lst_opers.Count;
  for kOper:=0 to NOpers - 1 do
  begin
    aOper:=lst_opers[kOper];
    aOper.Free;
    lst_opers[kOper]:=nil;
  end;
  lst_opers.Free;
  {$ENDIF}
  inherited Destroy;
end;



procedure TOperProcDef_.evaluar(salida: TExpresion; entradas: TExprLst);
begin
  entradas.Evaluar; // Ojo, por lo general si todos los parámetros deben ser
    // evaluados, los descendientes deben llamar, esto, pero alguno especial
    // que no necesite evaluar todos los parámetros puede no hacerlo.
end;

{$IFDEF CREAR_EXPRESION_DERIVADA}
function TOperProcDef_.crearDerivada(variable: TNodoToken; parametros: TExprLst): TExpresion;
begin
  // Nada
end;
{$ENDIF}

procedure TTokensLst.writeln; // solo para debug, lista los tokens Tipo ; valor
var
  k: integer;
  nodo: TNodoToken;
begin
  for k := 0 to Count - 1 do
  begin
    nodo := items[k];
    system.writeln(nodo.tipo: 4, '; ', nodo.val);
  end;
end;

destructor TTokensLst.Destroy;
var
  k: integer;
  nodo: TNodoToken;
begin
  for k := 0 to Count - 1 do
  begin
    nodo := items[k];
    nodo.Free;
  end;
  inherited Destroy;
end;



function TEvaluadorExpresionesSimples.TipoTokenName(tipo: TTipoToken): string;
begin
  case tipo of
    TTK_Ninguno: Result := 'Ninguno';
    TTK_Oper: Result := 'Operador';
    TTK_Func: Result := 'Función';
    TTk_Array: Result := 'Array';
    TTK_Apertura: Result := 'Apertura';
    TTK_Cierre: Result := 'Cierre';
    TTK_Cierre_Array: Result := 'Cierre_Array';
    TTK_Var: Result := 'Var';
    TTK_Const_S: Result := 'String';
    TTK_Const_F: Result := 'Float';
    TTK_Const_I: Result := 'Integer';
    TTK_Const_B: Result := 'Boolean';
    TTK_Const_V: Result := 'VectR';
    TTK_Const_M: Result := 'MatR';
    TTK_Const_C: Result := 'CronVarCursorFila';
  end;
end;

constructor TNodoToken.Create(xTipo: TTipoToken; xVal: string);
begin
  inherited Create;
  {$IFDEF TOKEN_DEBUG}
  self.cnt_token:= cnt_tokens;
  writeln( 'Creando token: ', Self.cnt_token, ' ', self.tipo, ' ', self.val );
  inc( cnt_tokens );
  {$ENDIF}
  tipo := xTipo;
  val := xval;
end;

{$IFDEF TOKEN_DEBUG}
destructor TNodoToken.destroy;
begin
  dec( cnt_tokens );
  writeln( 'Libero token: ', Self.cnt_token, ' ', self.tipo, ' ', self.val, ', cnt_tokens: ', cnt_tokens );
  inherited destroy;
end;
{$ENDIF}

function nextToken(var s: string): TNodoToken;
var
  i: integer;
  c: char;
  buscando: boolean;
  res: string;
  tipoToken: TTipoToken;

begin
  s := trim(s);
  if length(s) = 0 then
  begin
    Result := nil;
    exit;
  end;

  c := s[1];
  if c in Separadores then
  begin
    res := c;
    Delete(s, 1, 1);
    case c of
      '(': tipoToken := TTK_Apertura;
      ')': tipoToken := TTK_Cierre;
      ']': tipoToken := TTK_Cierre_Array;
      else
      begin
        if (c = ':') and (length(s) > 0) and (s[1] = '=') then
        begin
          res := res + '=';
          Delete(s, 1, 1);
        end;
        tipoToken := TTK_Oper;
      end;
    end;
    Result := TNodoToken.Create(tipoToken, res);
    exit;
  end;

  // Detectamdos si empieza constante encomillada.
  if c = '"' then
  begin
    Delete(s, 1, 1);
    i := pos('"', s);
    if i = 0 then
      raise Exception.Create('Error ... comilla abierta pero no cerrada!( "' + s);
    res := copy(s, 1, i - 1);
    Delete(s, 1, i);
    s := trim(s);
    tipoToken := TTK_Const_S;
    Result := TNodoToken.Create(tipoToken, res);
    exit;
  end;

  // Si llegamos aquí comienza o un identificador o una constante numérica
  res := c;
  i := 2;
  buscando := True;
  tipoToken := TTK_Var; // esto es solo para apagar un warnning
  while (i <= length(s)) and buscando do
  begin
    c := s[i];
    if (c in Separadores) and not
      ((i > 2) and (((c = '+') or (c = '-')) and (UpperCase(s[i - 1]) = 'E'))) then
    begin
      case c of
        '(':
        begin
          tipoToken := TTK_Func;
          Inc(i);
        end;
        '[':
        begin
          tipoToken := TTK_Array;
          Inc(i);
        end;
        else
          if res[1] in DigitosYPunto then
            if (pos('.', res) > 0) or (pos('e', res) > 1) or
              (pos('E', res) > 1) then
              tipoToken := TTK_Const_F
            else if (length(res) = 1) and ((res[1] = '0') or (res[1] = '1')) then
              tipoToken := TTK_Const_B
            else
              tipoToken := TTK_Const_I
          else
            tipoToken := TTK_Var;
      end;
      buscando := False;
    end
    else
    begin
      res := res + c;
      Inc(i);
    end;
  end;

  if buscando then
  begin
    s := '';
    if res[1] in DigitosYPunto then
      if (pos('.', res) > 0) or (pos('e', res) > 1) or (pos('E', res) > 1) then
        tipoToken := TTK_Const_F
      else if (length(res) = 1) and ((res[1] = '0') or (res[1] = '1')) then
        tipoToken := TTK_Const_B
      else
        tipoToken := TTK_Const_I
    else
      tipoToken := TTK_Var;
  end
  else
    Delete(s, 1, i - 1);

  Result := TNodoToken.Create(tipoToken, res);
end;




constructor TEvaluadorExpresionesSimples.Create(auto_regsitrar_basicas: boolean);
begin
  inherited Create;
  CatalogoOperadoresBinomicos := TList.Create;
  CatalogoFuncionesEstandar := TList.Create;
  CatalogoFuncionesDeUsuario := TList.Create;
  CatalogoVariables := TList.Create;
  if auto_regsitrar_basicas then
  begin
    AgregarOperadoresBinomicos(self);
    AgregarFunciones(self);
  end;
end;

destructor TEvaluadorExpresionesSimples.Destroy;
var
  k: integer;
begin

  if CatalogoOperadoresBinomicos <> nil then
  begin
    for k := 0 to CatalogoOperadoresBinomicos.Count - 1 do
      TOperProcDef_(CatalogoOperadoresBinomicos.items[k]).Free;
    CatalogoOperadoresBinomicos.Free;
  end;

  if CatalogoFuncionesEstandar <> nil then
  begin
    for k := 0 to CatalogoFuncionesEstandar.Count - 1 do
      TOperProcDef_(CatalogoFuncionesEstandar.items[k]).Free;
    CatalogoFuncionesEstandar.Free;
  end;

  if CatalogoFuncionesDeUsuario <> nil then
  begin
    for k := 0 to CatalogoFuncionesDeUsuario.Count - 1 do
      TOperProcDef_(CatalogoFuncionesDeUsuario.items[k]).Free;
    CatalogoFuncionesDeUsuario.Free;
  end;

  ClearVars;
  CatalogoVariables.Free;

  inherited Destroy;
end;

function TEvaluadorExpresionesSimples.tokenParser(s: string): TTokensLst;
var
  res: TTokensLst;
  nodo: TNodoToken;
begin
  res := TTokensLst.Create;
  nodo := nextToken(s);
  while nodo <> nil do
  begin
    res.add(nodo);
    nodo := nextToken(s);
  end;
  Result := res;
end;

(**** EXPRESIONES *******)


constructor TExprLst.Create;
begin
  inherited Create;
  lst := TList.Create;
end;

procedure TExprLst.add(aExpr: TExpresion);
begin
  lst.add(aExpr);
end;

procedure TExprLst.evaluar;
var
  k: integer;
  aExp: TExpresion;
begin
  for k := 0 to lst.Count - 1 do
  begin
    aExp := lst[k];
    aExp.evaluar;
  end;
end;

function TExprLst.crearDerivada(variable: TNodoToken): TExprLst;
var
  k: integer;
  aExp, aDerivada: TExpresion;
  res:TExprLst;
begin
  res:=TExprLst.Create;
  for k := 0 to lst.Count - 1 do
  begin
    aExp := lst[k];
    aDerivada:=aExp.crearDerivada(variable);
    res.Add(aDerivada);
  end;
  Result:=res;
end;

function TExprLst.crearClon: TExpresion;
var
  k: integer;
  aExp, aClon: TExpresion;
  res:TExprLst;
begin
  res:=TExprLst.Create;
  for k := 0 to lst.Count - 1 do
  begin
    aExp := lst[k];
    aClon:=aExp.crearClon;
    res.Add(aClon);
  end;
  Result:=res;
end;

function TExprLst.Serialize: string;
var
  s: string;
  k: integer;
  aExpr: TExpresion;
begin
  s := '';
  for k := 0 to lst.Count - 1 do
  begin
    aExpr := lst[k];
    if k > 0 then
      s := s + ', ';
    s := s + aExpr.Serialize;
  end;
  Result := s;
end;

function TExprLst.Serialize2: string;
var
  s: string;
  k: integer;
  aExpr: TExpresion;
begin
  s := '';
  for k := 0 to lst.Count - 1 do
  begin
    aExpr := lst[k];
    if k > 0 then
      s := s + ', ';
    s := s + aExpr.Serialize2;
  end;
  Result := s;
end;


destructor TExprLst.Destroy;
var
  k, NElementos: integer;
  aExp: TExpresion;
begin
  NElementos:=lst.Count;
  for k := 0 to NElementos - 1 do
  begin
    aExp := lst[k];
    if not ( aExp is TVar )then
      aExp.Free;
  end;
  lst.Free;
  inherited Destroy;
end;


function TExprLst.GetExpr(const i: longint): TExpresion;
begin
  Result := lst[i];
end;


constructor TConst_I.Create(valorInicial: integer);
begin
  inherited Create;
  val.tipo := 'I';
  val.val_I := valorInicial;
end;


function TConst_I.Serialize: string;
begin
  Result := IntToStr(val.val_I);
end;

function TConst_I.crearDerivada(variable: TNodoToken): TExpresion;
begin
  Result:=TConst_I.Create(0);
end;

function TConst_I.crearClon: TExpresion;
begin
  Result:=TConst_I.Create(self.val.val_I);
end;



constructor TConst_F.Create(valorInicial: double);
begin
  inherited Create;
  val.tipo := 'F';
  self.val.val_F := valorInicial;
end;

function TConst_F.Serialize: string;
begin
  Result := FloatToStr(val.val_F);
end;

function TConst_F.crearDerivada(variable: TNodoToken): TExpresion;
begin
  Result:=TConst_F.Create(0);
end;

function TConst_F.crearClon: TExpresion;
begin
  Result:=TConst_F.Create(val.val_F);
end;

(*
class function TConst_F.Simbolo: string;
begin
  result:= 'Const_F';
end;
  *)




constructor TConst_B.Create(valorInicial: boolean);
begin
  inherited Create;
  val.tipo := 'B';
  self.val.val_B := valorInicial;
end;

function TConst_B.crearDerivada(variable: TNodoToken): TExpresion;
begin
  Result:=TConst_B.Create(False); // El parseador toma al 1 como True
end;

function TConst_B.crearClon: TExpresion;
begin
  Result:=TConst_B.Create(val.val_B);
end;

function TConst_B.Serialize: string;
begin
  if val.val_B then
    Result := '1'
  else
    Result := '0';
end;

constructor TConst_D.Create(valorInicial: TDateTime);
begin
  inherited Create;
  val.tipo := 'D';
  self.val.val_D := valorInicial;
end;



function TConst_D.Serialize: string;
begin
  Result := DateTimeToStr(val.val_D);
end;

function TConst_D.crearClon: TExpresion;
begin
  Result:=TConst_D.Create(val.val_D);
end;



constructor TConst_S.Create(valorInicial: string);
begin
  inherited Create;
  val.tipo := 'S';
  self.val.val_S := valorInicial;
end;



function TConst_S.Serialize: string;
begin
  Result := val.val_S;
end;

function TConst_S.crearClon: TExpresion;
begin
  Result:=TConst_S.Create(val.val_S);
end;


(*
class function TConst_S.Simbolo: string;
begin
  result:= 'Const_S';
end;
  *)

constructor TVar.Create(id: string; valorInicial: double; flg_asignada: boolean
  );
begin
  inherited Create;
  self.id := id;
  val.tipo := 'F';
  self.val.val_F := valorInicial;
  self.flg_asignada:= flg_asignada;
end;

function TVar.crearDerivada(variable: TNodoToken): TExpresion;
var
  res:TConst_F;
begin
  if variable.val = id then
    Result:=TConst_F.Create(1)
  else
    Result:=TConst_F.Create(0);
end;

function TVar.crearClon: TExpresion;
begin
  Result:=self; // No crea un clon, las variables son del evaluador
end;


function TVar.Serialize: string;
begin
  Result := id;
end;

function TEvaluadorExpresionesSimples.FindFuncDef(nombreFunc: string): TOperProcDef_;
var
  res: TOperProcDef_;
  buscando: boolean;
  k: integer;
begin

  // primero busco entre las definidas por el usuario
  buscando := True;
  k := 0;
  while buscando and (k < CatalogoFuncionesDeUsuario.Count) do
  begin
    res := CatalogoFuncionesDeUsuario.Items[k];
    if res.nombre = nombreFunc then
      buscando := False
    else
      Inc(k);
  end;

  if not buscando then
  begin
    Result := res;
    exit;
  end;


  // si no tuve suerte con las de usuario busco entre las estandar.
  buscando := True;
  k := 0;
  while buscando and (k < CatalogoFuncionesEstandar.Count) do
  begin
    res := CatalogoFuncionesEstandar.Items[k];
    if res.nombre = nombreFunc then
      buscando := False
    else
      Inc(k);
  end;

  if buscando then
    Result := nil
  else
    Result := res;

end;

function TEvaluadorExpresionesSimples.FindOperDef(nombreOper: string): TOperProcDef_;
var
  res: TOperProcDef_;
  buscando: boolean;
  k: integer;
begin
  buscando := True;
  k := 0;
  while buscando and (k < CatalogoOperadoresBinomicos.Count) do
  begin
    res := CatalogoOperadoresBinomicos.Items[k];
    if res.nombre = nombreOper then
      buscando := False
    else
      Inc(k);
  end;

  if buscando then
    Result := nil
  else
    Result := res;

end;


function TEvaluadorExpresionesSimples.Evaluar(const str: string): TExpresion;
var
  s, st: string;
  tokens: TTokensLst;
  exp: TExpresion;
begin
  exp := nil;
  st := str;
  s := next_sentencia(st);
  while s <> '' do
  begin
    if exp <> nil then
      exp.Free;
    tokens := tokenParser(s);
    exp := GetFullExpresion(tokens);
    tokens.Free;
    exp.evaluar;
    s := next_sentencia(st);
  end;
  Result := exp;
end;

function TEvaluadorExpresionesSimples.GetNextExpresionList(
  var tokens: TTokensLst): TExprLst;

var
  res: TExprLst;
  aExpr: TExpresion;
  cntAperturas: integer;
  buscando: boolean;
  sublst: TTokensLst;
  aToken: TNodoToken;
begin
  res := TExprLst.Create;
  cntAperturas := 1;
  buscando := True;
  sublst := TTokensLst.Create;
  while buscando and (tokens.Count > 0) do
  begin
    aToken := getNextToken(tokens);

    case aToken.tipo of
      TTK_Cierre: Dec(cntAperturas);
      TTK_Apertura, TTK_Func: Inc(cntAperturas);
    end;

    if (aToken.tipo = TTK_Cierre) and (cntAperturas = 0) then
    begin
      buscando := False;
      if sublst.Count > 0 then
      begin
        aExpr := GetFullExpresion(sublst);
        res.add( aExpr );
        sublst.Free;
      end;
    end
    else
    begin
      if (aToken.val = ',') and (cntAperturas = 1) then
      begin
        aToken.Free;
        aToken:= nil;
        aExpr := GetFullExpresion(sublst);
        res.add( aExpr );
        sublst.Free;
        sublst := TTokensLst.Create;
      end
      else
        sublst.add(aToken);
    end;
  end;
  if buscando then
    raise Exception.Create('Falta cerrar paréntesis.');
  result:= res;
end;


function TEvaluadorExpresionesSimples.Evaluar(var res: double;
  const str: string): boolean;
var
  exp: TExpresion;
begin
  exp := evaluar(str);
  if exp <> nil then
  begin
    Res := exp.ValAsFloat;
    exp.Free;
    Result := True;
  end
  else
  begin
    Res := -11111111;
    Result := False;
  end;
end;

function TEvaluadorExpresionesSimples.Evaluar(var res: integer;
  const str: string): boolean;
var
  exp: TExpresion;
begin
  exp := evaluar(str);
  if exp <> nil then
  begin
    Res := exp.ValAsInt;
    exp.Free;
    Result := True;
  end
  else
  begin
    Res := -11111111;
    Result := False;
  end;
end;

function TEvaluadorExpresionesSimples.Evaluar(var res: boolean;
  const str: string): boolean;
var
  exp: TExpresion;
begin
  exp := evaluar(str);
  if exp <> nil then
  begin
    Res := exp.ValAsBool;
    exp.Free;
    Result := True;
  end
  else
  begin
    Res := False;
    Result := False;
  end;
end;

function TEvaluadorExpresionesSimples.Evaluar(var res: string;
  const str: string): boolean;
var
  exp: TExpresion;
begin
  exp := evaluar(str);
  if exp <> nil then
  begin
    Res := exp.ValAsStr;
    exp.Free;
    Result := True;
  end
  else
  begin
    Res := '';
    Result := False;
  end;
end;



function TEvaluadorExpresionesSimples.GetExprLst(str: string): TExprLst;
var
  s, st: string;
  tokens: TTokensLst;
  res: TExprLst;
  exp: TExpresion;

  VariablesNoDefinidas_str: string;
begin
  res := TExprLst.Create;

  exp := nil;
  st := str;
  s := next_sentencia(st);
  while s <> '' do
  begin
    tokens := tokenParser(s);
    exp := GetFullExpresion(tokens);
    tokens.Free;
    if exp <> nil then
    begin
      res.add(exp);
       VariablesNoDefinidas_str:= VariablesNoDefinidas;
       if VariablesNoDefinidas_str <> '' then
          raise Exception.Create('Variables no definidas: '+ VariablesNoDefinidas_str );
    end;
    s := next_sentencia(st);
  end;
  Result := res;
end;


function TEvaluadorExpresionesSimples.Ejecutar(var res: double; str: string
  ): boolean;
var
  s, st: string;
  tokens: TTokensLst;
  exp: TExpresion;
begin
  exp := nil;
  st := str;
  s := next_sentencia(st);
  while s <> '' do
  begin
    if exp <> nil then
      exp.Free;
    tokens := tokenParser(s);
//    tokens.writeln;
    exp := GetFullExpresion(tokens);
    tokens.Free;
    exp.evaluar;
    s := next_sentencia(st);
  end;

  if exp <> nil then
  begin
    Res := exp.ValAsFloat;
    exp.Free;
    result:= true;
  end
  else
  begin
    Res := -11111111;
    result:= false;
  end;
end;




function TEvaluadorExpresionesSimples.FindVar(var_id: string): TVar;
var
  res: TVar;
  buscando: boolean;
  k: integer;
begin
  buscando := True;
  k := 0;
  while buscando and (k < CatalogoVariables.Count) do
  begin
    res := CatalogoVariables.Items[k];
    if res.id = var_id then
      buscando := False
    else
      Inc(k);
  end;

  if buscando then
    Result := nil
  else
    Result := res;

end;

function TEvaluadorExpresionesSimples.VariablesNoDefinidas: string;
var
  aVar: TVar;
  res: TStringList;
  k: integer;
begin
  res:= TStringList.Create;
  for k := 0 to CatalogoVariables.Count-1 do
  begin
    aVar := CatalogoVariables.Items[k];
    if not aVar.flg_asignada then
      res.Add( aVar.id );
  end;
  result := res.text;
  res.Free;
end;

procedure TEvaluadorExpresionesSimples.ClearVars;
var
  k: integer;
begin
  if CatalogoVariables <> nil then
  begin
    for k := 0 to CatalogoVariables.Count - 1 do
      TVar(CatalogoVariables.items[k]).Free;
  end;
end;



function TEvaluadorExpresionesSimples.CrearExprFunc(nombreFunc: shortString;
  parametros: TExprLst): TExpresion;
var
  aDef: TOperProcDef_;
begin
  aDef := FindFuncDef(nombreFunc);
  if aDef = nil then
    raise Exception.Create('No se encuentra: "' + nombreFunc +
      '" en los catálogos de funciones.');
  Result := TOperProc.Create(aDef, parametros);
end;


function TEvaluadorExpresionesSimples.CrearExprOperBi(nombreOper: shortString;
  a, b: TExpresion): TExpresion;
var
  aDef: TOperPRocDef_;
  parametros: TExprLst;
begin
  aDef := FindOperDef(nombreOper);
  if aDef = nil then
    raise Exception.Create('No se encuentra: "' + nombreOper +
      '" en el catálogo de operadores.');
  parametros := TExprLst.Create;
  parametros.add(a);
  parametros.add(b);
  Result := TOperProc.Create(aDef, parametros);
end;


function TEvaluadorExpresionesSimples.GetNextToken(var tokens: TTokensLst): TNodoToken;
begin
  if tokens.Count > 0 then
  begin
    Result := tokens[0];
    tokens.Delete(0);
  end
  else
    Result := nil;

end;


// Lee la primer expresión comenzando de la Izquierda.
// retorna NIL si la lista de tokens estaba vacía.
function TEvaluadorExpresionesSimples.GetNextExpresion(
  var tokens: TTokensLst): TExpresion;
var
  aToken: TNodoToken;
  sublst: TTokensLst;
  a: TExpresion;
  cntAperturas: integer;
  nombreOperFunc: string;
  aExprLst: TExpresion;
  buscando: boolean;
  parametros: TExprLst;

begin
  aToken := getNextToken(tokens);
  if aToken = nil then
  begin
    Result := nil;
    exit;
  end;

  case aToken.tipo of
    TTK_Apertura:
    begin
      // Primero me fijo si empieza un paréntesis. Si es así
      // vamos a crear la sublista de tokens del parétnesis y cremos
      // una expresión que lo representa
      aToken.Free;
      aToken := nil;

      (**
      cntAperturas := 1;
      buscando := True;
      sublst := TTokensLst.Create;
      while buscando and (tokens.Count > 0) do
      begin
        aToken := getNextToken(tokens);
        case aToken.tipo of
          TTK_Cierre: Dec(cntAperturas);
          TTK_Apertura, TTK_Func: Inc(cntAperturas);
        end;
        if (aToken.tipo = TTK_Cierre) and (cntAperturas = 0) then
          buscando := False
        else
          sublst.add(aToken);
      end;

      if buscando then
        raise Exception.Create('Falta cerrar paréntesis');
      a := GetFullExpresion(sublst);
      **)
      parametros:= GetNextExpresionList( tokens );
      if parametros.lst.count > 1 then
        a:= parametros
      else
      begin
        a:= parametros.lst[0];
        parametros.lst.Delete(0);
        parametros.free;
      end;
    end;

    TTK_Func:
    begin
      // hay que leer la lista de parámetros
      NombreOperFunc := aToken.val;
      aToken.Free;
      aToken := nil;

      (**
      parametros := TExprLst.Create;
      cntAperturas := 1;
      buscando := True;
      sublst := TTokensLst.Create;
      while buscando and (tokens.Count > 0) do
      begin
        aToken := getNextToken(tokens);
        case aToken.tipo of
          TTK_Cierre: Dec(cntAperturas);
          TTK_Apertura, TTK_Func: Inc(cntAperturas);
        end;

        if (aToken.tipo = TTK_Cierre) and (cntAperturas = 0) then
        begin
          buscando := False;
          if sublst.Count > 0 then
          begin
            aExprLst := GetFullExpresion(sublst);
            parametros.add(aExprLst);
            sublst.Free;
          end;
        end
        else
        begin
          if (aToken.val = ',') and (cntAperturas = 1) then
          begin
            aToken.Free;
            aToken:= nil;
            aExprLst := GetFullExpresion(sublst);
            parametros.add(aExprLst);
            sublst.Free;
            sublst := TTokensLst.Create;
          end
          else
            sublst.add(aToken);
        end;

      end;
      if buscando then
        raise Exception.Create('Falta cerrar paréntesis en Func:');
    **)
      parametros:= GetNextExpresionList( tokens );
      a := CrearExprFunc(NombreOperFunc, parametros);
    end;

    TTK_Const_B:
      a := TConst_B.Create(StrToBool(aToken.val));

    TTK_Const_D:
      a := TConst_D.Create(StrToInt(aToken.val));

    TTK_Const_I:
      a := TConst_I.Create(StrToInt(aToken.val));
    TTK_Const_F:
      a := TConst_F.Create(StrToFloat(aToken.val));

    TTK_Const_S:
      a := TConst_S.Create(aToken.val);
    TTK_Var:
    begin
      a := FindVar(aToken.val);
      if a = nil then
      begin
        a := TVar.Create(aToken.val, 0, false );
        CatalogoVariables.Add(a);
      end;
    end;
    TTK_Oper:
      if (aToken.val = '-') then
      begin
        a := CrearExprOperBi('-', TConst_I.Create(0), GetNextExpresion(tokens));
      end
      else  // del case
        raise Exception.Create('OJO; Token tipo OPERADOR: ' +
          aToken.Val + '. No impelentado en CASE de GetNextExpresion ');

    else  // del case
      raise Exception.Create('OJO; Token tipo: ' + TipoTokenToStr(
        aToken.Tipo) + '. No impelentado en CASE de GetNextExpresion ');
  end;

  if aToken <> nil then
    aToken.Free;
  Result := a;

end;


function TEvaluadorExpresionesSimples.GetFullExpresion(
  var tokens: TTokensLst): TExpresion;
var
  aToken: TNodoToken;
  a: TExpresion;
  buscando: boolean;
  operLst: TTokensLst;
  terminos: TExprLst;
  kOper: integer;

begin
  if (tokens = nil) or (tokens.Count = 0) then
  begin
    Result := nil;
    exit;
  end;

  operLst := TTokensLst.Create;
  terminos := TExprLst.Create;

  buscando := True;
  while buscando do
  begin
    a := GetNextExpresion(tokens);
    terminos.add(a);
    aToken := getNextToken(tokens);
    if aToken <> nil then
      operLst.Add(aToken)
    else
      buscando := False;
  end;

  // Resolvemos operadores de prioridad 0 (^)
  kOper := 0;
  while kOper < operLst.Count do
  begin
    aToken := operLst[kOper];
    if (aToken.val = '^') then
    begin
      a := CrearExprOperBi(aToken.val, terminos[kOper], terminos[kOper + 1]);
      aToken.Free;
      operLst.Delete(kOper);
      terminos.lst[kOper] := a;
      terminos.lst.Delete(kOper + 1);
    end
    else
      Inc(kOper);
  end;

  // Resolvemos oeradores de prioridad 1 (* y /)
  kOper := 0;
  while kOper < operLst.Count do
  begin
    aToken := operLst[kOper];
    if (aToken.val = '*') or (aToken.val = '/') then
    begin
      a := CrearExprOperBi(aToken.val, terminos[kOper], terminos[kOper + 1]);
      aToken.Free;
      operLst.Delete(kOper);
      terminos.lst[kOper] := a;
      terminos.lst.Delete(kOper + 1);
    end
    else
      Inc(kOper);
  end;

  // Resolvemos los operadores de última prioridad  (+ y -)
  // Salvo el de asignación que lo dejamos al final de todo
  kOper := 0;
  while kOper < operLst.Count do
  begin
    aToken := operLst[kOper];
    if aToken.val <> ':=' then
    begin
      a := CrearExprOperBi(aToken.val, terminos[kOper], terminos[kOper + 1]);
      aToken.Free;
      operLst.Delete(kOper);
      terminos.lst[kOper] := a;
      terminos.lst.Delete(kOper + 1);
    end
    else
      Inc(kOper);
  end;


  // Resolvemos las asignaciones
  kOper := 0;
  while kOper < operLst.Count do
  begin
    aToken := operLst[kOper];
    if aToken.val = ':=' then
    begin
      a := CrearExprOperBi(aToken.val, terminos[kOper], terminos[kOper + 1]);
      (( a as TOperProc).Template as TOperAsignar ).MarcarVariablesAsignadas( a, ( a as TOperProc).parametros );
      aToken.Free;
      operLst.Delete(kOper);
      terminos.lst[kOper] := a;
      terminos.lst.Delete(kOper + 1);
    end
    else
      Inc(kOper);
  end;


  // llegados aquí, la lista de operadores debe estar vacía.
  // y en operLst tiene que haber solo un término.
  assert(operLst.Count = 0, 'Error, operLst.cont <> 0');
  assert(terminos.lst.Count = 1, 'Error, hay más de una expresión en terminos');

  Result := terminos.lst[0];
  operLst.Free;
  terminos.lst.Delete(0);  // antes del Free elimino la referencia al resultado
  terminos.Free;
end;

constructor TOperProc.Create(template: TOperProcDef_; parametros: TExprLst);
begin
  inherited Create;
  self.template := template;
  val.tipo := template.tiposSalidas[1];
  self.parametros := parametros;
end;

function TOperProc.crearClon: TExpresion;
begin
  Result:=TOperProc.Create(template,TExprLst(parametros.crearClon));
end;


procedure TOperProc.evaluar;
begin
  // parametros.Evaluar;
  template.evaluar(self, parametros);
end;

{$IFDEF CREAR_EXPRESION_DERIVADA}
function TOperProc.crearDerivada(variable: TNodoToken): TExpresion;
begin
  Result:=template.crearDerivada(variable,parametros);
end;
{$ENDIF}

function TOperProc.Serialize: string;
begin
  Result := template.nombre + '(' + parametros.Serialize + ')';
end;

function TOperProc.Serialize2: string;
var
  res:string;
  kParametro,NParametros:Integer;
begin

  NParametros:=parametros.lst.Count;
  res:='';

  if NParametros = 1 then
  begin
    res:= res + template.nombre + '( ' + parametros.Serialize2 + ' )';
  end
  else
  begin
    res:='( ';

    for kParametro:=0 to NParametros - 2 do
      res := res + parametros[kParametro ].Serialize2 + ' ' + template.nombre + ' ';
    res:= res + ' ' + parametros[NParametros - 1].Serialize2 + ' )';
  end;

  Result := res;

end;

destructor TOperProc.Destroy;
begin
  parametros.Free;
  inherited Destroy;
end;

// busca el ";" como serparador de sentencias
function next_sentencia(var s: string): string;
var
  i: integer;
  res: string;
begin
  i := pos(';', s);
  if i = 0 then
  begin
    Result := trim(s);
    s := '';
  end
  else
  begin
    res := copy(s, 1, i - 1);
    Delete(s, 1, i);
    s := trim(s);
    Result := trim(res);
  end;
end;

initialization
{$IFDEF DEBUG}
cnt_tokens:= 0;
{$ENDIF}


end.
