unit matexp;

{$mode Delphi}

interface

uses
  Classes, SysUtils,  Contnrs,
  base, struct, variabl, express;


type
    TStackrecycle=class(Contnrs.TobjectList)
     constructor create;
    end;

 type
  TMatExp=class(TMyObject)
         ClassType:TClass;
         dim:shortint;
         trndim:shortint;
         optionbase:shortint;
      constructor create;
      function OverflowErCode:integer;override;
      function OpName:string;override;
      procedure AskSize(var d:integer; var sz:array4);virtual;abstract;
      procedure evalA(const a:TArray; const sr:TStackrecycle);virtual;abstract;
      //得られたTARRAYオブジェクトは不要になったらsrにaddする

  end;

 function MatExp:TmatExp;
 function CompositeMat(prev,eld:TStatement):TStatement;
 function CompleteMatOperation(prev,eld:TStatement;mat1:TMatrix):TStatement;
 function TRNmatst(prev,eld:TStatement):TStatement;

implementation
uses
   texthand, HelpCtex,  mat, variabls, variablc, variablr, sconsts;

type
   TArrayClass = class of TArray;


{*****************}
{Matrix Expression}
{*****************}

 constructor TStackrecycle.create;
 begin
   inherited create(true);             //freeすると，追加したobjectもfreeされる。
 end;

 constructor TMatExp.create;
 begin
   inherited create;
   optionbase:=programunit.ArrayBase;
   case programunit.arithmetic of
       PrecisionNormal,PrecisionHigh:classtype:=TNArray;
       PrecisionNative              :classtype:=TFArray;
       PrecisionComplex             :classtype:=TCArray;
       PrecisionRational            :classtype:=TRArray;
   end;
 end;

 function  TMatExp.OverflowErCode:integer;
 begin
   result:=1005
 end;

function TMatExp.OpName:string;
begin
   result:='Matrix exppression'
end;

type
  TMatMatrix=class(TMatExp)
      mat1:TMatrix;
     constructor create(mat01:TMatrix);
     destructor destroy;override;
     procedure evalA(const a:TArray; const sr:TStackrecycle);override;
     procedure AskSize(var d:integer; var sz:array4);override;
  end;

 constructor TMatMatrix.create(mat01:TMatrix);
 begin
   inherited create;
   mat1:=mat01;
   dim:=mat1.idr.dim;
 end;

destructor TMatMatrix.destroy;
begin
    mat1.free;
    inherited destroy;
end;

procedure  TMatMatrix.evalA(const a:TArray; const sr:TStackrecycle);
begin
  a.matsubst(mat1.ptr as TArray);               //copyを返す
end;

procedure TMatMatrix.AskSize(var d:integer; var sz:array4);
begin
    with (mat1.ptr as TArray) do
      begin
         d:= dim;
        sz:= Size;
      end;
end;

type TVarList=class( Contnrs.TobjectList);

type
  TCompositeMatrix=Class(Tmatexp)
     VarList:TVarList;
     constructor create(VarList0:TvarList);
     destructor destroy;override;
     procedure AskSize(var d:integer; var sz:array4);override;
  end;

 TCompositeMatrixN=Class(TCompositeMatrix)
    procedure evalA(const a:TArray; const sr:TStackrecycle);override;
  end;

 TCompositeMatrixF=Class(TCompositeMatrix)
   procedure evalA(const a:TArray; const sr:TStackrecycle);override;
  end;

 TCompositeMatrixC=Class(TCompositeMatrix)
    procedure evalA(const a:TArray; const sr:TStackrecycle);override;
 end;

 TCompositeMatrixR=Class(TCompositeMatrix)
    procedure evalA(const a:TArray; const sr:TStackrecycle);override;
 end;


constructor TCompositeMatrix.create(VarList0:TvarList);
begin
  inherited create;
  VarList:=VarList0;
  dim:=1
end;

destructor TCompositeMatrix.destroy;
begin
  VarList.free;
  inherited destroy;
end;

