1 /* GDB/Scheme pretty-printing.
3 Copyright (C) 2008-2019 Free Software Foundation, Inc.
5 This file is part of GDB.
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 3 of the License, or
10 (at your option) any later version.
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>. */
20 /* See README file in this directory for implementation notes, coding
21 conventions, et.al. */
25 #include "symtab.h" /* Needed by language.h. */
30 #include "guile-internal.h"
32 /* Return type of print_string_repr. */
34 enum string_repr_result
36 /* The string method returned None. */
38 /* The string method had an error. */
48 /* No display hint. */
50 /* The display hint has a bad value. */
52 /* Print as an array. */
56 /* Print as a string. */
60 /* The <gdb:pretty-printer> smob. */
64 /* This must appear first. */
67 /* A string representing the name of the printer. */
70 /* A boolean indicating whether the printer is enabled. */
73 /* A procedure called to look up the printer for the given value.
74 The procedure is called as (lookup gdb:pretty-printer value).
75 The result should either be a gdb:pretty-printer object that will print
76 the value, or #f if the value is not recognized. */
79 /* Note: Attaching subprinters to this smob is left to Scheme. */
80 } pretty_printer_smob;
82 /* The <gdb:pretty-printer-worker> smob. */
86 /* This must appear first. */
89 /* Either #f or one of the supported display hints: map, array, string.
90 If neither of those then the display hint is ignored (treated as #f). */
93 /* A procedure called to pretty-print the value.
94 (lambda (printer) ...) -> string | <gdb:lazy-string> | <gdb:value> */
97 /* A procedure called to print children of the value.
98 (lambda (printer) ...) -> <gdb:iterator>
99 The iterator returns a pair for each iteration: (name . value),
100 where "value" can have the same types as to_string. */
102 } pretty_printer_worker_smob;
104 static const char pretty_printer_smob_name[] =
105 "gdb:pretty-printer";
106 static const char pretty_printer_worker_smob_name[] =
107 "gdb:pretty-printer-worker";
109 /* The tag Guile knows the pretty-printer smobs by. */
110 static scm_t_bits pretty_printer_smob_tag;
111 static scm_t_bits pretty_printer_worker_smob_tag;
113 /* The global pretty-printer list. */
114 static SCM pretty_printer_list;
116 /* gdb:pp-type-error. */
117 static SCM pp_type_error_symbol;
119 /* Pretty-printer display hints are specified by strings. */
120 static SCM ppscm_map_string;
121 static SCM ppscm_array_string;
122 static SCM ppscm_string_string;
124 /* Administrivia for pretty-printer matcher smobs. */
126 /* The smob "print" function for <gdb:pretty-printer>. */
129 ppscm_print_pretty_printer_smob (SCM self, SCM port, scm_print_state *pstate)
131 pretty_printer_smob *pp_smob = (pretty_printer_smob *) SCM_SMOB_DATA (self);
133 gdbscm_printf (port, "#<%s ", pretty_printer_smob_name);
134 scm_write (pp_smob->name, port);
135 scm_puts (gdbscm_is_true (pp_smob->enabled) ? " enabled" : " disabled",
137 scm_puts (">", port);
139 scm_remember_upto_here_1 (self);
141 /* Non-zero means success. */
145 /* (make-pretty-printer string procedure) -> <gdb:pretty-printer> */
148 gdbscm_make_pretty_printer (SCM name, SCM lookup)
150 pretty_printer_smob *pp_smob = (pretty_printer_smob *)
151 scm_gc_malloc (sizeof (pretty_printer_smob),
152 pretty_printer_smob_name);
155 SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG1, FUNC_NAME,
157 SCM_ASSERT_TYPE (gdbscm_is_procedure (lookup), lookup, SCM_ARG2, FUNC_NAME,
160 pp_smob->name = name;
161 pp_smob->lookup = lookup;
162 pp_smob->enabled = SCM_BOOL_T;
163 smob = scm_new_smob (pretty_printer_smob_tag, (scm_t_bits) pp_smob);
164 gdbscm_init_gsmob (&pp_smob->base);
169 /* Return non-zero if SCM is a <gdb:pretty-printer> object. */
172 ppscm_is_pretty_printer (SCM scm)
174 return SCM_SMOB_PREDICATE (pretty_printer_smob_tag, scm);
177 /* (pretty-printer? object) -> boolean */
180 gdbscm_pretty_printer_p (SCM scm)
182 return scm_from_bool (ppscm_is_pretty_printer (scm));
185 /* Returns the <gdb:pretty-printer> object in SELF.
186 Throws an exception if SELF is not a <gdb:pretty-printer> object. */
189 ppscm_get_pretty_printer_arg_unsafe (SCM self, int arg_pos,
190 const char *func_name)
192 SCM_ASSERT_TYPE (ppscm_is_pretty_printer (self), self, arg_pos, func_name,
193 pretty_printer_smob_name);
198 /* Returns a pointer to the pretty-printer smob of SELF.
199 Throws an exception if SELF is not a <gdb:pretty-printer> object. */
201 static pretty_printer_smob *
202 ppscm_get_pretty_printer_smob_arg_unsafe (SCM self, int arg_pos,
203 const char *func_name)
205 SCM pp_scm = ppscm_get_pretty_printer_arg_unsafe (self, arg_pos, func_name);
206 pretty_printer_smob *pp_smob
207 = (pretty_printer_smob *) SCM_SMOB_DATA (pp_scm);
212 /* Pretty-printer methods. */
214 /* (pretty-printer-enabled? <gdb:pretty-printer>) -> boolean */
217 gdbscm_pretty_printer_enabled_p (SCM self)
219 pretty_printer_smob *pp_smob
220 = ppscm_get_pretty_printer_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
222 return pp_smob->enabled;
225 /* (set-pretty-printer-enabled! <gdb:pretty-printer> boolean)
229 gdbscm_set_pretty_printer_enabled_x (SCM self, SCM enabled)
231 pretty_printer_smob *pp_smob
232 = ppscm_get_pretty_printer_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
234 pp_smob->enabled = scm_from_bool (gdbscm_is_true (enabled));
236 return SCM_UNSPECIFIED;
239 /* (pretty-printers) -> list
240 Returns the list of global pretty-printers. */
243 gdbscm_pretty_printers (void)
245 return pretty_printer_list;
248 /* (set-pretty-printers! list) -> unspecified
249 Set the global pretty-printers list. */
252 gdbscm_set_pretty_printers_x (SCM printers)
254 SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (printers)), printers,
255 SCM_ARG1, FUNC_NAME, _("list"));
257 pretty_printer_list = printers;
259 return SCM_UNSPECIFIED;
262 /* Administrivia for pretty-printer-worker smobs.
263 These are created when a matcher recognizes a value. */
265 /* The smob "print" function for <gdb:pretty-printer-worker>. */
268 ppscm_print_pretty_printer_worker_smob (SCM self, SCM port,
269 scm_print_state *pstate)
271 pretty_printer_worker_smob *w_smob
272 = (pretty_printer_worker_smob *) SCM_SMOB_DATA (self);
274 gdbscm_printf (port, "#<%s ", pretty_printer_worker_smob_name);
275 scm_write (w_smob->display_hint, port);
276 scm_puts (" ", port);
277 scm_write (w_smob->to_string, port);
278 scm_puts (" ", port);
279 scm_write (w_smob->children, port);
280 scm_puts (">", port);
282 scm_remember_upto_here_1 (self);
284 /* Non-zero means success. */
288 /* (make-pretty-printer-worker string procedure procedure)
289 -> <gdb:pretty-printer-worker> */
292 gdbscm_make_pretty_printer_worker (SCM display_hint, SCM to_string,
295 pretty_printer_worker_smob *w_smob = (pretty_printer_worker_smob *)
296 scm_gc_malloc (sizeof (pretty_printer_worker_smob),
297 pretty_printer_worker_smob_name);
300 w_smob->display_hint = display_hint;
301 w_smob->to_string = to_string;
302 w_smob->children = children;
303 w_scm = scm_new_smob (pretty_printer_worker_smob_tag, (scm_t_bits) w_smob);
304 gdbscm_init_gsmob (&w_smob->base);
308 /* Return non-zero if SCM is a <gdb:pretty-printer-worker> object. */
311 ppscm_is_pretty_printer_worker (SCM scm)
313 return SCM_SMOB_PREDICATE (pretty_printer_worker_smob_tag, scm);
316 /* (pretty-printer-worker? object) -> boolean */
319 gdbscm_pretty_printer_worker_p (SCM scm)
321 return scm_from_bool (ppscm_is_pretty_printer_worker (scm));
324 /* Helper function to create a <gdb:exception> object indicating that the
325 type of some value returned from a pretty-printer is invalid. */
328 ppscm_make_pp_type_error_exception (const char *message, SCM object)
330 std::string msg = string_printf ("%s: ~S", message);
331 return gdbscm_make_error (pp_type_error_symbol,
332 NULL /* func */, msg.c_str (),
333 scm_list_1 (object), scm_list_1 (object));
336 /* Print MESSAGE as an exception (meaning it is controlled by
337 "guile print-stack").
338 Called from the printer code when the Scheme code returns an invalid type
342 ppscm_print_pp_type_error (const char *message, SCM object)
344 SCM exception = ppscm_make_pp_type_error_exception (message, object);
346 gdbscm_print_gdb_exception (SCM_BOOL_F, exception);
349 /* Helper function for find_pretty_printer which iterates over a list,
350 calls each function and inspects output. This will return a
351 <gdb:pretty-printer> object if one recognizes VALUE. If no printer is
352 found, it will return #f. On error, it will return a <gdb:exception>
355 Note: This has to be efficient and careful.
356 We don't want to excessively slow down printing of values, but any kind of
357 random crud can appear in the pretty-printer list, and we can't crash
361 ppscm_search_pp_list (SCM list, SCM value)
363 SCM orig_list = list;
365 if (scm_is_null (list))
367 if (gdbscm_is_false (scm_list_p (list))) /* scm_is_pair? */
369 return ppscm_make_pp_type_error_exception
370 (_("pretty-printer list is not a list"), list);
373 for ( ; scm_is_pair (list); list = scm_cdr (list))
375 SCM matcher = scm_car (list);
377 pretty_printer_smob *pp_smob;
379 if (!ppscm_is_pretty_printer (matcher))
381 return ppscm_make_pp_type_error_exception
382 (_("pretty-printer list contains non-pretty-printer object"),
386 pp_smob = (pretty_printer_smob *) SCM_SMOB_DATA (matcher);
388 /* Skip if disabled. */
389 if (gdbscm_is_false (pp_smob->enabled))
392 if (!gdbscm_is_procedure (pp_smob->lookup))
394 return ppscm_make_pp_type_error_exception
395 (_("invalid lookup object in pretty-printer matcher"),
399 worker = gdbscm_safe_call_2 (pp_smob->lookup, matcher,
400 value, gdbscm_memory_error_p);
401 if (!gdbscm_is_false (worker))
403 if (gdbscm_is_exception (worker))
405 if (ppscm_is_pretty_printer_worker (worker))
407 return ppscm_make_pp_type_error_exception
408 (_("invalid result from pretty-printer lookup"), worker);
412 if (!scm_is_null (list))
414 return ppscm_make_pp_type_error_exception
415 (_("pretty-printer list is not a list"), orig_list);
421 /* Subroutine of find_pretty_printer to simplify it.
422 Look for a pretty-printer to print VALUE in all objfiles.
423 If there's an error an exception smob is returned.
424 The result is #f, if no pretty-printer was found.
425 Otherwise the result is the pretty-printer smob. */
428 ppscm_find_pretty_printer_from_objfiles (SCM value)
430 for (objfile *objfile : current_program_space->objfiles ())
432 objfile_smob *o_smob = ofscm_objfile_smob_from_objfile (objfile);
434 = ppscm_search_pp_list (ofscm_objfile_smob_pretty_printers (o_smob),
437 /* Note: This will return if pp is a <gdb:exception> object,
438 which is what we want. */
439 if (gdbscm_is_true (pp))
446 /* Subroutine of find_pretty_printer to simplify it.
447 Look for a pretty-printer to print VALUE in the current program space.
448 If there's an error an exception smob is returned.
449 The result is #f, if no pretty-printer was found.
450 Otherwise the result is the pretty-printer smob. */
453 ppscm_find_pretty_printer_from_progspace (SCM value)
455 pspace_smob *p_smob = psscm_pspace_smob_from_pspace (current_program_space);
457 = ppscm_search_pp_list (psscm_pspace_smob_pretty_printers (p_smob), value);
462 /* Subroutine of find_pretty_printer to simplify it.
463 Look for a pretty-printer to print VALUE in the gdb module.
464 If there's an error a Scheme exception is returned.
465 The result is #f, if no pretty-printer was found.
466 Otherwise the result is the pretty-printer smob. */
469 ppscm_find_pretty_printer_from_gdb (SCM value)
471 SCM pp = ppscm_search_pp_list (pretty_printer_list, value);
476 /* Find the pretty-printing constructor function for VALUE. If no
477 pretty-printer exists, return #f. If one exists, return the
478 gdb:pretty-printer smob that implements it. On error, an exception smob
481 Note: In the end it may be better to call out to Scheme once, and then
482 do all of the lookup from Scheme. TBD. */
485 ppscm_find_pretty_printer (SCM value)
489 /* Look at the pretty-printer list for each objfile
490 in the current program-space. */
491 pp = ppscm_find_pretty_printer_from_objfiles (value);
492 /* Note: This will return if function is a <gdb:exception> object,
493 which is what we want. */
494 if (gdbscm_is_true (pp))
497 /* Look at the pretty-printer list for the current program-space. */
498 pp = ppscm_find_pretty_printer_from_progspace (value);
499 /* Note: This will return if function is a <gdb:exception> object,
500 which is what we want. */
501 if (gdbscm_is_true (pp))
504 /* Look at the pretty-printer list in the gdb module. */
505 pp = ppscm_find_pretty_printer_from_gdb (value);
509 /* Pretty-print a single value, via the PRINTER, which must be a
510 <gdb:pretty-printer-worker> object.
511 The caller is responsible for ensuring PRINTER is valid.
512 If the function returns a string, an SCM containing the string
513 is returned. If the function returns #f that means the pretty
514 printer returned #f as a value. Otherwise, if the function returns a
515 <gdb:value> object, *OUT_VALUE is set to the value and #t is returned.
516 It is an error if the printer returns #t.
517 On error, an exception smob is returned. */
520 ppscm_pretty_print_one_value (SCM printer, struct value **out_value,
521 struct gdbarch *gdbarch,
522 const struct language_defn *language)
524 SCM result = SCM_BOOL_F;
529 pretty_printer_worker_smob *w_smob
530 = (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer);
532 result = gdbscm_safe_call_1 (w_smob->to_string, printer,
533 gdbscm_memory_error_p);
534 if (gdbscm_is_false (result))
536 else if (scm_is_string (result)
537 || lsscm_is_lazy_string (result))
539 else if (vlscm_is_value (result))
544 = vlscm_convert_value_from_scheme (FUNC_NAME, GDBSCM_ARG_NONE,
547 if (*out_value != NULL)
552 else if (gdbscm_is_exception (result))
556 /* Invalid result from to-string. */
557 result = ppscm_make_pp_type_error_exception
558 (_("invalid result from pretty-printer to-string"), result);
561 CATCH (except, RETURN_MASK_ALL)
569 /* Return the display hint for PRINTER as a Scheme object.
570 The caller is responsible for ensuring PRINTER is a
571 <gdb:pretty-printer-worker> object. */
574 ppscm_get_display_hint_scm (SCM printer)
576 pretty_printer_worker_smob *w_smob
577 = (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer);
579 return w_smob->display_hint;
582 /* Return the display hint for the pretty-printer PRINTER.
583 The caller is responsible for ensuring PRINTER is a
584 <gdb:pretty-printer-worker> object.
585 Returns the display hint or #f if the hint is not a string. */
587 static enum display_hint
588 ppscm_get_display_hint_enum (SCM printer)
590 SCM hint = ppscm_get_display_hint_scm (printer);
592 if (gdbscm_is_false (hint))
594 if (scm_is_string (hint))
596 if (gdbscm_is_true (scm_string_equal_p (hint, ppscm_array_string)))
598 if (gdbscm_is_true (scm_string_equal_p (hint, ppscm_map_string)))
600 if (gdbscm_is_true (scm_string_equal_p (hint, ppscm_string_string)))
607 /* A wrapper for gdbscm_print_gdb_exception that ignores memory errors.
608 EXCEPTION is a <gdb:exception> object. */
611 ppscm_print_exception_unless_memory_error (SCM exception,
612 struct ui_file *stream)
614 if (gdbscm_memory_error_p (gdbscm_exception_key (exception)))
616 gdb::unique_xmalloc_ptr<char> msg
617 = gdbscm_exception_message_to_string (exception);
619 /* This "shouldn't happen", but play it safe. */
620 if (msg == NULL || msg.get ()[0] == '\0')
621 fprintf_filtered (stream, _("<error reading variable>"));
624 /* Remove the trailing newline. We could instead call a special
625 routine for printing memory error messages, but this is easy
627 char *msg_text = msg.get ();
628 size_t len = strlen (msg_text);
630 if (msg_text[len - 1] == '\n')
631 msg_text[len - 1] = '\0';
632 fprintf_filtered (stream, _("<error reading variable: %s>"), msg_text);
636 gdbscm_print_gdb_exception (SCM_BOOL_F, exception);
639 /* Helper for gdbscm_apply_val_pretty_printer which calls to_string and
640 formats the result. */
642 static enum string_repr_result
643 ppscm_print_string_repr (SCM printer, enum display_hint hint,
644 struct ui_file *stream, int recurse,
645 const struct value_print_options *options,
646 struct gdbarch *gdbarch,
647 const struct language_defn *language)
649 struct value *replacement = NULL;
651 enum string_repr_result result = STRING_REPR_ERROR;
653 str_scm = ppscm_pretty_print_one_value (printer, &replacement,
655 if (gdbscm_is_false (str_scm))
657 result = STRING_REPR_NONE;
659 else if (scm_is_eq (str_scm, SCM_BOOL_T))
661 struct value_print_options opts = *options;
663 gdb_assert (replacement != NULL);
664 opts.addressprint = 0;
665 common_val_print (replacement, stream, recurse, &opts, language);
666 result = STRING_REPR_OK;
668 else if (scm_is_string (str_scm))
671 gdb::unique_xmalloc_ptr<char> string
672 = gdbscm_scm_to_string (str_scm, &length,
673 target_charset (gdbarch), 0 /*!strict*/, NULL);
675 if (hint == HINT_STRING)
677 struct type *type = builtin_type (gdbarch)->builtin_char;
679 LA_PRINT_STRING (stream, type, (gdb_byte *) string.get (),
680 length, NULL, 0, options);
684 /* Alas scm_to_stringn doesn't nul-terminate the string if we
685 ask for the length. */
688 for (i = 0; i < length; ++i)
690 if (string.get ()[i] == '\0')
691 fputs_filtered ("\\000", stream);
693 fputc_filtered (string.get ()[i], stream);
696 result = STRING_REPR_OK;
698 else if (lsscm_is_lazy_string (str_scm))
700 struct value_print_options local_opts = *options;
702 local_opts.addressprint = 0;
703 lsscm_val_print_lazy_string (str_scm, stream, &local_opts);
704 result = STRING_REPR_OK;
708 gdb_assert (gdbscm_is_exception (str_scm));
709 ppscm_print_exception_unless_memory_error (str_scm, stream);
710 result = STRING_REPR_ERROR;
716 /* Helper for gdbscm_apply_val_pretty_printer that formats children of the
717 printer, if any exist.
718 The caller is responsible for ensuring PRINTER is a printer smob.
719 If PRINTED_NOTHING is true, then nothing has been printed by to_string,
720 and format output accordingly. */
723 ppscm_print_children (SCM printer, enum display_hint hint,
724 struct ui_file *stream, int recurse,
725 const struct value_print_options *options,
726 struct gdbarch *gdbarch,
727 const struct language_defn *language,
730 pretty_printer_worker_smob *w_smob
731 = (pretty_printer_worker_smob *) SCM_SMOB_DATA (printer);
732 int is_map, is_array, done_flag, pretty;
735 SCM iter = SCM_BOOL_F; /* -Wall */
737 if (gdbscm_is_false (w_smob->children))
739 if (!gdbscm_is_procedure (w_smob->children))
741 ppscm_print_pp_type_error
742 (_("pretty-printer \"children\" object is not a procedure or #f"),
747 /* If we are printing a map or an array, we want special formatting. */
748 is_map = hint == HINT_MAP;
749 is_array = hint == HINT_ARRAY;
751 children = gdbscm_safe_call_1 (w_smob->children, printer,
752 gdbscm_memory_error_p);
753 if (gdbscm_is_exception (children))
755 ppscm_print_exception_unless_memory_error (children, stream);
758 /* We combine two steps here: get children, make an iterator out of them.
759 This simplifies things because there's no language means of creating
760 iterators, and it's the printer object that knows how it will want its
761 children iterated over. */
762 if (!itscm_is_iterator (children))
764 ppscm_print_pp_type_error
765 (_("result of pretty-printer \"children\" procedure is not"
766 " a <gdb:iterator> object"), children);
771 /* Use the prettyformat_arrays option if we are printing an array,
772 and the pretty option otherwise. */
774 pretty = options->prettyformat_arrays;
777 if (options->prettyformat == Val_prettyformat)
780 pretty = options->prettyformat_structs;
784 for (i = 0; i < options->print_max; ++i)
787 SCM item = itscm_safe_call_next_x (iter, gdbscm_memory_error_p);
789 if (gdbscm_is_exception (item))
791 ppscm_print_exception_unless_memory_error (item, stream);
794 if (itscm_is_end_of_iteration (item))
796 /* Set a flag so we can know whether we printed all the
797 available elements. */
802 if (! scm_is_pair (item))
804 ppscm_print_pp_type_error
805 (_("result of pretty-printer children iterator is not a pair"
806 " or (end-of-iteration)"),
810 scm_name = scm_car (item);
811 v_scm = scm_cdr (item);
812 if (!scm_is_string (scm_name))
814 ppscm_print_pp_type_error
815 (_("first element of pretty-printer children iterator is not"
819 gdb::unique_xmalloc_ptr<char> name
820 = gdbscm_scm_to_c_string (scm_name);
822 /* Print initial "{". For other elements, there are three cases:
823 1. Maps. Print a "," after each value element.
824 2. Arrays. Always print a ",".
825 3. Other. Always print a ",". */
829 fputs_filtered ("{", stream);
831 fputs_filtered (" = {", stream);
834 else if (! is_map || i % 2 == 0)
835 fputs_filtered (pretty ? "," : ", ", stream);
837 /* In summary mode, we just want to print "= {...}" if there is
839 if (options->summary)
841 /* This increment tricks the post-loop logic to print what
849 if (! is_map || i % 2 == 0)
853 fputs_filtered ("\n", stream);
854 print_spaces_filtered (2 + 2 * recurse, stream);
857 wrap_here (n_spaces (2 + 2 *recurse));
860 if (is_map && i % 2 == 0)
861 fputs_filtered ("[", stream);
864 /* We print the index, not whatever the child method
865 returned as the name. */
866 if (options->print_array_indexes)
867 fprintf_filtered (stream, "[%d] = ", i);
871 fputs_filtered (name.get (), stream);
872 fputs_filtered (" = ", stream);
875 if (lsscm_is_lazy_string (v_scm))
877 struct value_print_options local_opts = *options;
879 local_opts.addressprint = 0;
880 lsscm_val_print_lazy_string (v_scm, stream, &local_opts);
882 else if (scm_is_string (v_scm))
884 gdb::unique_xmalloc_ptr<char> output
885 = gdbscm_scm_to_c_string (v_scm);
886 fputs_filtered (output.get (), stream);
892 = vlscm_convert_value_from_scheme (FUNC_NAME, GDBSCM_ARG_NONE,
898 ppscm_print_exception_unless_memory_error (except_scm, stream);
901 common_val_print (value, stream, recurse + 1, options, language);
904 if (is_map && i % 2 == 0)
905 fputs_filtered ("] = ", stream);
914 fputs_filtered ("\n", stream);
915 print_spaces_filtered (2 + 2 * recurse, stream);
917 fputs_filtered ("...", stream);
921 fputs_filtered ("\n", stream);
922 print_spaces_filtered (2 * recurse, stream);
924 fputs_filtered ("}", stream);
928 /* Play it safe, make sure ITER doesn't get GC'd. */
929 scm_remember_upto_here_1 (iter);
932 /* This is the extension_language_ops.apply_val_pretty_printer "method". */
935 gdbscm_apply_val_pretty_printer (const struct extension_language_defn *extlang,
937 LONGEST embedded_offset, CORE_ADDR address,
938 struct ui_file *stream, int recurse,
940 const struct value_print_options *options,
941 const struct language_defn *language)
943 struct gdbarch *gdbarch = get_type_arch (type);
944 SCM exception = SCM_BOOL_F;
945 SCM printer = SCM_BOOL_F;
946 SCM val_obj = SCM_BOOL_F;
948 enum display_hint hint;
949 enum ext_lang_rc result = EXT_LANG_RC_NOP;
950 enum string_repr_result print_result;
952 if (value_lazy (val))
953 value_fetch_lazy (val);
955 /* No pretty-printer support for unavailable values. */
956 if (!value_bytes_available (val, embedded_offset, TYPE_LENGTH (type)))
957 return EXT_LANG_RC_NOP;
959 if (!gdb_scheme_initialized)
960 return EXT_LANG_RC_NOP;
962 /* Instantiate the printer. */
963 value = value_from_component (val, type, embedded_offset);
965 val_obj = vlscm_scm_from_value (value);
966 if (gdbscm_is_exception (val_obj))
969 result = EXT_LANG_RC_ERROR;
973 printer = ppscm_find_pretty_printer (val_obj);
975 if (gdbscm_is_exception (printer))
978 result = EXT_LANG_RC_ERROR;
981 if (gdbscm_is_false (printer))
983 result = EXT_LANG_RC_NOP;
986 gdb_assert (ppscm_is_pretty_printer_worker (printer));
988 /* If we are printing a map, we want some special formatting. */
989 hint = ppscm_get_display_hint_enum (printer);
990 if (hint == HINT_ERROR)
992 /* Print the error as an exception for consistency. */
993 SCM hint_scm = ppscm_get_display_hint_scm (printer);
995 ppscm_print_pp_type_error ("Invalid display hint", hint_scm);
996 /* Fall through. A bad hint doesn't stop pretty-printing. */
1000 /* Print the section. */
1001 print_result = ppscm_print_string_repr (printer, hint, stream, recurse,
1002 options, gdbarch, language);
1003 if (print_result != STRING_REPR_ERROR)
1005 ppscm_print_children (printer, hint, stream, recurse, options,
1007 print_result == STRING_REPR_NONE);
1010 result = EXT_LANG_RC_OK;
1013 if (gdbscm_is_exception (exception))
1014 ppscm_print_exception_unless_memory_error (exception, stream);
1018 /* Initialize the Scheme pretty-printer code. */
1020 static const scheme_function pretty_printer_functions[] =
1022 { "make-pretty-printer", 2, 0, 0,
1023 as_a_scm_t_subr (gdbscm_make_pretty_printer),
1025 Create a <gdb:pretty-printer> object.\n\
1027 Arguments: name lookup\n\
1028 name: a string naming the matcher\n\
1029 lookup: a procedure:\n\
1030 (pretty-printer <gdb:value>) -> <gdb:pretty-printer-worker> | #f." },
1032 { "pretty-printer?", 1, 0, 0, as_a_scm_t_subr (gdbscm_pretty_printer_p),
1034 Return #t if the object is a <gdb:pretty-printer> object." },
1036 { "pretty-printer-enabled?", 1, 0, 0,
1037 as_a_scm_t_subr (gdbscm_pretty_printer_enabled_p),
1039 Return #t if the pretty-printer is enabled." },
1041 { "set-pretty-printer-enabled!", 2, 0, 0,
1042 as_a_scm_t_subr (gdbscm_set_pretty_printer_enabled_x),
1044 Set the enabled flag of the pretty-printer.\n\
1045 Returns \"unspecified\"." },
1047 { "make-pretty-printer-worker", 3, 0, 0,
1048 as_a_scm_t_subr (gdbscm_make_pretty_printer_worker),
1050 Create a <gdb:pretty-printer-worker> object.\n\
1052 Arguments: display-hint to-string children\n\
1053 display-hint: either #f or one of \"array\", \"map\", or \"string\"\n\
1054 to-string: a procedure:\n\
1055 (pretty-printer) -> string | #f | <gdb:value>\n\
1056 children: either #f or a procedure:\n\
1057 (pretty-printer) -> <gdb:iterator>" },
1059 { "pretty-printer-worker?", 1, 0, 0,
1060 as_a_scm_t_subr (gdbscm_pretty_printer_worker_p),
1062 Return #t if the object is a <gdb:pretty-printer-worker> object." },
1064 { "pretty-printers", 0, 0, 0, as_a_scm_t_subr (gdbscm_pretty_printers),
1066 Return the list of global pretty-printers." },
1068 { "set-pretty-printers!", 1, 0, 0,
1069 as_a_scm_t_subr (gdbscm_set_pretty_printers_x),
1071 Set the list of global pretty-printers." },
1077 gdbscm_initialize_pretty_printers (void)
1079 pretty_printer_smob_tag
1080 = gdbscm_make_smob_type (pretty_printer_smob_name,
1081 sizeof (pretty_printer_smob));
1082 scm_set_smob_print (pretty_printer_smob_tag,
1083 ppscm_print_pretty_printer_smob);
1085 pretty_printer_worker_smob_tag
1086 = gdbscm_make_smob_type (pretty_printer_worker_smob_name,
1087 sizeof (pretty_printer_worker_smob));
1088 scm_set_smob_print (pretty_printer_worker_smob_tag,
1089 ppscm_print_pretty_printer_worker_smob);
1091 gdbscm_define_functions (pretty_printer_functions, 1);
1093 pretty_printer_list = SCM_EOL;
1095 pp_type_error_symbol = scm_from_latin1_symbol ("gdb:pp-type-error");
1097 ppscm_map_string = scm_from_latin1_string ("map");
1098 ppscm_array_string = scm_from_latin1_string ("array");
1099 ppscm_string_string = scm_from_latin1_string ("string");