* Bugs #9838,9839,10196 fixed: evstr(strarray) 2.3 x faster + more robust against...
[scilab.git] / scilab / modules / string / macros / evstr.sci
1 // Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
2 // Copyright (C) INRIA
3 // Copyright (C) DIGITEO - 2010 - Allan CORNET
4 // Copyright (C) 2017 - Samuel GOUGEON
5 //
6 // Copyright (C) 2012 - 2016 - Scilab Enterprises
7 //
8 // This file is hereby licensed under the terms of the GNU GPL v2.0,
9 // pursuant to article 5.3.4 of the CeCILL v.2.1.
10 // This file was originally licensed under the terms of the CeCILL v2.1,
11 // and continues to be available under such terms.
12 // For more information, see the COPYING file which you should have received
13 // along with this program.
14
15 function [%val, %ierr] = evstr(%str)
16 // HELP:
17 // * assignment forbidden
18 // * If a vector or matrix of strings is provided:
19 //   A single instruction per cell: no "," or ";" instruction separator
20
21     [lhs, rhs] = argn(0);
22     %val = [];
23     %ierr =  0;
24
25     select type(%str)
26     case 10 then
27         // matrix of character strings
28         if isempty(%str) then
29             return
30         end
31
32         // bug 7003
33         vars = ["Nan"  "NaN"  "Inf"  "INF"]
34         vals = ["%nan" "%nan" "%inf" "%inf"]
35         tmp = ~isdef(vars)
36         if tmp~=[]
37             execstr(vars(tmp)+"="+vals(tmp))
38         end
39
40         // Bug 9839: support to included ascii(10) or ascii(13) characters:
41         //  If the input is scalar: we replace them with ";"
42         //  Otherwise:
43         //    For every component including some ascii(10) or ascii(13),
44         //    we replace the component with only its head up to the first ascii(10)
45         //    or ascii(13) met (excluded).
46         if size(%str,"*")==1
47             %str = strsubst(%str, ascii(10), ";");
48             %str = strsubst(%str, ascii(13), ";");
49         else
50             tmp = grep(%str, [ascii(10) ascii(13)]);
51             if tmp~=[]
52                 tmp2 = strcspn(%str(tmp), ascii(10)+ascii(13));
53                 %str(tmp) = strncpy(%str(tmp), tmp2);
54             end
55         end
56
57         // Bug 10196.b: only one component with an instruction returning nothing => [] returned
58         serialized_input = %f
59         if size(%str,"*")==1
60             %ierr = execstr("%val=["+%str(1)+"]", "errcatch");
61             if %ierr~=0
62                 %val = []
63                 return
64             end
65             if or(type(%val)==[11 13])
66                 return
67             end
68             serialized_input = size(%val,"*")>1
69         end
70
71         // input strings with possible "," and ";" separators
72         // or column of strings with possible "," and ending ";"
73         // -----------------------------------------------------
74         if serialized_input | ..
75            grep(%str(1),"/^\s*\[/","r")~=[] & grep(%str($),"/\]\s*/","r")~=[]
76             %t1 = strcat(%str, ",", "c") + ";"
77             %t1(1) = "%val=[" + %t1(1);
78             %t1($) = part(%t1($), 1:length(%t1($)) - 1)+";";
79             %t1($+1)="]";
80             if lhs == 2 then
81                 %ierr = execstr(%t1, "errcatch");
82             else
83                 execstr(%t1)
84             end
85
86         // We assume: one %str component = only one instruction
87         // ----------------------------------------------------
88         else
89             // Bugs 9838 & 10196.a:
90             // Are considered as empty instructions
91             //  - a blank or empty string
92             //  - a string containing only "[ ]" and blanks
93             //  - a string starting with possible spaces + "//" being a comment
94             //  - a string like "  [ ]  // bla bla "
95             // If at least one component is detected to be so, then
96             //  * its evaluation returning nothing will be replaced with the "neutral" default,
97             //    that depends on the overall result type.
98             //  * So we search this type: it is the type returend by the evaluation of first
99             //    non-empty component
100             //  * We set the default: "" for texts, %nan for decimal and complex numbers, etc
101             void = grep(%str, "/^(\s*\[\s*\]\s*|\s*|\s*\/\/.*|\s*\[\s*\]\s*\/\/.*)$/", "r")
102
103             if void~=[]
104                 // The default replacement depends on the type of the output
105                 // It is set by the first expected valid output:
106                 tmp = setdiff(1:size(%str,"*"), void) // indices of valid expressions
107                 if tmp~=[]
108                     execstr("tmp = "+%str(tmp(1))) // We get the result of the first one
109                 else  // none not-empty valid output is expected
110                     return
111                 end
112             else
113                 execstr("tmp = "+%str(1)) // result of the first component
114             end
115             // We test its type to set the default result according to its type:
116             if or(type(tmp)==[1 2 5])
117                 default = "%nan"
118             elseif type(tmp)==4
119                 default = "%F"
120             elseif type(tmp)==10
121                 default = """"""
122             elseif type(tmp)==8
123                 default = typeof(tmp)+"(0)"
124             elseif type(tmp)==9
125                 default = "gdf()"
126             elseif or(type(tmp)==[11 13])
127                 deff("voidF()","")  // Does not survive when leaving evstr(). Never mind
128                 default = "voidF"
129             end
130             // Substitution void => default
131             if void~=[] then
132                 %str(void) = default
133             end
134
135             if or(type(tmp)==[1 2 4 8 9 10])    // matrix() supported
136                 // We optimize the matrix size:
137                 // The closer to a square matrix the faster is execstr()
138                 S = size(%str)
139                 s = size(%str,"*")
140                 n = ceil(sqrt(s))
141                 %str = [%str(:) ; repmat(default, n*n-s,1)]
142                 %str = matrix(%str, n, n);
143             end
144             %t1 = strcat(%str, ",", "c") + ";"
145             %t1(1) = "%val=[" + %t1(1);
146             %t1($) = part(%t1($), 1:length(%t1($)) - 1)+";";
147             %t1($+1)="]";
148             if lhs == 2 then
149                 %ierr = execstr(%t1, "errcatch");
150             else
151                 execstr(%t1)
152             end
153             if or(type(tmp)==[1 2 4 8 9 10])    // Reshaping the result
154                 %val = matrix(%val(1:s), S)
155             end
156         end
157
158     case 15 then
159         // list
160         %sexp = %str(2),
161         %nstr = prod(size(%sexp));
162         % = list();
163         if lhs == 2 then
164             for %k_ = 1:%nstr,
165                 [%w, %ierr] = evstr(%sexp(%k_));
166                 %(%k_) = %w;
167                 if %ierr <>0  then
168                     %val = [];
169                     return;
170                 end
171             end
172             [%val, %ierr] = evstr(%str(1));
173         else
174             for %k_ = 1:%nstr,
175                 %(%k_) = evstr(%sexp(%k_));
176             end
177             %val = evstr(%str(1))
178         end
179
180     case 1 then
181         // real or complex constant matrix
182         %val = %str;
183         %ierr = 0;
184     else
185         msg = _("%s: Wrong type for input argument #%d: Real or Complex matrix, Matrix of character strings or list expected.\n")
186         error(msprintf(msg, "evstr", 1));
187     end
188     if exists("%val", "local") == 0 then
189         msg = _("%s: Given expression has no value.\n")
190         error(msprintf(msg, "evstr"));
191     end
192 endfunction
193