svn/view/express.pas

unit express;
{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}
(***************************************)
(* Copyright (C) 2009, SHIRAISHI Kazuo *)
(***************************************)


{********}
interface
{********}
uses  Classes,
      base,objlist,arithmet,float,texthand,variabl,struct;

type
    extendedFunction1=function (x:extended):extended;
    extendedFunction2=function (x,y:extended):extended;

{********}
{compiler}
{********}

{******}
{matrix}
{******}
type
    TMatrix=class(TSubstance)
    end;

{******************}
{logical expression}
{******************}
type
    comparefunction=function(i:integer):boolean;

type
    TLogical=class(TPrincipal)
    end;

    TLogicalBiOp=class(TLogical)
           exp1,exp2:TPrincipal;
        constructor create(e1,e2:TPrincipal);
        destructor destroy;override;
      end;

     TDisjunction=class(TLogicalBiOp)
          function Code:Ansistring;override;
     end;

     TConjunction=class(TLogicalBiOp)
          function Code:Ansistring;override;
     end;

     TNegation=class(TLogical)
            exp:TPrincipal;
          constructor create(e:TPrincipal);
          function Code:Ansistring;override;
          destructor destroy;override;
     end;

    TComparison=class(TLogicalBiOp)
          op:comparefunction;
          constructor create(e1,e2:TPrincipal; f:comparefunction);
          function Code:Ansistring;override;
     end;

    TComparisonN= class(TComparison)
    end;

    TComparisonS= class(TComparison)
    end;


function Equals(i:integer):boolean;
function NotEquals(i:integer):boolean;
function Less(i:integer):boolean;
function Greater(i:integer):boolean;
function NotGreater(i:integer):boolean;
function NotLess(i:integer):boolean;

procedure  findcomparefunction(const r:string; var f:comparefunction);

function primary:TPrincipal ;
function StringPrimary:TPrincipal ;
function NExpression:TPrincipal;
function NConstant:TPrincipal;
var      NFunction:function(idr:TIdrec):TPrincipal;
function ChExpression:TPrincipal;
function ChannelExpression:TPrincipal;
function SExpression:TPrincipal;
function NSExpression:TPrincipal;
function SConstant:TPrincipal;
function matrix:TMatrix;
function Nmatrix:TMatrix;
function Smatrix:TMatrix;
function SMatrixDim(n:shortint):TMatrix;
function NMatrixDim(n:shortint):TMatrix;
function article:TPrincipal;
function principal(idrec:TIdRec):TPrincipal;
function simpleVariable:TSubstance;
function variable:TVariable;
function NVariable:TVariable;
function VariableOrFunctionRef:TPrincipal;
function relationalExpression:TLogical;
function IdRecord(CanInsert:boolean):TIdRec;

function reservedword(name:ShortString):boolean;


function tryLETst(prev,eld:TStatement):TStatement;far;


{**************}
{CALL statement}
{**************}

type
   TCALL=class(TStatement)
          params:TObjectList;
          Routine:TRoutine;
        constructor createF(idr:TIdrec);             // for function,def
        constructor Create(prev,eld:TStatement; kind:char);    // for sub,picture
        destructor destroy;override;
        function Code:Ansistring;override;

       private
        procedure init(routine1:TRoutine);virtual;
        procedure TestArithmetic;
   end;


{*****************}
{string expression}
{*****************}

type
   TStrExpression=class(TPrincipal)
           function kind:char;override;
     end;

type
   TStrConstant=class(TStrExpression)
            value:ansistring;
           constructor create(const s:ansistring);
           function evalS:ansistring;override;
           function Code:AnsiString;override;
           destructor destroy;override;
           function isConstant:boolean;override;
       end;


{**********}
{TInputVari}
{**********}

 type
  TInputVari=class
       vari:TVariable;
      constructor create(vari1:TVariable);
      destructor destroy;override;
  end;

  TStrVari=class(TInputVari)
       index1,index2:TPrincipal;
       CharacterByte:boolean;
      constructor create(vari1:TVariable);
      destructor destroy;override;
      function Code:ansistring;
  end;
function InputVari(StrOnly:boolean):TInputVari;
function StrVari:TStrVari;

{*********}
{Arguments}
{*********}
function argumentN1:TPrincipal;
function argumentN2a:TPrincipal;
function argumentN2b:TPrincipal;

var Unary:function({op1:unaryoperation;} op2:floatfunction1;er2:smallint;const name:ansistring):TPrincipal;
var Binary:function({op1:binaryoperation;} op2:floatfunction2; er2:smallint;const name:ansistring):TPrincipal;
var UnaryX:function(op2:extendedfunction1;er2:smallint;const name:ansistring):TPrincipal;
var BinaryX:function(op2:extendedfunction2; er2:smallint;const name:ansistring):TPrincipal;
var NOperation:function(op:TPrincipal):TPrincipal;

var NConst:function(var n:number):TPrincipal;
var OpPower:function(e1,e2:TPrincipal):TPrincipal;
var OpUnaryMinus:function(e1:TPrincipal):TPrincipal;
var OpSquare:function(e1:TPrincipal):TPrincipal;
var OpTimes:function(e1,e2:TPrincipal):TPrincipal;
var OpDivide:function(e1,e2:TPrincipal):TPrincipal;
var OpPlus:function(e1,e2:TPrincipal):TPrincipal;
var OpMinus:function(e1,e2:TPrincipal):TPrincipal;
var OpMSYen:function(e1,e2:TPrincipal):TPrincipal;
var OpMSMod:function(e1,e2:TPrincipal):TPrincipal;

type
  Subscriptarray=Array[1..4]of TPrincipal;

var NSubscripted1: function(idr:TIdrec; p:Subscriptarray):TVariable;
var NSubscripted2: function(idr:TIdrec; p:Subscriptarray):TVariable;
var NSubscripted3: function(idr:TIdrec; p:Subscriptarray):TVariable;
var NSubscripted4: function(idr:TIdrec; p:Subscriptarray):TVariable;

var NComparison: function(f:comparefunction; exp1,exp2:TPrincipal):TLogical;
type
    TLogicalNumeric=Class(TLogical)
        exp:TPrincipal;
        constructor create;
        destructor destroy;override;
     end;
function JISNExpression:TPrincipal;

procedure SubstringQualifier(var exp1,exp2:tPrincipal);
function GetRoutine(idr:TIdrec; kind:char):TRoutine;

type
   TSubscripted=class(TPointingVariable)
               subs:TSubstance;
               dim:integer;
               subscript:Subscriptarray;
           constructor create(idr:TIdrec; p:Subscriptarray);    //2011.3.8������
           destructor destroy;override;                      //2011.3.8
           function kind:char;override;
           function Code:AnsiString;override;
       end;

   TSubscripted1=class(TSubscripted)
       end;
   TSubscripted2=class(TSubscripted)
       end;
   TSubscripted3=class(TSubscripted)
       end;
   TSubscripted4=class(TSubscripted)
       end;

 //For Code Generate
 function ArgNLiteral(i:integer):Ansistring;
 function ArgSLiteral(i:integer):Ansistring;

implementation

uses SysUtils,Forms,
     base0,myutils,helpctex,optina,moddlg ,expressf,sconsts ;

{************}
{TSubscripted}
{************}

