5164
|
1 /* |
|
2 |
|
3 Copyright (C) 2001 John W. Eaton and Paul Kienzle |
|
4 |
7016
|
5 This file is part of Octave. |
|
6 |
|
7 Octave is free software; you can redistribute it and/or modify it |
5164
|
8 under the terms of the GNU General Public License as published by the |
7016
|
9 Free Software Foundation; either version 3 of the License, or (at your |
|
10 option) any later version. |
5164
|
11 |
7016
|
12 Octave is distributed in the hope that it will be useful, but WITHOUT |
5164
|
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
15 for more details. |
|
16 |
|
17 You should have received a copy of the GNU General Public License |
7016
|
18 along with Octave; see the file COPYING. If not, see |
|
19 <http://www.gnu.org/licenses/>. |
5164
|
20 |
|
21 */ |
|
22 |
|
23 #ifdef HAVE_CONFIG_H |
|
24 #include <config.h> |
|
25 #endif |
|
26 |
|
27 #include <list> |
|
28 #include <map> |
|
29 #include <string> |
|
30 |
|
31 #include "defun-dld.h" |
|
32 #include "ov.h" |
|
33 #include "ov-fcn.h" |
|
34 #include "ov-typeinfo.h" |
|
35 #include "pager.h" |
|
36 #include "parse.h" |
|
37 #include "symtab.h" |
|
38 #include "variables.h" |
|
39 |
5775
|
40 // FIXME should be using a map from type_id->name, rather |
5164
|
41 // than type_name->name |
|
42 |
|
43 template class std::map<std::string,std::string>; |
|
44 |
|
45 typedef std::map<std::string,std::string> Table; |
|
46 |
|
47 class |
|
48 octave_dispatch : public octave_function |
|
49 { |
|
50 public: |
|
51 |
5775
|
52 // FIXME need to handle doc strings of dispatched functions, for |
5164
|
53 // example, by appending "for <f>(<type>,...) see <name>" for each |
|
54 // time dispatch(f,type,name) is called. |
|
55 octave_dispatch (const std::string &nm) |
|
56 : octave_function (nm, "Overloaded function"), tab (), base (nm), |
|
57 has_alias (false) |
|
58 { } |
|
59 |
5775
|
60 // FIXME if we get deleted, we should restore the original |
5164
|
61 // symbol_record from base before dying. |
|
62 ~octave_dispatch (void) { } |
|
63 |
|
64 bool is_builtin_function (void) const { return true; } |
|
65 |
|
66 octave_function *function_value (bool) { return this; } |
|
67 |
5889
|
68 octave_value do_index_op (const octave_value_list&, bool = false) |
5164
|
69 { |
|
70 error ("dispatch: do_index_op"); |
|
71 return octave_value (); |
|
72 } |
|
73 |
|
74 octave_value subsref (const std::string&, |
|
75 const std::list<octave_value_list>&) |
|
76 { |
|
77 error ("dispatch: subsref (str, list)"); |
|
78 panic_impossible (); |
|
79 return octave_value (); |
|
80 } |
|
81 |
|
82 octave_value_list subsref (const std::string& type, |
|
83 const std::list<octave_value_list>& idx, |
|
84 int nargout); |
|
85 |
|
86 octave_value_list do_multi_index_op (int, const octave_value_list&); |
|
87 |
|
88 void add (const std::string t, const std::string n); |
|
89 |
|
90 void clear (const std::string t); |
|
91 |
|
92 void print (std::ostream& os, bool pr_as_read=false) const; |
|
93 |
|
94 private: |
|
95 |
|
96 Table tab; |
|
97 std::string base; |
|
98 bool has_alias; |
|
99 |
|
100 octave_dispatch (void) |
|
101 : octave_function (), tab (), base (), has_alias (false) { } |
|
102 |
|
103 DECLARE_OV_TYPEID_FUNCTIONS_AND_DATA |
|
104 |
|
105 DECLARE_OCTAVE_ALLOCATOR |
|
106 }; |
|
107 |
|
108 DEFINE_OCTAVE_ALLOCATOR (octave_dispatch); |
|
109 |
|
110 DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_dispatch, |
|
111 "overloaded function", "function"); |
|
112 |
|
113 void |
|
114 octave_dispatch::add (const std::string t, const std::string n) |
|
115 { |
|
116 if (tab.count (t) > 0 && tab[t] != n) |
|
117 warning ("replacing %s(%s,...)->%s with %s", |
|
118 base.c_str (), t.c_str (), tab[t].c_str (), n.c_str ()); |
|
119 |
|
120 tab[t] = n; |
|
121 |
|
122 if (t == "any") |
|
123 has_alias = true; |
|
124 } |
|
125 |
|
126 void |
|
127 octave_dispatch::clear (const std::string t) |
|
128 { |
|
129 tab.erase (t); |
|
130 |
|
131 if (t == "any") |
|
132 has_alias = false; |
|
133 } |
|
134 |
|
135 octave_value_list |
|
136 octave_dispatch::subsref (const std::string& type, |
|
137 const std::list<octave_value_list>& idx, |
|
138 int nargout) |
|
139 { |
|
140 octave_value_list retval; |
|
141 |
|
142 switch (type[0]) |
|
143 { |
|
144 case '(': |
|
145 retval = do_multi_index_op (nargout, idx.front ()); |
|
146 break; |
|
147 |
|
148 case '{': |
|
149 case '.': |
|
150 { |
|
151 const std::string nm = type_name (); |
|
152 error ("%s cannot be indexed with %c", nm.c_str (), type[0]); |
|
153 } |
|
154 break; |
|
155 |
|
156 default: |
|
157 panic_impossible (); |
|
158 } |
|
159 |
|
160 if (idx.size () > 1) |
|
161 retval = retval(0).next_subsref (type, idx); |
|
162 |
|
163 return retval; |
|
164 } |
|
165 |
|
166 static octave_function* |
|
167 builtin (const std::string& base) |
|
168 { |
|
169 octave_function *fcn = 0; |
|
170 |
|
171 // Check if we are overriding a builtin function. This is the |
|
172 // case if builtin is protected. |
|
173 symbol_record *builtin = fbi_sym_tab->lookup ("builtin:" + base, 0); |
|
174 |
|
175 if (! builtin) |
|
176 error ("builtin record has gone missing"); |
|
177 |
|
178 if (error_state) |
|
179 return fcn; |
|
180 |
|
181 if (builtin->is_read_only ()) |
|
182 { |
|
183 // builtin is read only, so checking for updates is pointless |
|
184 if (builtin->is_function ()) |
|
185 fcn = builtin->def().function_value (); |
|
186 else |
|
187 error ("builtin %s is not a function", base.c_str ()); |
|
188 } |
|
189 else |
|
190 { |
|
191 // Check that builtin is up to date. |
|
192 |
|
193 // Don't try to fight octave's function name handling |
|
194 // mechanism. Instead, move dispatch record out of the way, |
|
195 // and restore the builtin to its original name. |
|
196 symbol_record *dispatch = fbi_sym_tab->lookup (base, 0); |
|
197 if (! dispatch) |
|
198 error ("dispatch record has gone missing"); |
|
199 |
|
200 dispatch->unprotect (); |
|
201 |
|
202 fbi_sym_tab->rename (base, "dispatch:" + base); |
|
203 |
|
204 fbi_sym_tab->rename ("builtin:" + base, base); |
|
205 |
|
206 // check for updates to builtin function; ignore errors that |
|
207 // appear (they interfere with renaming), and remove the updated |
5775
|
208 // name from the current symbol table. FIXME check that |
5164
|
209 // updating a function updates it in all contexts --- it may be |
|
210 // that it is updated only in the current symbol table, and not |
|
211 // the caller. I believe this won't be a problem because the |
|
212 // caller will go through the same logic and end up with the |
|
213 // newer version. |
|
214 fcn = is_valid_function (base, "dispatch", 1); |
|
215 int cache_error = error_state; |
|
216 error_state = 0; |
|
217 curr_sym_tab->clear_function (base); |
|
218 |
|
219 // Move the builtin function out of the way and restore the |
|
220 // dispatch fuction. |
5775
|
221 // FIXME what if builtin wants to protect itself? |
5399
|
222 symbol_record *found = fbi_sym_tab->lookup (base, 0); |
5164
|
223 bool readonly = found->is_read_only (); |
|
224 found->unprotect (); |
|
225 fbi_sym_tab->rename (base, "builtin:" + base); |
|
226 fbi_sym_tab->rename ("dispatch:" + base, base); |
|
227 if (readonly) |
|
228 found->protect (); |
|
229 dispatch->protect (); |
|
230 |
|
231 // remember if there were any errors. |
|
232 error_state = cache_error; |
|
233 } |
|
234 |
|
235 return fcn; |
|
236 } |
|
237 |
|
238 static bool |
|
239 any_arg_is_magic_colon (const octave_value_list& args) |
|
240 { |
|
241 int nargin = args.length (); |
|
242 |
|
243 for (int i = 0; i < nargin; i++) |
|
244 if (args(i).is_magic_colon ()) |
|
245 return true; |
|
246 |
|
247 return false; |
|
248 } |
|
249 |
|
250 octave_value_list |
|
251 octave_dispatch::do_multi_index_op (int nargout, const octave_value_list& args) |
|
252 { |
|
253 octave_value_list retval; |
|
254 |
|
255 if (error_state) return retval; |
|
256 |
|
257 if (any_arg_is_magic_colon (args)) |
|
258 { |
|
259 ::error ("invalid use of colon in function argument list"); |
|
260 return retval; |
|
261 } |
|
262 |
|
263 // If more than one argument, check if argument template matches any |
|
264 // overloaded functions. Also provide a catch-all '*' type to provide |
|
265 // single level pseudo rename and replace functionality. |
|
266 if (args.length () > 0 && tab.count (args(0).type_name ()) > 0) |
|
267 retval = feval (tab[args(0).type_name()], args, nargout); |
|
268 else if (has_alias) |
|
269 retval = feval (tab["any"], args, nargout); |
|
270 else |
|
271 { |
|
272 octave_function *fcn = builtin (base); |
|
273 if (! error_state && fcn) |
|
274 retval = fcn->do_multi_index_op (nargout, args); |
|
275 } |
|
276 |
|
277 return retval; |
|
278 } |
|
279 |
|
280 void |
|
281 octave_dispatch::print (std::ostream& os, bool) const |
|
282 { |
|
283 os << "Overloaded function " << base << std::endl; |
|
284 |
|
285 for (Table::const_iterator it = tab.begin (); it != tab.end (); it++) |
|
286 os << base << "(" << it->first << ",...)->" |
|
287 << it->second << "(" << it->first << ",...)" |
|
288 << std::endl; |
|
289 } |
|
290 |
|
291 DEFUN_DLD (builtin, args, nargout, |
|
292 "-*- texinfo -*-\n\ |
|
293 @deftypefn {Loadable Function} {[@dots{}]} builtin (@var{f}, @dots{})\n\ |
|
294 Call the base function @var{f} even if @var{f} is overloaded to\n\ |
|
295 some other function for the given type signature.\n\ |
5646
|
296 @seealso{dispatch}\n\ |
|
297 @end deftypefn") |
5164
|
298 { |
|
299 octave_value_list retval; |
|
300 |
|
301 int nargin = args.length (); |
|
302 |
|
303 if (nargin > 0) |
|
304 { |
|
305 const std::string name (args(0).string_value ()); |
|
306 |
|
307 if (error_state) |
|
308 return retval; |
|
309 |
6348
|
310 symbol_record *sr = lookup_by_name (name, 0); |
5200
|
311 |
6348
|
312 if (sr && sr->is_function ()) |
5164
|
313 { |
5200
|
314 if (sr->def().type_id () == octave_dispatch::static_type_id ()) |
|
315 { |
|
316 octave_function *fcn = builtin (name); |
5164
|
317 |
5200
|
318 if (!error_state && fcn) |
6348
|
319 retval = fcn->do_multi_index_op (nargout, args.splice (0, 1)); |
5200
|
320 } |
|
321 else |
6348
|
322 retval = feval (name, args.splice (0, 1), nargout); |
5164
|
323 } |
|
324 else |
5200
|
325 error ("builtin: lookup for symbol `%s' failed", name.c_str ()); |
5164
|
326 } |
|
327 else |
5823
|
328 print_usage (); |
5164
|
329 |
|
330 return retval; |
|
331 } |
|
332 |
|
333 static void |
|
334 dispatch_record (const std::string &f, const std::string &n, |
|
335 const std::string &t) |
|
336 { |
|
337 // find the base function in the symbol table, loading it if it |
|
338 // is not already there; if it is already a dispatch, then bonus |
|
339 |
|
340 symbol_record *sr = fbi_sym_tab->lookup (f, true); |
|
341 |
|
342 if (sr->def().type_id () != octave_dispatch::static_type_id ()) |
|
343 { |
|
344 // Preserve mark_as_command status |
|
345 bool iscommand = sr->is_command (); |
|
346 |
|
347 // Not an overloaded name, so if only display or clear then we are done |
|
348 if (t.empty ()) |
|
349 return; |
|
350 |
|
351 // sr is the base symbol; rename it to keep it safe. When we need |
|
352 // it we will rename it back again. |
|
353 if (sr->is_read_only ()) |
|
354 { |
|
355 sr->unprotect (); |
|
356 fbi_sym_tab->rename (f, "builtin:" + f); |
|
357 sr = fbi_sym_tab->lookup (f, true); |
|
358 sr->protect (); |
|
359 } |
|
360 else |
|
361 fbi_sym_tab->rename (f, "builtin:" + f); |
|
362 |
5399
|
363 // It would be good to hide the builtin:XXX name, but since the |
|
364 // new XXX name in the symbol table is set to BUILTIN_FUNCTION, |
|
365 // things don't work quite the way we would like. |
|
366 // sr->hide (); |
5164
|
367 |
|
368 // Problem: when a function is first called a new record |
|
369 // is created for it in the current symbol table, so calling |
|
370 // dispatch on a function that has already been called, we |
|
371 // should also clear it from all existing symbol tables. |
|
372 // This is too much work, so we will only do it for the |
|
373 // top level symbol table. We can't use the clear_function() |
|
374 // method, because it won't clear builtin functions. Instead |
|
375 // we check if the symbol is a function and clear it then. This |
|
376 // won't properly clear shadowed functions, or functions in |
|
377 // other namespaces (such as the current, if called from a |
|
378 // function). |
|
379 symbol_record *local = top_level_sym_tab->lookup (f, false); |
|
380 if (local && local->is_function ()) |
|
381 local->clear (); |
|
382 |
|
383 // Build a new dispatch object based on the function definition |
|
384 octave_dispatch *dispatch = new octave_dispatch (f); |
|
385 |
|
386 // Create a symbol record for the dispatch object. |
|
387 sr = fbi_sym_tab->lookup (f, true); |
|
388 sr->unprotect (); |
|
389 sr->define (octave_value (dispatch), symbol_record::BUILTIN_FUNCTION); |
|
390 // std::cout << "iscommand('"<<f<<"')=" << iscommand << std::endl; |
|
391 if (iscommand) |
|
392 sr->mark_as_command(); |
5399
|
393 sr->document ("\n\n@noindent\nOverloaded function:\n"); |
5775
|
394 sr->make_eternal (); // FIXME why?? |
5164
|
395 sr->mark_as_static (); |
|
396 sr->protect (); |
|
397 } |
|
398 |
|
399 // clear/replace/extend the map with the new type-function pair |
|
400 const octave_dispatch& rep |
5760
|
401 = dynamic_cast<const octave_dispatch&> (sr->def().get_rep ()); |
5164
|
402 |
|
403 if (t.empty ()) |
5775
|
404 // FIXME should return the list if nargout > 1 |
5164
|
405 rep.print (octave_stdout); |
|
406 else if (n.empty ()) |
|
407 { |
5775
|
408 // FIXME should we eliminate the dispatch function if |
5164
|
409 // there are no more elements? |
5775
|
410 // FIXME should clear the " $t:\w+" from the help string. |
|
411 // FIXME -- seems bad to cast away const here... |
5164
|
412 octave_dispatch& xrep = const_cast<octave_dispatch&> (rep); |
|
413 |
|
414 xrep.clear (t); |
|
415 } |
|
416 else |
|
417 { |
5775
|
418 // FIXME -- seems bad to cast away const here... |
5164
|
419 octave_dispatch& xrep = const_cast<octave_dispatch&> (rep); |
|
420 |
|
421 xrep.add (t, n); |
|
422 |
|
423 if (! sr->help().empty ()) |
5300
|
424 sr->document (sr->help() + "\n" + n + " (" + t + ", ...)\n"); |
5164
|
425 } |
|
426 } |
|
427 |
|
428 DEFUN_DLD (dispatch, args, , |
|
429 "-*- texinfo -*-\n\ |
|
430 @deftypefn {Loadable Function} {} dispatch (@var{f}, @var{r}, @var{type})\n\ |
|
431 \n\ |
|
432 Replace the function @var{f} with a dispatch so that function @var{r}\n\ |
|
433 is called when @var{f} is called with the first argument of the named\n\ |
|
434 @var{type}. If the type is @var{any} then call @var{r} if no other type\n\ |
|
435 matches. The original function @var{f} is accessible using\n\ |
6248
|
436 @code{builtin (@var{f}, @dots{})}.\n\ |
5164
|
437 \n\ |
|
438 If @var{r} is omitted, clear dispatch function associated with @var{type}.\n\ |
|
439 \n\ |
|
440 If both @var{r} and @var{type} are omitted, list dispatch functions\n\ |
5646
|
441 for @var{f}.\n\ |
|
442 @seealso{builtin}\n\ |
|
443 @end deftypefn") |
5164
|
444 { |
|
445 octave_value retval; |
|
446 int nargin = args.length (); |
|
447 |
|
448 if (nargin < 1 || nargin > 3) |
|
449 { |
5823
|
450 print_usage (); |
5164
|
451 return retval; |
|
452 } |
|
453 |
|
454 std::string f, t, n; |
|
455 if (nargin > 0) |
|
456 f = args(0).string_value (); |
|
457 |
|
458 if (nargin == 2) |
|
459 t = args(1).string_value (); |
|
460 else if (nargin > 2) |
|
461 { |
|
462 n = args(1).string_value (); |
|
463 t = args(2).string_value (); |
|
464 } |
|
465 |
|
466 if (error_state) |
|
467 return retval; |
|
468 |
|
469 static bool register_type = true; |
|
470 |
|
471 // register dispatch function type if you have not already done so |
|
472 if (register_type) |
|
473 { |
|
474 octave_dispatch::register_type (); |
|
475 register_type = false; |
|
476 fbi_sym_tab->lookup("dispatch")->mark_as_static (); |
|
477 } |
|
478 |
|
479 dispatch_record (f, n, t); |
|
480 |
|
481 return retval; |
|
482 } |
|
483 |
|
484 /* |
|
485 |
|
486 %!test # builtin function replacement |
|
487 %! dispatch('sin','length','string') |
5582
|
488 %! assert(sin("abc"),3) |
5164
|
489 %! assert(sin(0),0,10*eps); |
|
490 %!test # 'any' function |
|
491 %! dispatch('sin','exp','any') |
|
492 %! assert(sin(0),1,eps); |
5582
|
493 %! assert(sin("abc"),3); |
5164
|
494 %!test # 'builtin' function |
|
495 %! assert(builtin('sin',0),0,eps); |
|
496 %! builtin('eval','x=1;'); |
|
497 %! assert(x,1); |
|
498 %!test # clear function mapping |
|
499 %! dispatch('sin','string') |
|
500 %! dispatch('sin','any') |
|
501 %! assert(sin(0),0,10*eps); |
|
502 %!test # oct-file replacement |
|
503 %! dispatch('fft','length','string') |
|
504 %! assert(fft([1,1]),[2,0]); |
5582
|
505 %! assert(fft("abc"),3) |
5164
|
506 %! dispatch('fft','string'); |
|
507 %!test # m-file replacement |
|
508 %! dispatch('hamming','length','string') |
|
509 %! assert(hamming(1),1) |
5582
|
510 %! assert(hamming("abc"),3) |
5164
|
511 %! dispatch('hamming','string') |
|
512 |
|
513 %!test # override preloaded builtin |
|
514 %! evalin('base','cos(1);'); |
|
515 %! dispatch('cos','length','string') |
5582
|
516 %! evalin('base','assert(cos("abc"),3)'); |
|
517 %! evalin('base','assert(cos(0),1,eps)'); |
5164
|
518 %! dispatch('cos','string') |
|
519 %!test # override pre-loaded oct-file |
|
520 %! evalin('base','qr(1);'); |
|
521 %! dispatch('qr','length','string') |
5582
|
522 %! evalin('base','assert(qr("abc"),3)'); |
|
523 %! evalin('base','assert(qr(1),1)'); |
5164
|
524 %! dispatch('qr','string'); |
|
525 %!test # override pre-loaded m-file |
|
526 %! evalin('base','hanning(1);'); |
|
527 %! dispatch('hanning','length','string') |
|
528 %! evalin('base','assert(hanning("abc"),3)'); |
|
529 %! evalin('base','assert(hanning(1),1)'); |
|
530 %! dispatch('hanning','string'); |
|
531 |
5775
|
532 FIXME I would rather not create dispatch_x/dispatch_y |
5164
|
533 in the current directory! I don't want them installed accidentally. |
|
534 |
|
535 %!test # replace base m-file |
|
536 %! system("echo 'function a=dispatch_x(a)'>dispatch_x.m"); |
|
537 %! dispatch('dispatch_x','length','string') |
|
538 %! assert(dispatch_x(3),3) |
5582
|
539 %! assert(dispatch_x("a"),1) |
5832
|
540 %! sleep (2); |
5164
|
541 %! system("echo 'function a=dispatch_x(a),++a;'>dispatch_x.m"); |
5832
|
542 %! rehash(); |
5164
|
543 %! assert(dispatch_x(3),4) |
5582
|
544 %! assert(dispatch_x("a"),1) |
5164
|
545 %!test |
5832
|
546 %! unlink("dispatch_x.m"); |
5164
|
547 |
|
548 %!test # replace dispatch m-file |
|
549 %! system("echo 'function a=dispatch_y(a)'>dispatch_y.m"); |
|
550 %! dispatch('hello','dispatch_y','complex scalar') |
|
551 %! assert(hello(3i),3i) |
5832
|
552 %! sleep (2); |
5164
|
553 %! system("echo 'function a=dispatch_y(a),++a;'>dispatch_y.m"); |
5832
|
554 %! rehash(); |
5164
|
555 %! assert(hello(3i),1+3i) |
|
556 %!test |
5832
|
557 %! unlink("dispatch_y.m"); |
5164
|
558 |
5775
|
559 FIXME add tests for preservation of mark_as_command status. |
5164
|
560 |
|
561 */ |