procedure TCompositeMatrix.AskSize(var d:integer; var sz:array4);
begin
  d:=dim;
  sz[1]:=VarList.count;
  sz[2]:=1;
  sz[3]:=1;
  sz[4]:=1;
end;

procedure TCompositeMatrixN.evalA(const a:TArray; const sr:TStackrecycle);
var
  i,n:integer;
  v:TVar;
  exp:TPrincipal;
begin
  n:=VarList.count;
  //a:= TNArray.createMatrix(n,1);
   with TNArray(a) do
   for i:=0 to n-1 do
          begin
             exp:= VarList[i] as TPrincipal;
             (ary[i] as TVar).assign(exp);
          end;
   with a do for i:=1 to 4 do lbound[i]:=optionbase;
   if a.dim=2 then
      with a do
        begin
           size[2]:=size[1];
           size[1]:=1
        end

end;

procedure  TCompositeMatrixF.evalA(const a:TArray; const sr:TStackrecycle);
var
  i,n:integer;
  v:TVar;
  exp:TPrincipal;
begin
  n:=VarList.count;
  //a:= TFArray.createMatrix(n,1);
  with TFArray(a) do
   for i:=0 to n-1 do
          begin
             exp:= VarList[i] as TPrincipal;
             TFArray(a).dary^[i]:=exp.evalF;
          end;
  with a do for i:=1 to 4 do lbound[i]:=optionbase;
  if a.dim=2 then
      with a do
        begin
           size[2]:=size[1];
           size[1]:=1
        end
end;

procedure  TCompositeMatrixC.evalA(const a:TArray; const sr:TStackrecycle);
var
  i,n:integer;
  v:TVar;
  exp:TPrincipal;
  c:complex;
begin
  n:=VarList.count;
  //a:= TCArray.createMatrix(n,1);
   with TCArray(a) do
     for i:=0 to n-1 do
            begin
               exp:= VarList[i] as TPrincipal;
               exp.evalC(c);
               TCArray(a).cary^[i]:=c;
            end;
   with a do for i:=1 to 4 do lbound[i]:=optionbase;
   if a.dim=2 then
      with a do
        begin
           size[2]:=size[1];
           size[1]:=1
        end
 end;

 procedure TCompositeMatrixR.evalA(const a:TArray; const sr:TStackrecycle);
var
  i,n:integer;
  v:TVar;
  exp:TPrincipal;
  c:complex;
begin
  n:=VarList.count;
  //a:= TRArray.createMatrix(n,1);
  with TRArray(a) do
   for i:=0 to n-1 do
          begin
             exp:= VarList[i] as TPrincipal;
             (ary[i] as TVar).assign(exp);
          end;
   with a do for i:=1 to 4 do lbound[i]:=optionbase;
   if a.dim=2 then
      with a do
        begin
           size[2]:=size[1];
           size[1]:=1
        end

end;
type
  TMatOPIDN=class(TMatExp)
      exp:TPrincipal;
   constructor create(e:TPrincipal);
   destructor destroy;override;
   procedure AskSize(var d:integer; var sz:array4);override;
   procedure evalA(const a:TArray; const sr:TStackrecycle);override;
  end;

constructor TMatOPIDN.create(e:TPrincipal);
begin
  inherited create;
  dim:=2;
  exp:=e;
end;

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

procedure TMatOPIDN.AskSize(var d:integer; var sz:array4);
var i:integer;
begin
  d:=2;

  if exp<>nil then
     i:=exp.evalLongint
  else
     setexception(6004);

  sz[1]:=i;
  sz[2]:=i;
  sz[3]:=1;
  sz[4]:=1;
end;

procedure TMatOPIDN.evalA(const a:TArray; const sr:TStackrecycle);
begin
  a.SubstIDN;
end;


type
  TmatOp1=Class(TmatExp)
     matexp1:TMatExp;
    constructor create(matexp01:TMatExp);
    destructor destroy;override;
    procedure AskSize(var d:integer; var sz:array4);override;
   end;

constructor TmatOp1.create(matexp01:TMatExp);
begin
   inherited create;
   matexp1:=matexp01;
   dim:=matexp1.dim;