constructor TSubscripted.create(idr:TIdRec; p:Subscriptarray);
var
   i:integer;
begin
   inherited  create;
   subs:=idr.subs;
   dim:=idr.dim;
   subscript:=p
end;

destructor TSubscripted.destroy;
var
  i:integer;
begin
  for i:=1 to dim do subscript[i].free;
  inherited destroy;
end;

function TSubscripted.kind:char;
begin
     kind:=subs.kind
end;


{**************************}
{function referece and CALL}
{**************************}

type
    TConcat=class(TStrExpression)
        exp1,exp2:TPrincipal;
      constructor create(e1,e2:TPrincipal);
      destructor  destroy;override;
      function Code:AnsiString;override;
    end;

type
   TConstVariable=class(TVariable)
             vari:TVariable;
           constructor create(exp:TVariable);
           destructor destroy;override;
           function Kind:char;override;
           function Code:AnsiString;override;
   end;


constructor TConstVariable.create(exp:TVariable);
begin
    inherited create;
    vari:=exp;

end;

destructor  TConstVariable.destroy;
begin
   vari.free;
   inherited destroy;
end;


procedure TestSubscripted;forward;

procedure TCall.TestArithmetic;
begin
   if (routine is TProgramUnit)
      and (punit.arithmetic<>(routine as TProgramUnit).arithmetic) then
      seterr(Format(s_IsNotAgreeArithmetic,[routine.name]),IDH_OPTION_ARITHMETIC)
end;

function GetRoutine(idr:TIdrec; kind:char):TRoutine;
var
   routine:TRoutine;
   nam:AnsiString;
begin
     GetRoutine:=nil;
      with idr do
         if modulename<>'' then
            nam:=modulename + '.' + name
         else
            nam:=name;
      if CurrentProgram.inquire(nam,routine)
           and ((routine.isfunction and (kind='F')) or(routine.kind=kind)) then
         GetRoutine:=routine
      else if pass=2 then
         begin
            statusmes.add(Format(s_BodyIsNotFound,[token]));
            if (kind='F')  and
               (token<>'SHIFT') and (token<>'SCALE') and (token<>'ROTATE')
               and (token<>'SHEAR')  and (nexttoken='(') then
               TestSubscripted
            else
               seterr('',IDH_FUNCTION);
         end;
end;

function lastChar(const s:string):char;
begin
   if s<>'' then
      result:=s[length(s)]
   else
      result:=#0;
end;

procedure TCALL.init(routine1:TRoutine);
var
   i:integer;
   table:TIdTable;
   exp:TPrincipal;
   svtoken:string;
begin
   case pass of
   1:
      begin
         gettoken;
         if token='(' then
            begin
              gettoken;
              repeat
                 exp:=article;
                 exp.free;
              until test(',')=false;
              check(')',IDH_FUNCTION);
            end;
      end;
   2: begin
         routine:=routine1;
         if routine<>nil then
            begin
               gettoken;
               table:=routine.VarTable;
               params:=TObjectList.create(table.count);
               if routine.isfunction then
                  if lastChar(routine.name)<>'$' then
                    TestArithmetic;
               i:=0;
               with table do
               while (i<count) and TIdRec(items[i]).prm do
                   begin
                        if i=0 then check('(',IDH_FUNCTION)
                               else check(',',IDH_FUNCTION);
                        svtoken:=token;
                        exp:=principal(TIdRec(items[i]));
                        if (TIdRec(items[i]).kindchar='n') then TestArithmetic;
                        if (not routine.isfunction) and (svtoken='(')
                                   and (exp is TVariable) then
                            exp:=TConstVariable.create(TVariable(exp));
                        params.add(exp);
                        if (not routine.isfunction) and (exp is TFVari) then  //������������
                           TFvari(exp).addQueryInteger(nil);
                        if (not routine.isfunction) and (exp is TCVari) then  //������������
                           TCvari(exp).addQueryDouble(nil);
                        inc(i);
                   end;
                if i>0 then check(')',IDH_FUNCTION);
            end
      end;
   end;
end;

constructor TCall.createF(idr:TIdrec);
begin
   inherited create(nil,nil);
   init(GetRoutine(idr,'F'))
end;

constructor TCall.Create(prev,eld:TStatement; kind:char);
var
   idr:TIdrec;
   index:integer;
   mnam,nam:ansistring;
begin
   inherited create(prev,eld);
   mnam:=Modifier(token);
   nam:=Identifier(token);
   if mnam<>'' then
      begin
         idr:=TIdrec.InitF(mnam,nam,extern);
         try
           init(GetRoutine(idr,kind));
         finally
           idr.free;
         end;
      end
   else if ProgramUnit.ExternalSubTable.search(nam,index) then
      begin
        idr:=TIdrec(ProgramUnit.ExternalSubTable.items[index]);
        init(GetRoutine(idr,kind))
      end
   else
      begin
         idr:=TIdrec.initF(mnam,token,intern);
         try
           init(GetRoutine(idr,kind));
         finally
           idr.free;
         end;
      end;
end;

destructor TCALL.destroy;
begin
   params.free;
   inherited destroy
end;


{*********************}
{Numerical Expressions}
{*********************}

function NConstant:TPrincipal;
var
   n:number;
begin
   numericconstant(n);
   NConstant:=NConst(n)
end;

function primary:TPrincipal ;
var
   x:number;
begin
   if test('(') then
     begin
        primary:=NExpression;
        checktoken(')',IDH_NUMBER);
     end
   else if tokenspec=Nrep then
     begin
         x:=tokenValue;
         getToken;
         primary:=NConst(x);
     end
   else if tokenspec=NIdf then
     begin
        result:=VariableOrFunctionRef;
        if (result=nil)  or  (result.kind<>'n') then
           seterr(token+s_CantBelongHere + EOL + s_ExpressionIncorrect,IDH_NUMBER);
     end
   else
     seterr(s_ExpressionIncorrect +EOL + token + s_CantBelongHere  , IDH_NUMBER)   ;


end;

function Negation:TPrincipal;forward;

function factor:TPrincipal ;
var
   exp:TPrincipal;
begin
   exp:=primary;
   while (Token='^') and (exp<>nil)  do
      begin
        gettoken;
        if token='-' then
           exp:=OpPower(exp,negation)
        else if token='2' then
            begin
               gettoken;
               exp:=OpSquare(exp)
            end
        else
               exp:=OpPower(exp,primary);
      end;
   factor:=exp;
end;

procedure insertParenthesis;
var
   svcp:tokensave;
   exp:TPrincipal;
begin
    savetoken(svcp);
    gettoken;
    exp:=factor;
    exp.free;
    if  NoContinuation and (AutoCorrect[ac_exp] or
        confirmFrom(svcp,
                  extract(svcp)+s_CanBeParenthesized,IDH_MICROSOFT_OP)) then
     begin
       insertkeyword('(',svcp);
       inserttext(')');
       raise ERecompile.create('');
     end
    else
     restoreToken(svcp);
end;

function Negation:TPrincipal;
begin
   Negation:=nil;
   if token='-' then
      if permitMicrosoft then
         begin
          gettoken;
          Negation:=OpUnaryMinus(factor);
         end
      else
        begin
          insertParenthesis;
          Negation:=factor;
        end
   else
      Negation:=factor;
