f68402354a1ad8efdb96f04010849b75b4862b9d
[scilab.git] / scilab / modules / overloading / macros / %s_i_st.sci
1 // Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
2 // Copyright (C) 2010 - INRIA - Serge Steer <serge.steer@inria.fr>
3 //
4 // Copyright (C) 2012 - 2016 - Scilab Enterprises
5 //
6 // This file is hereby licensed under the terms of the GNU GPL v2.0,
7 // pursuant to article 5.3.4 of the CeCILL v.2.1.
8 // This file was originally licensed under the terms of the CeCILL v2.1,
9 // and continues to be available under such terms.
10 // For more information, see the COPYING file which you should have received
11 // along with this program.
12
13 function out=%s_i_st(varargin)
14
15     // - Modified by Vincent COUVERT (16/08/2004) so that insertion of an empty matrix
16     //   is understood as an element deletion
17     //   Only one non-colon index can be used
18     // - Modified by Serge Steer INRIA (04/05/2010) to fix problems in element
19     //   deletion part
20
21     if size(varargin)>=3 & isempty(varargin($-1)) & ..
22         and(type(varargin(1))<>[10 15]) then
23         // st(i,:)=[] or st(:,j)=[] or st(i)=[] or st(:,j,:,:)=[]
24         //remove the substruct
25         out=varargin($);
26         dims=size(out)
27
28         // Make the dimensions and the indices fit
29         Ndims=size(dims,"*")
30         nindex=size(varargin)-2
31         if nindex>Ndims then
32             //index in excess must be equal to 1 or to :
33             for k=Ndims+1:nindex
34                 i=varargin(k)
35                 if size(i,"*")>1|(i<>1&i<>eye()) then
36                     error(msprintf(_("%s: A null assignment can have only one non-colon index.\n"),"%s_i_st"));
37                 end
38             end
39             nindex=Ndims
40         elseif nindex<Ndims then
41             //collapse dimensions in excess
42             dims=[dims(1:nindex-1) prod(dims(nindex:$))]
43             Ndims=nindex;
44             if size(dims,"*")==1 then dims=[dims 1],end
45         end
46
47         // Check the compatibility of the index (at most one index cannot span
48         // all the elements ot the associated struct dimension)
49         cj=[];
50         for k=1:nindex
51             ind=varargin(k)
52             if or(size(ind)<>[-1 -1]) then
53                 if or(type(ind)==[2,129]) then // size implicit index ($ based)
54                     ind=horner(ind,dims(k));
55                 end
56                 ind=floor(ind);
57                 //check if index is valid
58                 if ~isreal(ind)|or(ind<=0) then
59                     error(21)
60                 end
61                 //remove indices that exceed the associated struct dimension
62                 ind(ind>dims(k))=[];
63                 //compute the complement with respect to the associated dimension of st
64                 ind=setdiff(1:dims(k),ind)
65                 if ind<>[]&cj==[] then
66                     cj=ind
67                     loc=k,
68                 else
69                     error(msprintf(_("%s: A null assignment can have only one non-colon index.\n"),"%s_i_st"));
70                 end
71             end
72         end
73
74         // Generate the result
75         if cj==[] then  //st(:,:)=[]  --> empty struct
76             Fout=getfield(1,out)
77             Fout=Fout(3:$)
78             for f=Fout
79                 out(f)=list()
80             end
81         else
82             //replace st(:,j,:,:)=[] by st=st(:,cj,:,:) where cj is the
83             //complement of j with respect to the associated dimension of st
84             varargin(loc)=cj
85             out=out(varargin(1:Ndims))
86         end
87
88     elseif size(varargin)==3 & type(varargin(1))==10 then // out.i=in
89         i=varargin(1);
90         in=varargin(2);
91         out=varargin(3);
92         out=generic_i_st(i,in,out)
93     else
94         error(msprintf(_("%s: Not yet implemented.\n"),"%s_i_st"));
95     end
96 endfunction