end;

destructor TmatOp1.destroy;
begin
  matexp1.free;
  inherited destroy;
end;

procedure TmatOp1.AskSize(var d:integer; var sz:array4);
begin
   matexp1.asksize(d,sz);
end;

type
  TMatOpTRN=class(TMatOp1)
    constructor create(matexp01:TMatExp);
    procedure AskSize(var d:integer; var sz:array4);override;
    procedure evalA(const a:TArray; const sr:TStackRecycle);override;
  end;

constructor TMatOpTRN.create(matexp01:TMatExp);
begin
  inherited create(matexp01);
  if dim=1 then begin dim:=2; trndim:=1 end;
  if dim<>2 then
         seterrDimension(IDH_MAT);
end;

procedure TMatOpTRN.AskSize(var d:integer; var sz:array4);
var
  t:integer;
begin
  matexp1.AskSize(d,sz);
  if d=2 then
     begin
         t:=sz[1];
         sz[1]:=sz[2];
         sz[2]:=t
     end
  else if d=1 then
    d:=2
  else
    setexception(6001) ;
end;

procedure TMatOpTRN.evalA(const a:TArray; const sr:TStackrecycle);
var
  a2,p:TArray;
  d:integer;
  sz:array4;
begin
  matexp1.AskSize(d,sz);
  a2:=TarrayClass(classtype).createNative(d,sz);
  MatExp1.evalA(a2,sr);
  //matexp1が1次元のとき，a2を(n×1)行列に擬態する。
   if d=1 then
      a.matSubst(a2)
   else
      begin
         p:=a2.trn;
         a.matsubst(p);
         p.free;
      end;
   a2.free;
end;


type
  TMatOpInv=class(TMatOp1)
    constructor create(matexp01:TMatExp);
    procedure evalA(const a:TArray; const sr:TStackrecycle);override;
    function InvalidErCode:integer;override;
    function OpName:string;override;
  end;

constructor TMatOpInv.create(matexp01:TMatExp);
begin
     inherited create(matexp01);
     if dim<>2 then
         seterrDimension(IDH_MAT);
end;
{
 procedure TMatOpInv.evalA(const a:TArray; const sr:TStackrecycle);
 var
  a2,p:TArray;
begin
   a2:=TArrayClass(a.classtype).createFrameCopy(a);
   MatExp1.evalA(a2,sr);
   currentOperation:=self;
   p:=a2.inverse;
   a.matsubst(p);
   currentOperation:=nil;
   p.free;
   a2.free;
end;
}
procedure TMatOpInv.evalA(const a:TArray; const sr:TStackrecycle);
var
 p:TArray;
begin
  MatExp1.evalA(a,sr);
  currentOperation:=self;
  p:=a.inverse;
  a.matsubst(p);
  currentOperation:=nil;
  p.free;
end;


function TMatOpInv.InvalidErCode:integer;
begin
   result:=3009
end;

function TMatOpInv.OpName:string;
begin
  result:='MAT INV'
end;

type
  TMatOpCnj=class(TMatOp1)
    procedure evalA(const a:TArray; const sr:TStackrecycle);override;
  end;

procedure CCONJ(var x:complex);
begin
   x.y:=-x.y
end;

 procedure TMatOpCnj.evalA(const a:TArray; const sr:TStackrecycle);
 var
      i,n:integer;
begin
  MatExp1.evalA(a,sr);
  if classtype=TCArray then
     begin
      n:=a.amount;
      with TCArray(a) do
         begin
            for i:=0 to n-1 do
                    cconj(TCArray(a).cary^[i]) ;
         end;
     end


end;


type
  TMatPower=Class(TmatOp1)
     exp1:TPrincipal;          //指数
     constructor create(matexp01:TMatexp; exp01:TPrincipal);
     destructor destroy;override;
     procedure evalA(const a:TArray; const sr:TStackrecycle)override;
  end;

constructor TMatPower.create(matexp01:TMatexp; exp01:TPrincipal);
begin
  inherited create(Matexp01);
  if dim<>2 then
      seterrDimension(IDH_MAT);
  exp1:=exp01;