end;


function term:TPrincipal;
 var
    exp:TPrincipal ;
    op:char;
 begin
    exp:=factor;
    while ((token='*') or (token='/')) and (exp<>nil)  do
       begin
           op:=token[1];
           gettoken;
           case  op of
                '*': exp:=OpTimes(exp, negation);
                '/': exp:=OpDivide(exp, negation);
           end;
       end;
    term:=exp
 end;

function YenTerm:TPrincipal;
var
  svcp1,svcp2:tokensave;

  exp,exp2:TPrincipal;
begin
   savetoken(svcp1);
   exp:=Term;
   Result:=exp;

   if permitMicrosoft then
      while (token='\') do
         begin
            gettoken;
            Result:=OpMSYen(result,Term);
         end
   else if (token='\') and NoContinuation then
      case confirmMod of
        0:begin
            savetoken(svcp2);
            gettoken;
            exp2:=Term;
            exp.free;
            exp2.free;
            inserttext('))');
            replaceKeyword('/(',svcp2);
            insertkeyword('INT(',svcp1);
            raise ERecompile.create('');
         end;
        1:begin
            savetoken(svcp2);
            gettoken;
            exp2:=Term;
            exp.free;
            exp2.free;
            inserttext('))');
            replaceKeyword('/(',svcp2);
            insertkeyword('IP(',svcp1);
            raise ERecompile.create('');
         end;
        2:begin
            savetoken(svcp2);
            gettoken;
            exp2:=Term;
            exp.free;
            exp2.free;
            inserttext('))');
            replaceKeyword(')/ROUND(',svcp2);
            insertkeyword('IP(ROUND(',svcp1);
            raise ERecompile.create('');
         end;
      end
end;


function ModTerm:TPrincipal;
var
  svcp1,svcp2:tokensave;

  exp,exp2:TPrincipal;
begin
   savetoken(svcp1);
   exp:=YenTerm;
   result:=exp;

   if permitMicrosoft then
      while (token='MOD') do
         begin
            gettoken;
            Result:=OpMSMod(result,YenTerm);
         end
   else if (token='MOD') and NoContinuation then
      case confirmMod of
        0:begin
            savetoken(svcp2);
            gettoken;
            exp2:=YenTerm;
            exp.free;
            exp2.free;
            inserttext(')');
            replaceKeyword(',',svcp2);
            insertkeyword('MOD(',svcp1);
            raise ERecompile.create('');
         end;
        1:begin
            savetoken(svcp2);
            gettoken;
            exp2:=YenTerm;
            exp.free;
            exp2.free;
            inserttext(')');
            replaceKeyword(',',svcp2);
            insertkeyword('REMAINDER(',svcp1);
            raise ERecompile.create('');
         end;
        2:begin
            savetoken(svcp2);
            gettoken;
            exp2:=YenTerm;
            exp.free;
            exp2.free;
            inserttext('))');
            replaceKeyword('),ROUND(',svcp2);
            insertkeyword('REMAINDER(ROUND(',svcp1);
            raise ERecompile.create('');
         end;
      end
   else
      ModTerm:=exp
end;

function JISNExpression:TPrincipal;
 var
   exp:TPrincipal;
   op:char;
 begin
    if token='+' then
       begin
            gettoken;
            exp:=ModTerm
       end
    else if token='-' then
        begin
             gettoken;
             exp:=OpUnaryMinus(term);
        end
    else
        exp:=ModTerm;

    while ((token='+') or (token='-')) and (exp<>nil)  do
        begin
           op:=token[1];
           gettoken;
           case  op of
               '+': exp:=OpPlus(exp,ModTerm);
               '-': exp:=OpMinus(exp,ModTerm);
           end;
        end;

    JISNExpression:=exp
end;

//function MicrosoftNExpression:TPrincipal;forward;

function NExpression:TPrincipal;
begin
   if permitMicrosoft then
      result:=MicrosoftNExpression
   else
      result:=JISNExpression
end;

{******************}
{string expression }
{******************}

type
   TStrFunction=class(TStrExpression)
          exe   :TCALL;
         constructor create(idr:TIdrec);
         destructor destroy;override;
         function Code:ansistring;override;
     end;


{*****************}
{string expression}
{*****************}


function TStrExpression.kind:char;
begin
   kind:='s'
end;


constructor TStrFunction.create(idr:TIdrec);
begin
   inherited  create;
   exe:=TCALL.createF(idr) ;
end;

destructor TStrFunction.destroy;
begin
   exe.free;
   inherited destroy
end;

constructor TStrConstant.create(const s:ansistring);
begin
     inherited create;
     value:=s
end;

destructor TStrConstant.destroy;
begin
    inherited destroy
end;

function TStrConstant.isConstant:boolean;
begin
   isConstant:=true
end;


function TStrConstant.evalS:ansistring;
begin
  result:=value;
end;


{******************}
{logical expression}
{******************}


constructor TLogicalBiOp.create(e1,e2:TPrincipal);
begin
   inherited  create;
   exp1:=e1;
   exp2:=e2;
end;


destructor TLogicalBiOp.destroy;
begin
    exp1.free;
    exp2.free;
    inherited destroy
end;

{*****************}
{logical operation}
{*****************}


constructor TComparison.create(e1,e2:TPrincipal; f:comparefunction);
begin
    inherited  create(e1,e2);
    op:=f
end;


{*****************}
{logical operation}
{*****************}

constructor TNegation.create(e:TPrincipal);
begin
    inherited create;
    exp:=e ;
end;

destructor  TNegation.destroy;
begin
    exp.free;
    inherited destroy;
end;

{********}
{compiler}
{********}

function subscript(idr:TIdRec):Subscriptarray; //2011.3.8������
var
   i:integer;
   exp:TPrincipal;
   d:integer;
begin
   for i:=1 to 4 do result[i]:=nil;
      check('(',IDH_ARRAY);
      with idr do
         if tag=undeterm then
            begin
                d:=0;
                repeat
                  inc(d);
                  result[d]:=NExpression;
                until (d=4) or (test(',')=false) ;
                check(')',IDH_ARRAY);
                tag:=intern;
                setdim1(d);
            end
         else
            begin
                for i:=1 to dim do
                    begin
                        exp:=NExpression;
                        if exp is TFVari then
                           TFVari(exp).usedAsASubscript:=true;
                        result[i]:=exp;
                        if i<dim then check(',',IDH_ARRAY);
                    end;
                check(')',IDH_ARRAY);
            end;
end;


procedure TestSubscripted;      //2011.3.8 ������
var
   idr:TIdRec;
   p:SubscriptArray;
   s:ansistring;
   i:integer;
begin
  if insertDimst and not OptionExplicit then
   begin
     idr:=TIdrec.InitA(token,1,Undeterm);
     try
        gettoken;
        p:=subscript(idr);
        s:='10';
        i:=idr.dim;
        while i>1 do  begin s:=s+',10'; dec(i) end;
        insertLine(linenumber,'DIM '+idr.name+'('+s+')');
        raise EReCompile.create('');
     finally
        idr.free;
     end;
   end
 else
     gettoken;
end;


function reservedword(name:ShortString):boolean;
var
   index:integer;
   s:boolean;
begin
   s:=ReservedwordTable.search(@name,index);
   if s then  seterr(name+s_IsReserved,IDH_RESERVED);
   reservedword:=s;
end;

function ColonIncluded:boolean;
var
   svcp:tokensave;
begin
   savetoken(svcp);
   gettoken;
   repeat
      gettoken;
      while token='(' do
         FindCorrespondingParenthesis;
   until (token=':') or (token=')') or (tokenspec=tail);
   result:=(token=':');
   restoretoken(svcp);
end;

function IdRecord(CanInsert:boolean):TIdRec;
var
  index,index1: integer;
  idr:TIdRec;
  func: SimpleFunction;
  module1:TModule;
  mnam:AnsiString;
  nam:ansistring;
begin
  IdRecord:=nil;
  mnam:=modifier(token);
  nam:=identifier(token);
  if mnam<>'' then
     begin
        if ForceFunctionDeclare
          and not ProgramUnit.ExternalVarTable.search2(mnam,nam,index1) then
            seterr(token+s_IsNotExternalDeclared,IDH_MODULE);

        module1:=nil;
        if pass=2 then  module1:=module(mnam);
        if (module1<>nil) and module1.ShareVarTable.search(nam,index1) then
           begin
              Idr:=TIdRec(module1.ShareVartable.items[index1]);
              Idrecord:=idr;
              if (idr.tag<>idPublic) then
                   seterr(Format(s_NotPublicDeclaredIn,[mnam,nam]),IDH_MODULE);
              if (tokenspec=NIdf) and (module1.Arithmetic<>programunit.Arithmetic) then
                   seterr(s_DisAgreeArithmetic,IDH_MODULE);

           end
        else if ProgramUnit.ExternalVarTable.search2(mnam,nam,index1) then
             idrecord:=TIdRec(ProgramUnit.ExternalVarTable.items[index1]);
     end
  else if (LocalRoutine<>nil)
       and LocalRoutine.isFunction and (LocalRoutine.ResultVar.name=token) then
     IdRecord:=LocalRoutine.ResultVar
  else if (LocalRoutine<>nil) and LocalRoutine.VarTable.search(token,index1) then
     IdRecord:=TIdRec(LocalRoutine.VarTable.items[index1])
  else if ProgramUnit.isFunction and (ProgramUnit.ResultVar.name=token) then
     IdRecord:=ProgramUnit.ResultVar
  else if ProgramUnit.VarTable.search(token,index) then
     IdRecord:=TIdRec(ProgramUnit.VarTable.items[index])
  else if (CurModule<>nil) and CurModule.ShareVarTable.search(token,index1) then
     begin
       IdRecord:=TIdRec(CurModule.ShareVarTable.items[index1]);
       if (tokenspec=NIdf) and (CurModule.Arithmetic<>programunit.Arithmetic) then
                    seterr(s_DisAgreeArithmetic,IDH_MODULE);
     end
  else if ProgramUnit.ExternalVarTable.search(token,index1) then
     begin
        idr:=TIdRec(ProgramUnit.ExternalVarTable.items[index1]);
        if (pass=1) or (idr.dim<0) then
           IdRecord:=idr
        else
           begin
             module1:=module(idr.moduleName);
             if (module1<>nil) and module1.ShareVarTable.search(token,index1) then
                IdRecord:=TIdRec(module1.ShareVartable.items[index1])
           end
     end
  else if CanInsert then
    begin
      if (nexttoken='(') then
          if MinimalBasic and not SuppliedFunctionTable.find(token,func) then
             ProgramUnit.VarTable.insert(index,TIdRec.initA(token,1,Undeterm))
          else if (tokenSpec=Sidf) and  ColonIncluded then
              ProgramUnit.VarTable.insert(index,TIdRec.initSimple(token,intern,maxint))
          else
              exit
      else if not OptionExplicit then
              ProgramUnit.VarTable.insert(index,TIdRec.initSimple(token,intern,maxint))
           else
              setErr(token+s_IsNotDeclared,IDH_DECLARE) ;
       IdRecord:=TIdRec(ProgramUnit.VarTable.items[index]);
    end;
end;


function  Variablesub(var k:integer):TVariable;
var
  IdRec:TIdRec;
begin
  Variablesub:=nil;
  if reservedword(token) then exit;

  idrec:=IdRecord(true);
  if IdRec=nil then exit;

  gettoken;
  with IdRec do
    if kindchar='n' then
      begin
        k:=dim;
        case k of
            0: Variablesub:=IdRec.subs;
            1: Variablesub:=NSubScripted1(IdRec,Subscript(IdRec));
            2: Variablesub:=NSubScripted2(IdRec,Subscript(IdRec));
            3: Variablesub:=NSubScripted3(IdRec,Subscript(IdRec));
            4: Variablesub:=NSubScripted4(IdRec,Subscript(IdRec));
           -1: if prm then
                      Variablesub:=IdRec.subs
               else
                      seterr(prevtoken +s_IsFunctionName,IDH_RESERVED);
        end;
      end
    else
      begin
        k:=dim;
        case k of
            0: Variablesub:=IdRec.subs;
            1: Variablesub:=TSubScripted1.create(IdRec,Subscript(IdRec));
            2: Variablesub:=TSubScripted2.create(IdRec,Subscript(IdRec));
            3: Variablesub:=TSubScripted3.create(IdRec,Subscript(IdRec));
            4: Variablesub:=TSubScripted4.create(IdRec,Subscript(IdRec));
           -1: if prm then
                      Variablesub:=IdRec.subs
               else
                      seterr(prevtoken +s_IsFunctionName,IDH_RESERVED);
        end;
      end;
end;

function variable:TVariable;
var
   p:TVariable;
   k:integer;
begin
   variable:=nil;
   p:=variablesub(k);
   if (p<>nil) and  (k>=0) then
      variable:=p
   else     {function reference}
      begin
          seterrExpected(s_VarName,IDH_RESERVED)  ;
          p.free
      end;
end;

function  NVariable:TVariable;
begin
   result:=Variable;
   if (result<>nil) and  (result.kind<>'n') then
      seterrExpected(s_NumVar,IDH_RESERVED);
end;


function simpleVariable:TSubstance;
var
   p:TPrincipal;
   k:integer;
begin
   p:=nil;
   if tokenspec=NIdf then
      begin
          p:=variablesub(k);
          if (p<>nil) and (k<>0) then
                begin
                    p.free;
                    p:=nil
                end;
      end;
   if p=nil then
                seterrRestricted(s_SimpleVar,IDH_RESERVED);
   simplevariable:=p as TSubstance
end;


{********}
{compiler}
{********}
function  NSExpression1:TPrincipal;
var
   svcp:^tokensave;
begin
   new(svcp);
   savetoken(svcp^);
   try
      try
         inc(trying);
         result:=NExpression;
      except
         on SyntaxError do
         begin
             restoreToken(svcp^);
             result:=SExpression;
             statusmes.clear;
             HelpContext:=0;
         end;
      end;
   finally
      dispose(svcp);
      dec(trying);
   end;
end;

function  NSExpression:TPrincipal;
var
   sp:tokenspecification;
begin
   sp:=tokenspec;
   if token='(' then sp:=NextTokenspecWithinParenthesis;   //   sp:=nexttokenspec;//2006.1.15
   case sp of
      SCon,Sidf:NSExpression:=SExpression;
      NRep,NIdf:NSExpression:=NExpression;
      else      NSExpression:=NSExpression1;
   end;
end;


function article:TPrincipal;
var
   svcp:^tokensave;
begin
   if token='#' then
      article:=ChExpression
   else
      begin
          new(svcp);
          inc(trying);
          try
              savetoken(svcp^);
              try
                  article:=NSExpression;
              except
                  on SyntaxError do
                     begin
                       restoreToken(svcp^);
                       article:=matrix;
                       statusmes.clear;
                       HelpContext:=0;
                     end;
              end;
          finally
              dispose(svcp);
              dec(trying);
          end;
      end;
end;


{********************}
{numerical Expression}
{********************}

function NMatrixDim(n:shortint):TMatrix;
begin
  result:=NMatrix;
  if result.idr.dim<>n then SeterrDimension(IDH_Array_Parameter);
end;

function SMatrixDim(n:shortint):TMatrix;
begin
  result:=SMatrix;
  if result.idr.dim<>n then SeterrDimension(IDH_Array_Parameter);
end;


function principal(idrec:TIdRec):TPrincipal;
begin
   principal:=nil;
   case idrec.kindchar of
      'n': if idrec.dim =0 then
                 principal:=NExpression
            else if idrec.dim>0 then
                 principal:=NMatrixDim(idrec.dim) ;
       's':if idrec.dim =0 then
                  principal:=sexpression
           else if idrec.dim>0 then
                  principal:=SMatrixDim(idrec.dim) ;
       'c': principal:=ChExpression;
    end;
end;


function VariableOrFunctionRef:TPrincipal;  {numeric variable | function reference}
var
  func: SimpleFunction;
  idr:TIdRec;

begin
  VariableOrFunctionRef:=nil;

  if ReservedWordTable.find(token,func) then
      begin
          gettoken;
          VariableOrFunctionRef:=func
      end
  else
      begin
         idr:=IdRecord(true);
         if idr<>nil then
            with idr do
                 case dim of
                    0: begin
                          gettoken;
                          VariableOrFunctionRef:=idr.subs;
                        end;
                    1: begin
                           gettoken;
                           VariableOrFunctionRef:=
                                      NSubscripted1(idr,Subscript(idr));
                         end;
                    2: begin
                           gettoken;
                           VariableOrFunctionRef:=
                                      NSubscripted2(idr,Subscript(idr));
                         end;
                    3: begin
                           gettoken;
                           VariableOrFunctionRef:=
                                      NSubscripted3(idr,Subscript(idr));
                         end;
                    4: begin
                           gettoken;
                           VariableOrFunctionRef:=
                                      NSubscripted4(idr,Subscript(idr));
                         end;
                    -1 : if idr.kindchar='n' then
                            VariableOrFunctionRef:=NFunction(idr)
                         else
                             VariableOrFunctionRef:=TStrFunction.create(idr);
                 end
         else if SuppliedFunctionTable.find(token,func) then
              begin
                  gettoken;
                  VariableOrFunctionRef:=func
              end
          else if not (ForceFunctionDeclare or OptionExplicit) then
             try
                 idr:=TIdrec.initF(modifier(token),identifier(token),intern);
                 if tokenspec=NIdf then
                     VariableOrFunctionRef:=NFunction(idr)
                 else if tokenspec=SIDf then
                     VariableOrFunctionRef:=TStrFunction.create(idr);
             finally
                 idr.free;
             end  ;
      end;
end;


{**********}
{ string   }
{**********}

type
   TSubstring=class(TStrExpression)
        exp:TPrincipal;
        exp1,exp2:TPrincipal;
        CharacterByte:boolean;
      constructor create(e:TPrincipal);
      destructor  destroy;override;
      function Code:AnsiString;override;
    end;

procedure SubstringQualifier(var exp1,exp2:tPrincipal);
begin
    check('(',IDH_SUBSTRING);
    exp1:=NExpression;
    check(':',IDH_SUBSTRING);
    exp2:=NExpression;
    check(')',IDH_SUBSTRING);
end;

constructor TSubString.create(e:TPrincipal);
begin
    inherited  create;
    CharacterByte:=ProgramUnit.CharacterByte;
    exp:=e;
    SubstringQualiFier(exp1,exp2);
end;

destructor TSubString.destroy;
begin
    exp.free;
    exp1.free;
    exp2.free;
    inherited destroy;
end;

function StringPrimary:TPrincipal ;
var
   exp:TPrincipal;
begin
   if token='(' then
        begin
           check('(',IDH_STRING);
           stringprimary:=SExpression;
           checktoken(')',IDH_STRING);
        end
   else if tokenspec=Scon then
         begin
            StringPrimary:=TStrConstant.create(tokenstring);
            gettoken;
         end
   else if tokenspec=SIdf then
        begin
           exp:=VariableOrFunctionRef;
           if (exp=nil) or  (exp.kind<>'s') then
              seterr( token +  s_CantBelongHere + EOL +s_IllegalStringVar,IDH_String);
           if (token='(') and (exp is TVariable) then
              StringPrimary:=TSubString.create(exp)
           else
              StringPrimary:=exp ;
        end
    else
        seterr(s_IllegalStringVar + EOL+ token +  s_CantBelongHere ,IDH_STRING);
end;

constructor TConcat.create(e1,e2:TPrincipal);
begin
    inherited create;
    exp1:=e1;
    exp2:=e2;
end;

destructor TConcat.destroy;
begin
   exp1.free;
   exp2.free;
   inherited destroy;
end;

var
   confirmedA:boolean=false;

function confirmA:boolean;
begin
    confirmA:=false;
    if permitMicrosoft then
        confirmA:=true
    else if autocorrect[ac_string] or confirmedA or
       confirm(s_ConfirmPlusSignToAnpersand,IDH_MICROSOFT_OP) then
       begin
         replacetoken('&');
         confirmedA:=true;
         confirmA:=true;
       end;
end;


function SExpression:TPrincipal;
var
   exp:TPrincipal;
begin
   exp:=stringprimary;
   while ((Token='&') or (token='+') and confirmA) and (exp<>nil)  do
         begin
               gettoken;
               exp:=TConcat.create(exp,stringprimary);
         end;
   SExpression:=exp;
end;

{**************}
{constant term }
{**************}

function SConstant:TPrincipal;
begin
   if tokenspec=SCon then
       SConstant:=stringprimary
   else
       begin
          seterrrestricted(s_Constant,IDH_STRING);
          SConstant:=nil
       end
end;


{******}
{matrix}
{******}

function Matrix:TMatrix;
var
  idr:TidRec;
begin
  matrix:=nil;
  idr:=Idrecord(false);
  if (idr<>nil) and (idr.dim>0) then
     begin
        matrix:=TMatrix(idr.subs);
        gettoken;
     end
  else
     seterr(token+s_IsNotArrayName,IDH_MAT);
end;


function  Nmatrix:TMatrix;
begin
   result:=matrix;
   if (result<>nil) and (result.kind<>'n') then
     begin
        result.Free;
        result:=nil;
        seterrExpected(s_NumArrayName,IDH_MAT);
     end;
end;

function  Smatrix:TMatrix;
begin
   result:=matrix;
   if (result<>nil) and (result.kind<>'s') then
      begin
         result.Free;
         seterrExpected(s_StringArrayName,IDH_MAT_STRING);
      end;   
end;


{*******************}
{ logical expression}
{*******************}


procedure  findcomparefunction(const r:string; var f:comparefunction);
begin
   if r='=' then f:=Equals
   else if r='<' then f:=Less
   else if (r='<=') or (r='=<') then f:=NotGreater
   else if r='>' then f:=Greater
   else if (r='>=') or (r='=>') then f:=NotLess
   else if (r='<>') or (r='><') then f:=NotEquals
   else if r='' then  seterrExpected(s_ComparisonExp,IDH_LOGICAL)
   else seterrIllegal(r,IDH_LOGICAL) ;
end;


function comparison:TLogical;     //TComparison;
var
   e1,e2:TPrincipal ;
   f:comparefunction;
begin
   comparison:=nil;
   e1:=NSExpression;
   if e1=nil then exit;
   findcomparefunction(token,f);
   gettoken;
   if e1.kind='n' then
     begin
        e2:=NExpression;
        Comparison:=NComparison(f,e1,e2)
     end
   else
      comparison:=tComparisonS.create(e1,SExpression,f) ;
end;

function Disjunction :TLogical;forward;

function relationalPrimary:TLogical;
var
   svcp:^tokensave;
begin
   if Token= '(' then
      begin
          new(svcp);
          inc(trying);
          try
             saveToken(svcp^);
             try                                    //���������������������������������������
                 relationalprimary:=comparison;
              except
                 On SyntaxError do
                    begin
                      restoretoken(svcp^);
                      gettoken;                       //������������������������������������
                      relationalprimary:=disjunction;
                      checktoken(')',IDH_LOGICAL);
                      statusmes.clear;
                      HelpContext:=0;
                    end;
             end;
          finally
             dispose(svcp);
             dec(trying);
          end;
      end
   else
      relationalprimary:=comparison;
end;

function relationalTerm:TLogical;
begin
   if token='NOT' then
       begin
            gettoken;
            relationalTerm:=TNegation.create(relationalPrimary)
       end
   else
       begin
           relationalTerm:=relationalprimary;
       end;
end;

function conjunction :TLogical;
var
    b:TLogical;
begin
   b:=relationalTerm;
   while token='AND' do
         begin
             gettoken;
             b:=TConjunction.create(b,relationalTerm)
         end;
   conjunction:=b
end;

function Disjunction :TLogical;
var
   b:Tlogical;
begin
   b:=conjunction;
   while token='OR' do
          begin
             gettoken;
             b:=TDisjunction.create(b,conjunction)
          end ;
   disjunction:=b
end;

function relationalExpression :TLogical;
begin
  if permitMicrosoft then
     relationalExpression:=TLogicalNumeric.create
  else
     relationalExpression:=Disjunction
end;


{************}
{LET statement}
{************}
type
  TLet=class(TStatement)
        vari:TVariable;
        exp :TPrincipal;
       constructor create(prev,eld:TStatement; vari1:Tvariable; exp1:Tprincipal);
       destructor destroy;override;
       function Code:AnsiString;override;
    end;

   TLetWithNoRound=class(TLet)
       function Code:AnsiString;override;
   end;

constructor TLet.create(prev,eld:TStatement; vari1:Tvariable; exp1:Tprincipal);
begin
   inherited create(prev,eld);
   vari:=vari1;
   exp:=exp1;
  if vari is TFVari then
     TFVari(vari).AddQueryInteger(exp.QueryInteger);
   if vari is TCVari then
      TCVari(vari).AddQueryDouble(exp.QueryDouble);
end;

destructor TLet.destroy;
begin
    vari.free;
    exp.free;
    inherited destroy
end;


type
  TLetMulti0=class(TStatement)
        varis:TObjectList;    {collection of TVariable}
        exp :TPrincipal;
      constructor create(prev,eld:TStatement);
      destructor destroy;override;
    end;

type
  TLetMultiN=class(TLetMulti0)
        arith:tpPrecision;
      constructor create(prev,eld:TStatement);
      function Code:ansistring;override;
    end;

constructor TLetMulti0.create(prev,eld:TStatement);
begin
    inherited create(prev,eld);
    varis:=TObjectList.create(4);
end;

constructor TLetMultiN.create(prev,eld:TStatement);
var
   k:integer;
   p:TPrincipal;
   i:integer;
begin
    inherited create(prev,eld);
    arith:=programunit.arithmetic;
    repeat
        p:=Variablesub(k);
        varis.add(p);
        if (p=nil) or (p.kind<>'n')  then seterr('',IDH_LET);
        if k<0 then seterrillegal(s_FunctionName,IDH_LET);
    until not test(',');
    check('=',IDH_LET);
    exp:=NExpression;

    with varis do
       for i:=0 to count-1 do
          begin
             p:=TPrincipal(items[i]);
             if p is TFVari then
                TFVari(p).AddQueryInteger(nil); //Integer���������
             if p is TCVari then
                TCVari(p).AddQueryDouble(nil); //Double���������
          end;

end;

destructor TLetMulti0.destroy;
begin
    varis.free;
    exp.free;
    inherited destroy
end;

{**********}
{TInputVari}
{**********}

function InputVari(StrOnly:Boolean):TInputVari;
var
   vari:TVariable;
   k:integer;
begin
    vari:=Variablesub(k);
    if(vari=nil) or (k<0) then
      begin
        vari.Free;
        seterrillegal(s_FunctionName,IDH_LET);
      end;
    if StrOnly and (vari.Kind<>'s') then
      begin
        vari.Free;
        SetErr(s_OnlyStringVar,IDH_LINE_INPUT);
      end;
    if vari.kind='n' then
      result:=TInputVari.create(vari)
    else if vari.kind='s' then
      result:=TStrVari.create(vari);
end;

constructor TInputVari.create(vari1:TVariable);
begin
    inherited create;
    vari:=vari1;
    if vari is TFVari then
               TFVari(vari).AddQueryInteger(nil); //Integer���������

end;

function StrVari:TStrVari;
var
   vari:TVariable;
   k:integer;
begin
    vari:=Variablesub(k);
    if k<0 then
       begin
         vari.Free;
         seterrillegal(s_FunctionName,IDH_LET);
       end;  
    result:=TStrVari.create(vari)
end;

constructor TStrVari.create(vari1:TVariable);
begin
    inherited create(vari1);
    if (vari1=nil) or (vari1.kind<>'s')  then
                          seterrexpected(s_StringIdentifier,IDH_String);
    if token='(' then
         SubstringQualifier(index1,index2);
    CharacterByte:=ProgramUnit.CharacterByte;
end;

destructor TInputVari.destroy;
begin
   vari.free;
   inherited destroy;
end;

destructor TStrVari.destroy;
begin
   index1.free;
   index2.free;
   inherited destroy;
end;

type
  TLetMultiS=class(TLetMulti0)
      constructor create(prev,eld:TStatement);
      function code:ansistring;override;
    end;

constructor TLetMultiS.create(prev,eld:TStatement);
begin
    inherited Create(prev,eld);
    repeat
        varis.add(StrVari);
    until not test(',');
    trying:=0;
    check('=',IDH_LET);
    exp:=SExpression;
end;

function LETst(prev,eld:TStatement):TStatement;
var
   vari:Tvariable;
   svcp:TokenSave;
   sp:char;
   k:integer;
begin
   LETst:=nil;
   savetoken(svcp);
   vari:=Variablesub(k);
   if (vari<>nil) then
      begin
        sp:=vari.kind;
        if (k<0) then
           begin
              check('=',IDH_LET);
              trying:=0;
              case sp of
               'n': Letst:=TLetwithNoRound.create(prev,eld,vari,NExpression);
               's': Letst:=TLetwithNoRound.create(prev,eld,vari,SExpression);
              end;
           end
        else if sp='n' then
           if token=',' then
              begin
                vari.Free;
                restoretoken(svcp);
                Letst:=TLetMultiN.create(prev,eld);
              end
           else
              begin
                check('=',IDH_LET);
                trying:=0;
                Letst:=Tlet.create(prev,eld,vari,NExpression);
              end
        else if sp='s' then
          begin
            vari.Free;
            restoretoken(svcp);
            Letst:=TLetMultiS.create(prev,eld);
        end;
      end
   else
      if ((tokenspec=NIdf) or (tokenspec=SIdf)) and (nexttoken='(') then
        begin
          vari.Free;
          TestSubscripted;
          seterr(s_ArrayShouldBeDeclared,IDH_ARRAY);
        end ;
end;


function tryLETst(prev,eld:TStatement):TStatement;far;
                      {���������������������������nil���������}
var
   p:TStatement;
   svcp:^TokenSave;
begin
   tryLETst:=nil;
   if (token='ELSEIF') or (token='ELSE') or (token='USE')
                                         or (token='CASE') then exit;
   if NextTokenBeyondParenthesis2<>'=' then  exit;

   if permitMicroSoft then
      begin TryLETst:=LETst(prev,eld);exit end;

   p:=nil;
   new(svcp);
   try
       savetoken(svcp^);
       try
           inc(trying);
           p:=LETst(prev,eld);
           if AutoCorrect[ac_let] or
              confirm(s_ConfirmInsertLET,IDH_MICROSOFT_OP) then
              begin
                TryLETst:=p;
                insertKeyWord('LET ',svcp^) ;
              end
           else
              begin
                 p.Free;
                 restoretoken(svcp^);
              end;
       except
          On SyntaxError do
             restoretoken(svcp^);
       end;
   finally
        dispose(svcp);
        dec(trying);
   end;
end;

{*************}
{DEFst        }
{*************}
type
    TDefN = class(TLetwithNoRound)
       constructor create(prev,eld:TStatement; routine:TRoutine);
    end;

    TDefS = class(TLetwithNoRound)
       constructor create(prev,eld:TStatement; routine:TRoutine);
    end;

constructor TDefN.create(prev,eld:TStatement; routine:TRoutine);
begin
    inherited TStatementcreate(prev,eld);
    vari:=routine.ResultVar.subs;
    check('=',IDH_DEF);
    exp:=NExpression ;
end;

constructor TDefS.create(prev,eld:TStatement; routine:TRoutine);
begin
    inherited TStatementcreate(prev,eld);
    vari:=routine.ResultVar.subs;
    check('=',IDH_DEF);
    exp:=SExpression ;
end;


function DEFst(prev,eld:TStatement):TStatement;far;
var
   sp:tokenspecification;
begin
     if (LocalRoutine<>nil)
        or (indent>0) and (CurModule=MainProgram)
        or (indent>1)   
        then  seterrillegal(prevtoken,IDH_DEF) ;
     if (ProgramUnit=CurModule) and (ProgramUnit<>MainProgram) then
        seterr(s_InternalRoutineCanntotbeInProcedure,IDH_MODULE);
     DEFst:=TStatementNoTrace.create(prev,eld) ;
     sp:=tokenspec;
     LocalRoutine:=routineHeadLocal;
     LocalRoutine.MakeParameter;
     case sp of
           NIdf: LocalRoutine.block:=TDefN.create(prev,eld,LocalRoutine);
           SIdf: LocalRoutine.block:=TDefS.create(prev,eld,LocalRoutine);
      end;
     localRoutine:=nil;
end;

{*********}
{Arguments}
{*********}

function argumentN1:TPrincipal;
begin
     check('(',IDH_FUNCTIONS);
     argumentN1:=Nexpression;
     checktoken(')',IDH_FUNCTIONS);
end;

function argumentN2a:TPrincipal;
begin
     check('(',IDH_FUNCTIONS);
     argumentN2a:=Nexpression;
     check(',',IDH_FUNCTIONS);
end;

function argumentN2b:TPrincipal;
begin
     argumentN2b:=Nexpression;
     checktoken(')',IDH_FUNCTIONS);
end;

{*********}
{Micorsoft}
{*********}

constructor TLogicalNumeric.create;
begin
   inherited create;
   exp:=NExpression;
end;

destructor TLogicalNumeric.destroy;
begin
   exp.free;
   inherited destroy
end;

{********}
{TChannel}
{********}
type
   TChannel=class(TPrincipal)
          exp:TPrincipal;
          PUnit:TProgramUnit;
        constructor create;
        destructor destroy;override;
        function kind:char;override;
        function InvalidErCode:integer;override;
        function Code:ansistring;override;
   end;

constructor TChannel.create;
begin
    inherited create;
    checkToken('#',IDH_FILE);
    exp:=NExpression;
    Punit:=programUnit;
    PUnit.haveChannelExpression:=true;
end;

destructor TChannel.destroy;
begin
   exp.free;
   inherited destroy;
end;

function ChExpression:TPrincipal;
begin
   chExpression:=TChannel.create;
end;


function ChannelExpression:TPrincipal;
begin
    if token='#' then
       begin
            gettoken;
            ChannelExpression:=NExpression;
            programunit.HaveChannelExpression:=true;
       end
    else
       ChannelExpression:=nil;
end;


function Equals(i:integer):boolean;
begin
   Equals:=(i=0)
end;

function NotEquals(i:integer):boolean;far;
begin
   NotEquals:=(i<>0)
end;

function Less(i:integer):boolean;far;
begin
   Less:=(i<0)
end;

function Greater(i:integer):boolean;far;
begin
   Greater:=(i>0)
end;

function NotGreater(i:integer):boolean;
begin
   NotGreater:=(i<=0)
end;

function NotLess(i:integer):boolean;far;
begin
   NotLess:=(i>=0)
end;


function TChannel.InvalidErCode:integer;
begin
  result:=7001
end;


function TChannel.kind:char;
begin
   result:='c'
end;

{*************}
{Generate Code}
{*************}

function ArgNLiteral(i:integer):Ansistring;
begin
   result:='arg_n'+Format('%5.5u',[i]);
end;

function ArgSLiteral(i:integer):Ansistring;
begin
   result:='arg_s'+Format('%5.5u',[i]);
end;

var
   SeqCounterN:cardinal;
   SeqCounterS:cardinal;

function ArgVarNameN:string;
begin
   inc(SeqCounterN);
   result:=ArgNLiteral(SeqCounterN);
end;
function ArgVarNameS:string;
begin
   inc(SeqCounterS);
   result:=ArgSLiteral(SeqCounterS);
end;

function TCall.Code:AnsiString;
var
   i:integer;
   s:Ansistring;
   FinalizeCode:AnsiString;
   a:tArticle;
begin
 case Routine.kind of
  'D','F':
     begin
         s:='';
         for i:=0 to params.count -1 do
           begin
             if i>0 then s:=s+',';
             a:=TArticle(params.items[i]);
             s:=s+a.code;
             //if (Routine.Kind='F') and (a is TFAVari) or (a is TCAVari) or (a is TSAVari)  then
             if (Routine.Kind='F') and ((a is TSubstance) and (TSubstance(a).idr.dim>0))  then
                s:=s+'.NewCopy ';
           end;
         if s<>'' then s:='('+s+')';
         result := routine.NameCode + s;
     end;
  'S','P':
    begin
         SeqCounterN:=0;
         SeqCounterS:=0;
         s:='';
         for i:=0 to params.count -1 do
           begin
             if i>0 then s:=s+',';
             a:=TArticle(params.items[i]);
             if (a is TVariable) and not (a is TConstVariable)  then
                s:=s+a.code
             else if (a is TPrincipal) then
               case TPrincipal(a).kind of
                'n': s:=s+ 'NumericVariable('+ ArgVarNameN + ',' + a.code + ')^';
                's': s:=s+ 'StringVariable('+ ArgVarNameS + ',' + a.code + ')^';
                'c': s:=s+ 'TDeviceRef.create(ChannelList,'+a.code+')';
               end;
           end;
         if s<>'' then s:='('+s+')';
         result := routine.nameCode + s +';';
         with proc do
           begin
             if PUnit.Arithmetic=precisionNative then
                MaxNumArgDouble:=base.max(MaxNumArgDouble,SeqCounterN)
             else if Punit.Arithmetic=precisionComplex then
                MaxNumArgComplex:=base.max(MaxNumArgComplex,SeqCounterN);
             MaxNumArgString :=base.max(MaxNumArgString,SeqCounterS);
           end;
    end;
  end;
end;

function TDisjunction.Code:AnsiString;
begin
   result:= '(' + exp1.Code + ') or (' + exp2.Code + ')'
end;

function TConjunction.Code:AnsiString;
begin
   result:= '(' + exp1.Code + ') and (' + exp2.Code + ')'
end;

function TNegation.Code:AnsiString;
begin
   result:= ' not(' + exp.Code + ') '
end;

function TComparison.Code:AnsiString;
var
   opCode:String[2];
begin
   if @op=@Express.Equals then
      opCode:='='
   else if @op=@NotEquals then
      opCode:='<>'
   else if @op=@Greater then
      opCode:='>'
   else if @op=@Less then
      opCode:='<'
   else if @op=@NotGreater then
      opCode:='<='
   else if @op=@NotLess then
      opCode:='>=';

      result := exp1.Code + opCode + exp2.Code
end;

function TLetWithNoRound.Code:AnsiString;
begin
  result:=Vari.Code + ' := ' + exp.Code + ';'
end;


function TLet.Code:AnsiString;
var
   channel:ansistring;
begin
   result:=Vari.Code + ' := ' + exp.Code + ';';
   // TRACE
   if PUnit.haveTraceSt then
   begin
       channel:='Trace' + IntToStr(PUNIT.LineNumb+1);
       if Vari is TSubstance then
       begin
           result:=result + EOL +
           'if  ' + channel + '<>nil then '+
           channel + '.PRINT([],rsNone, false ,['' ' +
           TSubstance(Vari).idr.name + '='' ,' ;
           if (vari.kind='n') and (PUnit.Arithmetic=precisionComplex) then
              result := result+ 'TComplex.create('+vari.Code+')'
           else
              result := result + vari.Code;
           result := result + ', TNewLine.create ]);' + EOL
       end
       else if Vari is TSubscripted then
       with TSubscripted(Vari) do
       begin
          result:=subs.idr.Literal+'.LetWithTrace(' + channel + ',''' + subs.idr.name + ''',';
          case dim of
           1: result:=result + subscript[1].code +',';
           2: result:=result + subscript[1].code +','+ subscript[2].code +',';
           3: result:=result + subscript[1].code +','+ subscript[2].code +','+ subscript[3].code +',';
           4: result:=result + subscript[1].code +','+ subscript[2].code +','+ subscript[3].code +','+ subscript[4].code +',';
          end;
          result:=result + exp.code + ');' +EOL;
       end;
   end;
end;


function TConcat.Code:ansistring;
begin
  result:=exp1.code + '+' + exp2.code
end;
function TSubscripted.Code:AnsiString;
begin
  result:= subs.Code + '.elements^['+subs.Code +'.index(' + subscript[1].Code;
  if dim>=2 then    result:= result + ',' + subscript[2].Code;
  if dim>=3  then    result:= result + ',' + subscript[3].Code;
  if dim>=4  then    result:= result + ',' + subscript[4].Code;
  result:= result + ')]';
end;

function TSubstring.Code:Ansistring;
begin
  if CharacterByte then
     result:='SubStringByte('
  else
     result:='SubString(';
  result:=result+exp.Code+','+exp1.Code+','+exp2.code+')'
end;

function TStrConstant.Code:AnsiString;
begin
  result:=AnsiQuotedStr(value,'''')
end;

function TletMultiN.code:ansistring;
var
   i:integer;
begin
  if arith=PrecisionComplex then
     result:='LETC(['
  else // PrecisionNative
     result:='LET(['     ;
  with varis do
    for i:=0 to count-1 do
      begin
        with (items[i] as TPrincipal) do
            result:=result + '@' + code;
        if i<count-1 then
           result:=result+',';
      end;
  result:=result+'],'+exp.code+');'
end;

function TStrVari.Code:ansistring;
begin
  if index1=nil then
     result:='TStrvar.create(@' + vari.code +')'
  else if characterbyte then
     result:='TStrvarByte.create(@' + vari.code +',' + index1.code +','+ index2.code +')'
  else
     result:='TStrvar2.create(@' + vari.code +',' + index1.code +','+ index2.code +')';
end;


function TletMultiS.code:ansistring;
var
   i:integer;
begin
  result:='LETS([';
  with varis do
    for i:=0 to count-1 do
      begin
        if i>0 then
           result:=result+',';
        result:=result+(items[i] as TStrVari).code;
      end;
  result:=result+'],'+exp.code+');'
end;

function TChannel.code:ansistring;
begin
  result:=exp.code
end;

function TStrFunction.code:ansistring;
begin
  result:=exe.code
end;

function  TConstVariable.Kind:Char;
begin
  result:=vari.kind
end;

function  TConstVariable.Code:AnsiString;
begin
  result:=vari.Code
end;

{**********}
{Initialize}
{**********}
procedure statementTableinit;far;
begin
       statementTableinitImperative('LET',LETst);
       statementTableinitStructural('DEF',DEFst);
end;


initialization
   suppliedFunctionTable:=TFncSelection.create;
   suppliedFunctionTable.capacity:=96;
   reservedwordTable:=TFncSelection.create;
   if TableInitProcs=nil then
      TableInitProcs:=TProcsCollection.create; //97.10.12 ������������������������������struct.pas������������
   tableInitProcs.accept(statementTableinit);

finalization
  suppliedFunctionTable.free;
  reservedwordTable.free;

end.