Mercurial > octave-nkf
annotate src/DLD-FUNCTIONS/dispatch.cc @ 9444:0c785ad961fa
improve behavior of builtin
| author | John W. Eaton <jwe@octave.org> |
|---|---|
| date | Tue, 21 Jul 2009 12:43:33 -0400 |
| parents | 8f9d8776d11c |
| children | 40dfc0c99116 |
| rev | line source |
|---|---|
| 5164 | 1 /* |
| 2 | |
| 8920 | 3 Copyright (C) 2001, 2005, 2006, 2007, 2008, 2009 |
| 4 John W. Eaton and Paul Kienzle | |
| 5164 | 5 |
| 7016 | 6 This file is part of Octave. |
| 7 | |
| 8 Octave is free software; you can redistribute it and/or modify it | |
| 5164 | 9 under the terms of the GNU General Public License as published by the |
| 7016 | 10 Free Software Foundation; either version 3 of the License, or (at your |
| 11 option) any later version. | |
| 5164 | 12 |
| 7016 | 13 Octave is distributed in the hope that it will be useful, but WITHOUT |
| 5164 | 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
| 7016 | 19 along with Octave; see the file COPYING. If not, see |
| 20 <http://www.gnu.org/licenses/>. | |
| 5164 | 21 |
| 22 */ | |
| 23 | |
| 24 #ifdef HAVE_CONFIG_H | |
| 25 #include <config.h> | |
| 26 #endif | |
| 27 | |
| 28 #include <list> | |
| 29 #include <map> | |
| 30 #include <string> | |
| 31 | |
| 7336 | 32 #include "Cell.h" |
| 33 #include "oct-map.h" | |
| 5164 | 34 #include "defun-dld.h" |
| 35 #include "ov.h" | |
| 36 #include "ov-fcn.h" | |
| 37 #include "ov-typeinfo.h" | |
| 38 #include "pager.h" | |
| 39 #include "parse.h" | |
| 40 #include "symtab.h" | |
| 41 #include "variables.h" | |
| 42 | |
| 43 DEFUN_DLD (builtin, args, nargout, | |
| 44 "-*- texinfo -*-\n\ | |
| 45 @deftypefn {Loadable Function} {[@dots{}]} builtin (@var{f}, @dots{})\n\ | |
| 46 Call the base function @var{f} even if @var{f} is overloaded to\n\ | |
| 47 some other function for the given type signature.\n\ | |
| 5646 | 48 @seealso{dispatch}\n\ |
| 49 @end deftypefn") | |
| 5164 | 50 { |
| 51 octave_value_list retval; | |
| 52 | |
| 53 int nargin = args.length (); | |
| 54 | |
| 55 if (nargin > 0) | |
| 56 { | |
| 57 const std::string name (args(0).string_value ()); | |
| 58 | |
| 7336 | 59 if (! error_state) |
| 5164 | 60 { |
|
9444
0c785ad961fa
improve behavior of builtin
John W. Eaton <jwe@octave.org>
parents:
9443
diff
changeset
|
61 octave_value fcn = symbol_table::builtin_find (name); |
| 5164 | 62 |
| 7336 | 63 if (fcn.is_defined ()) |
| 64 retval = feval (fcn.function_value (), args.splice (0, 1), | |
| 65 nargout); | |
| 5200 | 66 else |
| 7336 | 67 error ("builtin: lookup for symbol `%s' failed", name.c_str ()); |
| 5164 | 68 } |
| 69 else | |
| 7336 | 70 error ("builtin: expecting function name as first argument"); |
| 5164 | 71 } |
| 72 else | |
| 5823 | 73 print_usage (); |
| 5164 | 74 |
| 75 return retval; | |
| 76 } | |
| 77 | |
| 7336 | 78 DEFUN_DLD (dispatch, args, nargout, |
| 5164 | 79 "-*- texinfo -*-\n\ |
| 80 @deftypefn {Loadable Function} {} dispatch (@var{f}, @var{r}, @var{type})\n\ | |
| 81 \n\ | |
| 82 Replace the function @var{f} with a dispatch so that function @var{r}\n\ | |
| 83 is called when @var{f} is called with the first argument of the named\n\ | |
|
9038
fca0dc2fb042
Cleanup documentation files stmt.texi and func.texi
Rik <rdrider0-list@yahoo.com>
parents:
8920
diff
changeset
|
84 @var{type}. If the type is @var{any} then call @var{r} if no other type\n\ |
| 5164 | 85 matches. The original function @var{f} is accessible using\n\ |
| 6248 | 86 @code{builtin (@var{f}, @dots{})}.\n\ |
| 5164 | 87 \n\ |
| 88 If @var{r} is omitted, clear dispatch function associated with @var{type}.\n\ | |
| 89 \n\ | |
| 90 If both @var{r} and @var{type} are omitted, list dispatch functions\n\ | |
| 5646 | 91 for @var{f}.\n\ |
| 92 @seealso{builtin}\n\ | |
| 93 @end deftypefn") | |
| 5164 | 94 { |
| 95 octave_value retval; | |
| 7336 | 96 |
| 5164 | 97 int nargin = args.length (); |
| 98 | |
| 7336 | 99 std::string f, r, t; |
| 5164 | 100 |
| 7336 | 101 if (nargin > 0 && nargin < 4) |
| 5164 | 102 { |
| 7336 | 103 if (nargin > 0) |
| 104 { | |
| 105 f = args(0).string_value (); | |
| 106 | |
| 107 if (error_state) | |
| 108 { | |
| 109 error ("dispatch: expecting first argument to be function name"); | |
| 110 return retval; | |
| 111 } | |
| 112 } | |
| 113 | |
| 114 if (nargin > 1) | |
| 115 { | |
| 116 r = args(1).string_value (); | |
| 5164 | 117 |
| 7336 | 118 if (error_state) |
| 119 { | |
| 120 error ("dispatch: expecting second argument to be function name"); | |
| 121 return retval; | |
| 122 } | |
| 123 } | |
| 124 | |
| 125 if (nargin > 2) | |
| 126 { | |
| 127 t = args(2).string_value (); | |
| 128 | |
| 129 if (error_state) | |
| 130 { | |
| 131 error ("dispatch: expecting third argument to be type name"); | |
| 132 return retval; | |
| 133 } | |
| 134 } | |
| 5164 | 135 |
| 7336 | 136 if (nargin == 1) |
| 137 { | |
| 138 if (nargout > 0) | |
| 139 { | |
| 140 symbol_table::fcn_info::dispatch_map_type dm | |
| 141 = symbol_table::get_dispatch (f); | |
| 142 | |
| 143 size_t len = dm.size (); | |
| 144 | |
| 145 Cell type_field (len, 1); | |
| 146 Cell name_field (len, 1); | |
| 147 | |
| 148 symbol_table::fcn_info::dispatch_map_type::const_iterator p | |
| 149 = dm.begin (); | |
| 150 | |
| 151 for (size_t i = 0; i < len; i++) | |
| 152 { | |
| 153 type_field(i) = p->first; | |
| 154 name_field(i) = p->second; | |
| 155 | |
| 156 p++; | |
| 157 } | |
| 158 | |
| 159 Octave_map m; | |
| 160 | |
| 161 m.assign ("type", type_field); | |
| 162 m.assign ("name", name_field); | |
| 163 | |
| 164 retval = m; | |
| 165 } | |
| 166 else | |
| 167 symbol_table::print_dispatch (octave_stdout, f); | |
| 168 } | |
| 169 else if (nargin == 2) | |
| 170 { | |
| 171 t = r; | |
| 172 symbol_table::clear_dispatch (f, t); | |
| 173 } | |
| 174 else | |
| 175 symbol_table::add_dispatch (f, t, r); | |
| 5164 | 176 } |
| 7336 | 177 else |
| 178 print_usage (); | |
| 5164 | 179 |
| 180 return retval; | |
| 181 } | |
| 182 | |
| 183 /* | |
| 184 | |
| 185 %!test # builtin function replacement | |
| 186 %! dispatch('sin','length','string') | |
| 5582 | 187 %! assert(sin("abc"),3) |
| 5164 | 188 %! assert(sin(0),0,10*eps); |
| 189 %!test # 'any' function | |
| 190 %! dispatch('sin','exp','any') | |
| 191 %! assert(sin(0),1,eps); | |
| 5582 | 192 %! assert(sin("abc"),3); |
| 5164 | 193 %!test # 'builtin' function |
| 194 %! assert(builtin('sin',0),0,eps); | |
| 195 %! builtin('eval','x=1;'); | |
| 196 %! assert(x,1); | |
| 197 %!test # clear function mapping | |
| 198 %! dispatch('sin','string') | |
| 199 %! dispatch('sin','any') | |
| 200 %! assert(sin(0),0,10*eps); | |
| 201 %!test # oct-file replacement | |
| 202 %! dispatch('fft','length','string') | |
| 203 %! assert(fft([1,1]),[2,0]); | |
| 5582 | 204 %! assert(fft("abc"),3) |
| 5164 | 205 %! dispatch('fft','string'); |
| 206 %!test # m-file replacement | |
| 207 %! dispatch('hamming','length','string') | |
| 208 %! assert(hamming(1),1) | |
| 5582 | 209 %! assert(hamming("abc"),3) |
| 5164 | 210 %! dispatch('hamming','string') |
| 211 | |
| 212 %!test # override preloaded builtin | |
| 213 %! evalin('base','cos(1);'); | |
| 214 %! dispatch('cos','length','string') | |
| 5582 | 215 %! evalin('base','assert(cos("abc"),3)'); |
| 216 %! evalin('base','assert(cos(0),1,eps)'); | |
| 5164 | 217 %! dispatch('cos','string') |
| 218 %!test # override pre-loaded oct-file | |
| 219 %! evalin('base','qr(1);'); | |
| 220 %! dispatch('qr','length','string') | |
| 5582 | 221 %! evalin('base','assert(qr("abc"),3)'); |
| 222 %! evalin('base','assert(qr(1),1)'); | |
| 5164 | 223 %! dispatch('qr','string'); |
| 224 %!test # override pre-loaded m-file | |
| 225 %! evalin('base','hanning(1);'); | |
| 226 %! dispatch('hanning','length','string') | |
| 227 %! evalin('base','assert(hanning("abc"),3)'); | |
| 228 %! evalin('base','assert(hanning(1),1)'); | |
| 229 %! dispatch('hanning','string'); | |
| 230 | |
|
8703
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
231 ## The following tests have been disabled because creating functions |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
232 ## on the fly causes trouble (filesystem timestamp resolution?) and so |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
233 ## leads people to complain about the failed tests when the dispatch |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
234 ## mechanism is working fine, but it is really the creation of the |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
235 ## functions that is failing. And anyway, this method of function |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
236 ## dispatch should be considered obsolete and probably removed from |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
237 ## Octave now that we have classes. |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
238 ## |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
239 ## FIXME I would rather not create dispatch_x/dispatch_y |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
240 ## in the current directory! I don't want them installed accidentally. |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
241 ## |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
242 ## %!function echo_to_file (str, name) |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
243 ## %! fid = fopen (name, 'w'); |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
244 ## %! if (fid != -1) |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
245 ## %! fprintf (fid, str); |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
246 ## %! fprintf (fid, '\n'); |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
247 ## %! fclose (fid); |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
248 ## %! endif |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
249 ## |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
250 ## %!test # replace base m-file |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
251 ## %! echo_to_file ('function a=dispatch_x(a)', "dispatch_x.m"); |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
252 ## %! dispatch('dispatch_x','length','string') |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
253 ## %! assert(dispatch_x(3),3) |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
254 ## %! assert(dispatch_x("a"),1) |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
255 ## %! sleep (2); |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
256 ## %! echo_to_file ('function a=dispatch_x(a),++a;', "dispatch_x.m"); |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
257 ## %! rehash(); |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
258 ## %! assert(dispatch_x(3),4) |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
259 ## %! assert(dispatch_x("a"),1) |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
260 ## %!test |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
261 ## %! unlink("dispatch_x.m"); |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
262 ## |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
263 ## %!test # replace dispatch m-file |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
264 ## %! echo_to_file ('function a=dispatch_y(a)', "dispatch_y.m"); |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
265 ## %! dispatch('hello','dispatch_y','complex scalar') |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
266 ## %! assert(hello(3i),3i) |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
267 ## %! sleep (2); |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
268 ## %! echo_to_file ('function a=dispatch_y(a),++a;', "dispatch_y.m"); |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
269 ## %! rehash(); |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
270 ## %! assert(hello(3i),1+3i) |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
271 ## %!test |
|
c953a6977be6
dispatch.cc: comment out troublesome tests
John W. Eaton <jwe@octave.org>
parents:
7706
diff
changeset
|
272 ## %! unlink("dispatch_y.m"); |
| 5164 | 273 |
| 5775 | 274 FIXME add tests for preservation of mark_as_command status. |
| 5164 | 275 |
| 276 */ |