end;

destructor TMatPower.destroy;
begin
  exp1.free;
  inherited destroy
end;

procedure TMatPower.evalA(const a:TArray; const sr:TStackRecycle);
var
     i,n:integer;
     a1,a2:TArray;
begin
    n:=exp1.evalLongint;
    if n=0 then
       a.substIDN
    else
        begin
             MatExp1.evalA(a,sr);
             if n>0 then
                begin
                   TVar(a1):=a.newcopy;
                   for i:=2 to n do
                      a.matproduct(a,a1);
                   //sr.add(a1);
                   a1.free;
                end
             else {if n<0 then}
                begin
                   n:=-n;
                   a1:=a.inverse;
                   a.matsubst(a1);
                   a1.free;
                   TVar(a1):=a.newcopy;
                   for i:=2 to n do
                       a.matproduct(a,a1);
                  a1.free;
                end ;
        end;
end;

type
    TMatScalar=Class(TmatOp1)
     exp1:TPrincipal;          //スカラー
     constructor create(exp01:TPrincipal; matexp01:TMatexp);
     destructor destroy;override;
     procedure evalA(const a:TArray; const sr:TStackrecycle);override;
    end;

constructor TMatScalar.create(exp01:TPrincipal; matexp01:TMatexp);
begin
  inherited create(matexp01);
  exp1:= exp01
end;

destructor TMatScalar.destroy;
begin
  exp1.free;
  inherited destroy;
end;

procedure TMatScalar.evalA(const a:TArray; const sr:TStackRecycle);
var
  n:TVar;
begin
   matexp1.evalA(a,sr);
   if exp1<>nil then
       begin
          n:=exp1.substance1;
          a.scalarmulti(n);
          exp1.disposesubstance1(n);
       end;
end;

type
    TmatOp2=Class(TmatExp)
      matexp1,matexp2:TMatExp;
     constructor create(matexp01,matexp02:TMatExp);
     destructor destroy;override;
   end;

    TMatMulti=Class(TmatOp2)
     constructor create(matexp01,matexp02:TMatExp);
     procedure AskSize(var d:integer; var sz:array4);override;
     procedure evalA(const a:TArray; const sr:TStackRecycle);override;
    end;

    TMatAdd=Class(TmatOp2)
     constructor create(matexp01,matexp02:TMatExp);
     procedure AskSize(var d:integer; var sz:array4);override;
     procedure evalA(const a:TArray; const sr:TStackrecycle);override;
    end;

    TMatSbt=Class(TMatAdd)
     procedure evalA(const a:TArray; const sr:TStackrecycle);override;
    end;

constructor TmatOp2.create(matexp01,matexp02:TMatExp);
begin
    inherited create;
    matexp1:=matexp01;
    matexp2:=matexp02;
end;

destructor TmatOp2.destroy;
begin
  matexp1.free;
  matexp2.free;
  inherited destroy;
end;

constructor TmatMulti.create(matexp01,matexp02:TMatExp);
begin
  inherited create(matexp01,matexp02);
  if (matexp1.dim=1) and (matexp2.dim=2) then
     dim:=1
  else if (matexp1.dim=2) then
     begin
        dim:=2;
        if matexp2.trndim=1 then
           trndim:=1;
     end
  else
     seterrDimension(IDH_MAT);
end;

constructor TmatAdd.create(matexp01,matexp02:TMatExp);
begin
  inherited create(matexp01,matexp02);
  dim:=matexp1.dim;
  if dim<>matexp2.dim then
     seterrDimension(IDH_MAT);
end;

procedure TMatMulti.AskSize(var d:integer; var sz:array4);
var
    d1,d2:integer;
    sz1,sz2:array4;
begin

    matexp1.asksize(d1,sz1);
    matexp2.asksize(d2,sz2);
    if d1=1 then
       begin
         d:=1;
         sz:=sz1
       end
    else
       begin
          d:=2;
          sz[1]:=sz1[1];
          sz[2]:=sz2[2];
          sz[3]:=1;
          sz[4]:=1;
          if (sz1[2]<>sz2[1]) then
          setexception(6001)
      end;
end;

procedure TMatMulti.evalA(const a:TArray; const sr:TStackRecycle);
var
      a1,a2:TArray;
      d:integer;
      sz:array4;
begin
    matexp1.asksize(d,sz);
    a1:=TArrayClass(Classtype).createNative(d,sz);
    matexp1.evalA(a1,sr);
    matexp2.asksize(d,sz);
    a2:=TArrayClass(Classtype).createNative(d,sz);
    matexp2.evalA(a2,sr);
    try
       CurrentOperation:=self;
       a.matproduct(a1,a2);
       CurrentOperation:=nil;
    finally
         a2.free;
         a1.free;
      end;
end;



function SameSize(d:integer; var size1,size2:array4):boolean;
var
  i:integer;
begin
  result:=true;
  for i:=1 to d do
      if size1[i]<>size2[i] then result:=false
end;

procedure TMatAdd.AskSize(var d:integer; var sz:array4);
var
    d2:integer;
    sz2:array4;
begin
    matexp1.asksize(d,sz);
    matexp2.asksize(d2,sz2);
    if (d<>d2) or not samesize(d,sz,sz2) then
       setexception(6001)
end;

procedure TMatAdd.evalA(const a:TArray; const sr:TStackRecycle);
var
  a1,a2:TArray;
  d:integer;
   sz:array4;
begin
  matexp1.asksize(d,sz);
  a1:=TArrayClass(Classtype).createNative(d,sz);
  matexp1.evalA(a1,sr);
  matexp2.asksize(d,sz);
  a2:=TArrayClass(Classtype).createNative(d,sz);
  matexp2.evalA(a2,sr);
    a.matadd(a1,a2);
    a2.free;
    a1.free;
end;

procedure TMatSbt.evalA(const a:TArray; const sr:TStackRecycle);
var
  a1,a2:TArray;
  d:integer;
   sz:array4;
begin
  matexp1.asksize(d,sz);
  a1:=TArrayClass(Classtype).createNative(d,sz);
  matexp1.evalA(a1,sr);
  matexp2.asksize(d,sz);
  a2:=TArrayClass(Classtype).createNative(d,sz);
  matexp2.evalA(a2,sr);
    a.matsbt(a1,a2);
    a2.free;
    a1.free;
end;

function CompositeMatrix:TMatExp;
var
  VarList:TVarList;
  exp:TPrincipal;
begin
  VarList:=TVarList.create;
  try
     repeat
         exp:= NExpression ;
         VarList.add(exp);
     until not test(',');
     case programunit.arithmetic of
        PrecisionNormal,PrecisionHigh:result:=TCompositeMatrixN.create(VarList);
        PrecisionNative              :result:=TCompositeMatrixF.create(VarList);
        PrecisionComplex             :result:=TCompositeMatrixC.create(VarList);
        PrecisionRational            :result:=TCompositeMatrixR.create(VarList);
     end;
  except
     VarList.free;
     result:=nil;
  end;


end;

function matPrimary:TMatExp;
var
   svcp:TokenSave;

begin
   if token='(' then
     begin
       gettoken;
       result:=matexp;
       checktoken(')',IDH_MAT);
     end
   else if token='['  then
     begin
        gettoken;
        result:=Compositematrix;
        checktoken(']',IDH_MAT);
     end
   else if tokenspec=NIdf then
           if (token='IDN') and (NextToken='(') then
              begin
                 gettoken;
                 gettoken;
                 result:=TMatOpIDN.create(NExpression);
                 checkToken(')',IDH_MAT);
              end
           else  if (token='TRN') and (nextToken='(') then
              begin
                 gettoken;
                 gettoken;
                 result:=TMatOpTRN.create(MatExp) ;
                 checktoken(')',IDH_MAT);
              end
           else if (token='INV') and (nextToken='(') then
              begin
                 gettoken;
                 gettoken;
                 result:=TMatOpINV.create(MatExp);
                 checktoken(')',IDH_MAT);
               end
           else if (token='CNJ') and (nextToken='(') then
               begin
                  gettoken;
                  gettoken;
                  result:=TMatOpCNJ.create(MatExp);
                  checktoken(')',IDH_MAT);
                 end
           else
                result:=TMatMatrix.create(matrix)

   else
     seterr(token + s_CantBelongHere  , IDH_MAT)   ;


end;


 function MatFactor:TMatExp ;
 var
    exp:TMatExp;
 begin
    exp:=MatPrimary;
    while (Token='^') and (exp<>nil)  do
          begin
            gettoken;
            exp:=TMatPower.create(exp,Primary);
          end;
    result:=exp;
end;

function MatTerm:TMatExp;
var
    pri:Tprincipal;
    exp:TMatExp ;
    svcp:TokenSave;
 begin
    try
       savetoken(svcp);
       pri:=primary;
       if token='*' then
          gettoken
       else
          begin
             restoretoken(svcp);
             pri:=nil;
          end;
    except
       restoretoken(svcp);
       pri:=nil;
    end;

    exp:=MatFactor;
    while (token='*')  and (exp<>nil)  do
       begin
           gettoken;
           exp:=TMatMulti.create(exp, MatFactor);
        end;
    if pri=nil then
       result:=exp
    else
       result:=TMatScalar.create(pri,exp)
 end;


function MatExp:TmatExp;
var
   exp:TMatExp;
   op:char;
 begin
   exp:=MatTerm;
   while ((token='+') or (token='-')) and (exp<>nil)  do
        begin
           op:=token[1];
           gettoken;
           case  op of
               '+': exp:=TMatAdd.create(exp,MatTerm);
               '-': exp:=TMatSbt.create(exp,MatTerm);
           end;
        end;
   result:=exp
end;



{***********************}
{Complete MAT Operartion}     //ver.8.1.5.0
{***********************}
type
    TMatSubst=class(Tmat)
       MatExp1:TMatExp;
     constructor create(prev,eld:TStatement; m1:TMatrix; e1:TMatExp);
     procedure exec;override;
     destructor destroy;override;
     private
      procedure CreateDimTest;virtual;
    end;

constructor TMatSubst.create(prev,eld:TStatement; m1:TMatrix; e1:TMatExp);
begin
  inherited create(prev,eld);
  mat1:=m1;
  MatExp1:=e1;
  CreateDimTest;
end;

procedure  TMatSubst.createDimTest;
begin
   if mat1.idr.dim<>MatExp1.dim then
     seterrDimension(IDH_MAT);
end;

destructor TMatSubst.destroy;
begin
  MatExp1.free;
  mat1.free;
  inherited destroy;
end;

procedure TMatSubst.exec;
var
   a1,a2:TArray;
   sr:TStackRecycle;
   d:integer;
   sz:array4;
begin

   sr:=TStackRecycle.create;
   try
     TVar(a1):=mat1.point;
     MatExp1.evalA(a1,sr);
   finally
     sr.free;
   end;
end;


function CompleteMatOperation(prev,eld:TStatement;mat1:TMatrix):TStatement;
var
   matexp1:TMatExp;
begin
  if token='=' then
     begin
      gettoken;
      matexp1:=MatExp;
      result:=TmatSubst.create(prev,eld, mat1, matexp1)
     end
end;

{********}
{TRNMatst}
{********}
type
    TTRNMatSubst=class(TMatSubst)
      procedure exec;override;
     private
      procedure CreateDimTest;Override;

    end;

 procedure  TTRNMatSubst.createDimTest;
begin
   if mat1.idr.dim=1 then
      if MatExp1.trndim<>1 then
         seterrDimension(IDH_MAT);
end;

procedure TTRNMatSubst.exec;
var
   a1,a2,a3:TArray;
   sr:TStackRecycle;
   d,svd:integer;
   sz,svsz:array4;
begin
   sr:=TStackRecycle.create;
   TVar(a1):=mat1.point;
   svd:=a1.dim;
   svsz:=a1.size;
   d:=2;
   sz:=svsz;
   if svd=2 then
      begin
       sz[1]:=svsz[2];
       sz[2]:=svsz[1];
      end;
   a2:=TarrayClass(a1.classtype).createNative(d,sz);
   try
    MatExp1.evalA(a2,sr);
    a3:=a2.TRN;
    if (a1.dim=1) and (a3.dim=2) then
       if a3.size[1]=1 then
          with a3 do
            begin
              size[1]:=size[2];
              size[2]:=1;
              dim:=2
            end
          else
            setexception(6001) ;
    a1.matsubst(a3);
    a3.free;
    a2.free;
   finally
    sr.free;
   end;
end;

function CompositeTRNMatst(prev,eld:TStatement):TStatement; forward;
function TRNmatst(prev,eld:TStatement):TStatement;
var
      mat1:TMatrix;
      matexp1:TMatExp;
begin
   gettoken;  //'TRN'
   gettoken;  //'('
   if token='[' then
      result:=CompositeTRNMatst(prev,eld)
   else
      begin
         mat1:=matrix;
         checktoken(')',IDH_MAT);
         if token='=' then
              begin
               gettoken;
               matexp1:=MatExp;
               result:=TTRNmatSubst.create(prev,eld, mat1, matexp1)
              end
      end;
   end;

{***************}
{Composite MATst}
{***************}
type TCompositeMatSubst=class(TStatement)
    VarList:TVarList;
    matexp1:TMatExp;
    trn:boolean;
      constructor create(prev,eld:TStatement; VarList0:TVarList; matexp0:TMatExp; trn0:boolean);
      procedure exec;override;
      destructor destroy;override;
    end;

constructor TCompositeMatSubst.create(prev,eld:TStatement; VarList0:TVarList; matexp0:TMatExp; trn0:boolean);
begin
  inherited create(prev,eld);
  VarList:=VarList0;
  matexp1:=matexp0;
  trn:=trn0;
end;

destructor TCompositeMatSubst.destroy;
begin
   matexp1.free;
   VarList.Free;
   inherited destroy;
end;

procedure TCompositeMatSubst.exec;
var
   i:integer;
   n:integer;
   v:TSubstance;
   a2,a3:TArray;
   sr:TStackRecycle;
begin
   sr:=TStackRecycle.create;
   n:=VarList.Count;
   a2:=TArrayClass(MatExp1.classType).createMatrix(n,1);
   if not trn then
      a2.dim:=1;
   try
    MatExp1.evalA(a2,sr);
    if n=a2.amount then
       begin
        for i:=0 to n-1 do
            begin
               v:=(VarList[i] as TSubstance);
               v.point.copyfrom(a2.ItemSubstance1(i));
            end;
        end
    else
       setexception(6001);
   finally
    a2.free;
    sr.free;
  end;
end;


function CompositeMat(prev,eld:TStatement):TStatement;
var
   VarList: TVarList;
   matexp1:TMatExp;
begin
    VarList:=TVarList.create;
    gettoken;  //'['
    VarList.add(NVariable);
    while test(',') do
           VarList.add(NVariable);
    checkToken(']',IDH_MAT);
    if token='=' then
       begin
        gettoken;
        matexp1:=MatExp;
        if matexp1=nil then
           seterror('Matrix error',IDH_MAT)
        else
           result:=TCompositeMatSubst.create(prev,eld, VarList, matexp1,false)
       end
end;

function CompositeTRNMatst(prev,eld:TStatement):TStatement;
var
   VarList: TVarList;
   matexp1:TMatExp;
begin
    VarList:=TVarList.create;
    gettoken;  //'['
    VarList.add(NVariable);
    while test(',') do
           VarList.add(NVariable);
    checkToken(']',IDH_MAT);
    checktoken(')',IDH_MAT);
    if token='=' then
       begin
        gettoken;
        matexp1:=MatExp;
        if matexp1=nil then
           seterror('Matrix error',IDH_MAT)
        else
           result:=TCompositeMatSubst.create(prev,eld, VarList, matexp1,true)
       end
end;


end.

