1 /* GDB/Scheme pretty-printing.
3 Copyright (C) 2008-2024 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. */
31 #include "guile-internal.h"
33 /* Return type of print_string_repr. */
35 enum guile_string_repr_result
37 /* The string method returned None. */
39 /* The string method had an error. */
49 /* No display hint. */
51 /* The display hint has a bad value. */
53 /* Print as an array. */
57 /* Print as a string. */
61 /* The <gdb:pretty-printer> smob. */
63 struct pretty_printer_smob
65 /* This must appear first. */
68 /* A string representing the name of the printer. */
71 /* A boolean indicating whether the printer is enabled. */
74 /* A procedure called to look up the printer for the given value.
75 The procedure is called as (lookup gdb:pretty-printer value).
76 The result should either be a gdb:pretty-printer object that will print
77 the value, or #f if the value is not recognized. */
80 /* Note: Attaching subprinters to this smob is left to Scheme. */
83 /* The <gdb:pretty-printer-worker> smob. */
85 struct pretty_printer_worker_smob
87 /* This must appear first. */
90 /* Either #f or one of the supported display hints: map, array, string.
91 If neither of those then the display hint is ignored (treated as #f). */
94 /* A procedure called to pretty-print the value.
95 (lambda (printer) ...) -> string | <gdb:lazy-string> | <gdb:value> */
98 /* A procedure called to print children of the value.
99 (lambda (printer) ...) -> <gdb:iterator>
100 The iterator returns a pair for each iteration: (name . value),
101 where "value" can have the same types as to_string. */
105 static const char pretty_printer_smob_name
[] =
106 "gdb:pretty-printer";
107 static const char pretty_printer_worker_smob_name
[] =
108 "gdb:pretty-printer-worker";
110 /* The tag Guile knows the pretty-printer smobs by. */
111 static scm_t_bits pretty_printer_smob_tag
;
112 static scm_t_bits pretty_printer_worker_smob_tag
;
114 /* The global pretty-printer list. */
115 static SCM pretty_printer_list
;
117 /* gdb:pp-type-error. */
118 static SCM pp_type_error_symbol
;
120 /* Pretty-printer display hints are specified by strings. */
121 static SCM ppscm_map_string
;
122 static SCM ppscm_array_string
;
123 static SCM ppscm_string_string
;
125 /* Administrivia for pretty-printer matcher smobs. */
127 /* The smob "print" function for <gdb:pretty-printer>. */
130 ppscm_print_pretty_printer_smob (SCM self
, SCM port
, scm_print_state
*pstate
)
132 pretty_printer_smob
*pp_smob
= (pretty_printer_smob
*) SCM_SMOB_DATA (self
);
134 gdbscm_printf (port
, "#<%s ", pretty_printer_smob_name
);
135 scm_write (pp_smob
->name
, port
);
136 scm_puts (gdbscm_is_true (pp_smob
->enabled
) ? " enabled" : " disabled",
138 scm_puts (">", port
);
140 scm_remember_upto_here_1 (self
);
142 /* Non-zero means success. */
146 /* (make-pretty-printer string procedure) -> <gdb:pretty-printer> */
149 gdbscm_make_pretty_printer (SCM name
, SCM lookup
)
151 pretty_printer_smob
*pp_smob
= (pretty_printer_smob
*)
152 scm_gc_malloc (sizeof (pretty_printer_smob
),
153 pretty_printer_smob_name
);
156 SCM_ASSERT_TYPE (scm_is_string (name
), name
, SCM_ARG1
, FUNC_NAME
,
158 SCM_ASSERT_TYPE (gdbscm_is_procedure (lookup
), lookup
, SCM_ARG2
, FUNC_NAME
,
161 pp_smob
->name
= name
;
162 pp_smob
->lookup
= lookup
;
163 pp_smob
->enabled
= SCM_BOOL_T
;
164 smob
= scm_new_smob (pretty_printer_smob_tag
, (scm_t_bits
) pp_smob
);
165 gdbscm_init_gsmob (&pp_smob
->base
);
170 /* Return non-zero if SCM is a <gdb:pretty-printer> object. */
173 ppscm_is_pretty_printer (SCM scm
)
175 return SCM_SMOB_PREDICATE (pretty_printer_smob_tag
, scm
);
178 /* (pretty-printer? object) -> boolean */
181 gdbscm_pretty_printer_p (SCM scm
)
183 return scm_from_bool (ppscm_is_pretty_printer (scm
));
186 /* Returns the <gdb:pretty-printer> object in SELF.
187 Throws an exception if SELF is not a <gdb:pretty-printer> object. */
190 ppscm_get_pretty_printer_arg_unsafe (SCM self
, int arg_pos
,
191 const char *func_name
)
193 SCM_ASSERT_TYPE (ppscm_is_pretty_printer (self
), self
, arg_pos
, func_name
,
194 pretty_printer_smob_name
);
199 /* Returns a pointer to the pretty-printer smob of SELF.
200 Throws an exception if SELF is not a <gdb:pretty-printer> object. */
202 static pretty_printer_smob
*
203 ppscm_get_pretty_printer_smob_arg_unsafe (SCM self
, int arg_pos
,
204 const char *func_name
)
206 SCM pp_scm
= ppscm_get_pretty_printer_arg_unsafe (self
, arg_pos
, func_name
);
207 pretty_printer_smob
*pp_smob
208 = (pretty_printer_smob
*) SCM_SMOB_DATA (pp_scm
);
213 /* Pretty-printer methods. */
215 /* (pretty-printer-enabled? <gdb:pretty-printer>) -> boolean */
218 gdbscm_pretty_printer_enabled_p (SCM self
)
220 pretty_printer_smob
*pp_smob
221 = ppscm_get_pretty_printer_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
223 return pp_smob
->enabled
;
226 /* (set-pretty-printer-enabled! <gdb:pretty-printer> boolean)
230 gdbscm_set_pretty_printer_enabled_x (SCM self
, SCM enabled
)
232 pretty_printer_smob
*pp_smob
233 = ppscm_get_pretty_printer_smob_arg_unsafe (self
, SCM_ARG1
, FUNC_NAME
);
235 pp_smob
->enabled
= scm_from_bool (gdbscm_is_true (enabled
));
237 return SCM_UNSPECIFIED
;
240 /* (pretty-printers) -> list
241 Returns the list of global pretty-printers. */
244 gdbscm_pretty_printers (void)
246 return pretty_printer_list
;
249 /* (set-pretty-printers! list) -> unspecified
250 Set the global pretty-printers list. */
253 gdbscm_set_pretty_printers_x (SCM printers
)
255 SCM_ASSERT_TYPE (gdbscm_is_true (scm_list_p (printers
)), printers
,
256 SCM_ARG1
, FUNC_NAME
, _("list"));
258 pretty_printer_list
= printers
;
260 return SCM_UNSPECIFIED
;
263 /* Administrivia for pretty-printer-worker smobs.
264 These are created when a matcher recognizes a value. */
266 /* The smob "print" function for <gdb:pretty-printer-worker>. */
269 ppscm_print_pretty_printer_worker_smob (SCM self
, SCM port
,
270 scm_print_state
*pstate
)
272 pretty_printer_worker_smob
*w_smob
273 = (pretty_printer_worker_smob
*) SCM_SMOB_DATA (self
);
275 gdbscm_printf (port
, "#<%s ", pretty_printer_worker_smob_name
);
276 scm_write (w_smob
->display_hint
, port
);
277 scm_puts (" ", port
);
278 scm_write (w_smob
->to_string
, port
);
279 scm_puts (" ", port
);
280 scm_write (w_smob
->children
, port
);
281 scm_puts (">", port
);
283 scm_remember_upto_here_1 (self
);
285 /* Non-zero means success. */
289 /* (make-pretty-printer-worker string procedure procedure)
290 -> <gdb:pretty-printer-worker> */
293 gdbscm_make_pretty_printer_worker (SCM display_hint
, SCM to_string
,
296 pretty_printer_worker_smob
*w_smob
= (pretty_printer_worker_smob
*)
297 scm_gc_malloc (sizeof (pretty_printer_worker_smob
),
298 pretty_printer_worker_smob_name
);
301 w_smob
->display_hint
= display_hint
;
302 w_smob
->to_string
= to_string
;
303 w_smob
->children
= children
;
304 w_scm
= scm_new_smob (pretty_printer_worker_smob_tag
, (scm_t_bits
) w_smob
);
305 gdbscm_init_gsmob (&w_smob
->base
);
309 /* Return non-zero if SCM is a <gdb:pretty-printer-worker> object. */
312 ppscm_is_pretty_printer_worker (SCM scm
)
314 return SCM_SMOB_PREDICATE (pretty_printer_worker_smob_tag
, scm
);
317 /* (pretty-printer-worker? object) -> boolean */
320 gdbscm_pretty_printer_worker_p (SCM scm
)
322 return scm_from_bool (ppscm_is_pretty_printer_worker (scm
));
325 /* Helper function to create a <gdb:exception> object indicating that the
326 type of some value returned from a pretty-printer is invalid. */
329 ppscm_make_pp_type_error_exception (const char *message
, SCM object
)
331 std::string msg
= string_printf ("%s: ~S", message
);
332 return gdbscm_make_error (pp_type_error_symbol
,
333 NULL
/* func */, msg
.c_str (),
334 scm_list_1 (object
), scm_list_1 (object
));
337 /* Print MESSAGE as an exception (meaning it is controlled by
338 "guile print-stack").
339 Called from the printer code when the Scheme code returns an invalid type
343 ppscm_print_pp_type_error (const char *message
, SCM object
)
345 SCM exception
= ppscm_make_pp_type_error_exception (message
, object
);
347 gdbscm_print_gdb_exception (SCM_BOOL_F
, exception
);
350 /* Helper function for find_pretty_printer which iterates over a list,
351 calls each function and inspects output. This will return a
352 <gdb:pretty-printer> object if one recognizes VALUE. If no printer is
353 found, it will return #f. On error, it will return a <gdb:exception>
356 Note: This has to be efficient and careful.
357 We don't want to excessively slow down printing of values, but any kind of
358 random crud can appear in the pretty-printer list, and we can't crash
362 ppscm_search_pp_list (SCM list
, SCM value
)
364 SCM orig_list
= list
;
366 if (scm_is_null (list
))
368 if (gdbscm_is_false (scm_list_p (list
))) /* scm_is_pair? */
370 return ppscm_make_pp_type_error_exception
371 (_("pretty-printer list is not a list"), list
);
374 for ( ; scm_is_pair (list
); list
= scm_cdr (list
))
376 SCM matcher
= scm_car (list
);
378 pretty_printer_smob
*pp_smob
;
380 if (!ppscm_is_pretty_printer (matcher
))
382 return ppscm_make_pp_type_error_exception
383 (_("pretty-printer list contains non-pretty-printer object"),
387 pp_smob
= (pretty_printer_smob
*) SCM_SMOB_DATA (matcher
);
389 /* Skip if disabled. */
390 if (gdbscm_is_false (pp_smob
->enabled
))
393 if (!gdbscm_is_procedure (pp_smob
->lookup
))
395 return ppscm_make_pp_type_error_exception
396 (_("invalid lookup object in pretty-printer matcher"),
400 worker
= gdbscm_safe_call_2 (pp_smob
->lookup
, matcher
,
401 value
, gdbscm_memory_error_p
);
402 if (!gdbscm_is_false (worker
))
404 if (gdbscm_is_exception (worker
))
406 if (ppscm_is_pretty_printer_worker (worker
))
408 return ppscm_make_pp_type_error_exception
409 (_("invalid result from pretty-printer lookup"), worker
);
413 if (!scm_is_null (list
))
415 return ppscm_make_pp_type_error_exception
416 (_("pretty-printer list is not a list"), orig_list
);
422 /* Subroutine of find_pretty_printer to simplify it.
423 Look for a pretty-printer to print VALUE in all objfiles.
424 If there's an error an exception smob is returned.
425 The result is #f, if no pretty-printer was found.
426 Otherwise the result is the pretty-printer smob. */
429 ppscm_find_pretty_printer_from_objfiles (SCM value
)
431 for (objfile
*objfile
: current_program_space
->objfiles ())
433 objfile_smob
*o_smob
= ofscm_objfile_smob_from_objfile (objfile
);
435 = ppscm_search_pp_list (ofscm_objfile_smob_pretty_printers (o_smob
),
438 /* Note: This will return if pp is a <gdb:exception> object,
439 which is what we want. */
440 if (gdbscm_is_true (pp
))
447 /* Subroutine of find_pretty_printer to simplify it.
448 Look for a pretty-printer to print VALUE in the current program space.
449 If there's an error an exception smob is returned.
450 The result is #f, if no pretty-printer was found.
451 Otherwise the result is the pretty-printer smob. */
454 ppscm_find_pretty_printer_from_progspace (SCM value
)
456 pspace_smob
*p_smob
= psscm_pspace_smob_from_pspace (current_program_space
);
458 = ppscm_search_pp_list (psscm_pspace_smob_pretty_printers (p_smob
), value
);
463 /* Subroutine of find_pretty_printer to simplify it.
464 Look for a pretty-printer to print VALUE in the gdb module.
465 If there's an error a Scheme exception is returned.
466 The result is #f, if no pretty-printer was found.
467 Otherwise the result is the pretty-printer smob. */
470 ppscm_find_pretty_printer_from_gdb (SCM value
)
472 SCM pp
= ppscm_search_pp_list (pretty_printer_list
, value
);
477 /* Find the pretty-printing constructor function for VALUE. If no
478 pretty-printer exists, return #f. If one exists, return the
479 gdb:pretty-printer smob that implements it. On error, an exception smob
482 Note: In the end it may be better to call out to Scheme once, and then
483 do all of the lookup from Scheme. TBD. */
486 ppscm_find_pretty_printer (SCM value
)
490 /* Look at the pretty-printer list for each objfile
491 in the current program-space. */
492 pp
= ppscm_find_pretty_printer_from_objfiles (value
);
493 /* Note: This will return if function is a <gdb:exception> object,
494 which is what we want. */
495 if (gdbscm_is_true (pp
))
498 /* Look at the pretty-printer list for the current program-space. */
499 pp
= ppscm_find_pretty_printer_from_progspace (value
);
500 /* Note: This will return if function is a <gdb:exception> object,
501 which is what we want. */
502 if (gdbscm_is_true (pp
))
505 /* Look at the pretty-printer list in the gdb module. */
506 pp
= ppscm_find_pretty_printer_from_gdb (value
);
510 /* Pretty-print a single value, via the PRINTER, which must be a
511 <gdb:pretty-printer-worker> object.
512 The caller is responsible for ensuring PRINTER is valid.
513 If the function returns a string, an SCM containing the string
514 is returned. If the function returns #f that means the pretty
515 printer returned #f as a value. Otherwise, if the function returns a
516 <gdb:value> object, *OUT_VALUE is set to the value and #t is returned.
517 It is an error if the printer returns #t.
518 On error, an exception smob is returned. */
521 ppscm_pretty_print_one_value (SCM printer
, struct value
**out_value
,
522 struct gdbarch
*gdbarch
,
523 const struct language_defn
*language
)
525 SCM result
= SCM_BOOL_F
;
530 pretty_printer_worker_smob
*w_smob
531 = (pretty_printer_worker_smob
*) SCM_SMOB_DATA (printer
);
533 result
= gdbscm_safe_call_1 (w_smob
->to_string
, printer
,
534 gdbscm_memory_error_p
);
535 if (gdbscm_is_false (result
))
537 else if (scm_is_string (result
)
538 || lsscm_is_lazy_string (result
))
540 else if (vlscm_is_value (result
))
545 = vlscm_convert_value_from_scheme (FUNC_NAME
, GDBSCM_ARG_NONE
,
548 if (*out_value
!= NULL
)
553 else if (gdbscm_is_exception (result
))
557 /* Invalid result from to-string. */
558 result
= ppscm_make_pp_type_error_exception
559 (_("invalid result from pretty-printer to-string"), result
);
562 catch (const gdb_exception_forced_quit
&except
)
564 quit_force (NULL
, 0);
566 catch (const gdb_exception
&except
)
573 /* Return the display hint for PRINTER as a Scheme object.
574 The caller is responsible for ensuring PRINTER is a
575 <gdb:pretty-printer-worker> object. */
578 ppscm_get_display_hint_scm (SCM printer
)
580 pretty_printer_worker_smob
*w_smob
581 = (pretty_printer_worker_smob
*) SCM_SMOB_DATA (printer
);
583 return w_smob
->display_hint
;
586 /* Return the display hint for the pretty-printer PRINTER.
587 The caller is responsible for ensuring PRINTER is a
588 <gdb:pretty-printer-worker> object.
589 Returns the display hint or #f if the hint is not a string. */
591 static enum display_hint
592 ppscm_get_display_hint_enum (SCM printer
)
594 SCM hint
= ppscm_get_display_hint_scm (printer
);
596 if (gdbscm_is_false (hint
))
598 if (scm_is_string (hint
))
600 if (gdbscm_is_true (scm_string_equal_p (hint
, ppscm_array_string
)))
602 if (gdbscm_is_true (scm_string_equal_p (hint
, ppscm_map_string
)))
604 if (gdbscm_is_true (scm_string_equal_p (hint
, ppscm_string_string
)))
611 /* A wrapper for gdbscm_print_gdb_exception that ignores memory errors.
612 EXCEPTION is a <gdb:exception> object. */
615 ppscm_print_exception_unless_memory_error (SCM exception
,
616 struct ui_file
*stream
)
618 if (gdbscm_memory_error_p (gdbscm_exception_key (exception
)))
620 gdb::unique_xmalloc_ptr
<char> msg
621 = gdbscm_exception_message_to_string (exception
);
623 /* This "shouldn't happen", but play it safe. */
624 if (msg
== NULL
|| msg
.get ()[0] == '\0')
625 gdb_printf (stream
, _("<error reading variable>"));
628 /* Remove the trailing newline. We could instead call a special
629 routine for printing memory error messages, but this is easy
631 char *msg_text
= msg
.get ();
632 size_t len
= strlen (msg_text
);
634 if (msg_text
[len
- 1] == '\n')
635 msg_text
[len
- 1] = '\0';
636 gdb_printf (stream
, _("<error reading variable: %s>"), msg_text
);
640 gdbscm_print_gdb_exception (SCM_BOOL_F
, exception
);
643 /* Helper for gdbscm_apply_val_pretty_printer which calls to_string and
644 formats the result. */
646 static enum guile_string_repr_result
647 ppscm_print_string_repr (SCM printer
, enum display_hint hint
,
648 struct ui_file
*stream
, int recurse
,
649 const struct value_print_options
*options
,
650 struct gdbarch
*gdbarch
,
651 const struct language_defn
*language
)
653 struct value
*replacement
= NULL
;
655 enum guile_string_repr_result result
= STRING_REPR_ERROR
;
657 str_scm
= ppscm_pretty_print_one_value (printer
, &replacement
,
659 if (gdbscm_is_false (str_scm
))
661 result
= STRING_REPR_NONE
;
663 else if (scm_is_eq (str_scm
, SCM_BOOL_T
))
665 struct value_print_options opts
= *options
;
667 gdb_assert (replacement
!= NULL
);
668 opts
.addressprint
= false;
669 common_val_print (replacement
, stream
, recurse
, &opts
, language
);
670 result
= STRING_REPR_OK
;
672 else if (scm_is_string (str_scm
))
675 gdb::unique_xmalloc_ptr
<char> string
676 = gdbscm_scm_to_string (str_scm
, &length
,
677 target_charset (gdbarch
), 0 /*!strict*/, NULL
);
679 if (hint
== HINT_STRING
)
681 struct type
*type
= builtin_type (gdbarch
)->builtin_char
;
683 language
->printstr (stream
, type
, (gdb_byte
*) string
.get (),
684 length
, NULL
, 0, options
);
688 /* Alas scm_to_stringn doesn't nul-terminate the string if we
689 ask for the length. */
692 for (i
= 0; i
< length
; ++i
)
694 if (string
.get ()[i
] == '\0')
695 gdb_puts ("\\000", stream
);
697 gdb_putc (string
.get ()[i
], stream
);
700 result
= STRING_REPR_OK
;
702 else if (lsscm_is_lazy_string (str_scm
))
704 struct value_print_options local_opts
= *options
;
706 local_opts
.addressprint
= false;
707 lsscm_val_print_lazy_string (str_scm
, stream
, &local_opts
);
708 result
= STRING_REPR_OK
;
712 gdb_assert (gdbscm_is_exception (str_scm
));
713 ppscm_print_exception_unless_memory_error (str_scm
, stream
);
714 result
= STRING_REPR_ERROR
;
720 /* Helper for gdbscm_apply_val_pretty_printer that formats children of the
721 printer, if any exist.
722 The caller is responsible for ensuring PRINTER is a printer smob.
723 If PRINTED_NOTHING is true, then nothing has been printed by to_string,
724 and format output accordingly. */
727 ppscm_print_children (SCM printer
, enum display_hint hint
,
728 struct ui_file
*stream
, int recurse
,
729 const struct value_print_options
*options
,
730 struct gdbarch
*gdbarch
,
731 const struct language_defn
*language
,
734 pretty_printer_worker_smob
*w_smob
735 = (pretty_printer_worker_smob
*) SCM_SMOB_DATA (printer
);
736 int is_map
, is_array
, done_flag
, pretty
;
739 SCM iter
= SCM_BOOL_F
; /* -Wall */
741 if (gdbscm_is_false (w_smob
->children
))
743 if (!gdbscm_is_procedure (w_smob
->children
))
745 ppscm_print_pp_type_error
746 (_("pretty-printer \"children\" object is not a procedure or #f"),
751 /* If we are printing a map or an array, we want special formatting. */
752 is_map
= hint
== HINT_MAP
;
753 is_array
= hint
== HINT_ARRAY
;
755 children
= gdbscm_safe_call_1 (w_smob
->children
, printer
,
756 gdbscm_memory_error_p
);
757 if (gdbscm_is_exception (children
))
759 ppscm_print_exception_unless_memory_error (children
, stream
);
762 /* We combine two steps here: get children, make an iterator out of them.
763 This simplifies things because there's no language means of creating
764 iterators, and it's the printer object that knows how it will want its
765 children iterated over. */
766 if (!itscm_is_iterator (children
))
768 ppscm_print_pp_type_error
769 (_("result of pretty-printer \"children\" procedure is not"
770 " a <gdb:iterator> object"), children
);
775 /* Use the prettyformat_arrays option if we are printing an array,
776 and the pretty option otherwise. */
778 pretty
= options
->prettyformat_arrays
;
781 if (options
->prettyformat
== Val_prettyformat
)
784 pretty
= options
->prettyformat_structs
;
788 for (i
= 0; i
< options
->print_max
; ++i
)
791 SCM item
= itscm_safe_call_next_x (iter
, gdbscm_memory_error_p
);
793 if (gdbscm_is_exception (item
))
795 ppscm_print_exception_unless_memory_error (item
, stream
);
798 if (itscm_is_end_of_iteration (item
))
800 /* Set a flag so we can know whether we printed all the
801 available elements. */
806 if (! scm_is_pair (item
))
808 ppscm_print_pp_type_error
809 (_("result of pretty-printer children iterator is not a pair"
810 " or (end-of-iteration)"),
814 scm_name
= scm_car (item
);
815 v_scm
= scm_cdr (item
);
816 if (!scm_is_string (scm_name
))
818 ppscm_print_pp_type_error
819 (_("first element of pretty-printer children iterator is not"
823 gdb::unique_xmalloc_ptr
<char> name
824 = gdbscm_scm_to_c_string (scm_name
);
826 /* Print initial "=" to separate print_string_repr output and
827 children. For other elements, there are three cases:
828 1. Maps. Print a "," after each value element.
829 2. Arrays. Always print a ",".
830 3. Other. Always print a ",". */
833 if (!printed_nothing
)
834 gdb_puts (" = ", stream
);
836 else if (! is_map
|| i
% 2 == 0)
837 gdb_puts (pretty
? "," : ", ", stream
);
839 /* Skip printing children if max_depth has been reached. This check
840 is performed after print_string_repr and the "=" separator so that
841 these steps are not skipped if the variable is located within the
843 if (val_print_check_max_depth (stream
, recurse
, options
, language
))
846 /* Print initial "{" to bookend children. */
847 gdb_puts ("{", stream
);
849 /* In summary mode, we just want to print "= {...}" if there is
851 if (options
->summary
)
853 /* This increment tricks the post-loop logic to print what
861 if (! is_map
|| i
% 2 == 0)
865 gdb_puts ("\n", stream
);
866 print_spaces (2 + 2 * recurse
, stream
);
869 stream
->wrap_here (2 + 2 *recurse
);
872 if (is_map
&& i
% 2 == 0)
873 gdb_puts ("[", stream
);
876 /* We print the index, not whatever the child method
877 returned as the name. */
878 if (options
->print_array_indexes
)
879 gdb_printf (stream
, "[%d] = ", i
);
883 gdb_puts (name
.get (), stream
);
884 gdb_puts (" = ", stream
);
887 if (lsscm_is_lazy_string (v_scm
))
889 struct value_print_options local_opts
= *options
;
891 local_opts
.addressprint
= false;
892 lsscm_val_print_lazy_string (v_scm
, stream
, &local_opts
);
894 else if (scm_is_string (v_scm
))
896 gdb::unique_xmalloc_ptr
<char> output
897 = gdbscm_scm_to_c_string (v_scm
);
898 gdb_puts (output
.get (), stream
);
904 = vlscm_convert_value_from_scheme (FUNC_NAME
, GDBSCM_ARG_NONE
,
910 ppscm_print_exception_unless_memory_error (except_scm
, stream
);
915 /* When printing the key of a map we allow one additional
916 level of depth. This means the key will print before the
918 struct value_print_options opt
= *options
;
919 if (is_map
&& i
% 2 == 0
920 && opt
.max_depth
!= -1
921 && opt
.max_depth
< INT_MAX
)
923 common_val_print (value
, stream
, recurse
+ 1, &opt
, language
);
927 if (is_map
&& i
% 2 == 0)
928 gdb_puts ("] = ", stream
);
937 gdb_puts ("\n", stream
);
938 print_spaces (2 + 2 * recurse
, stream
);
940 gdb_puts ("...", stream
);
944 gdb_puts ("\n", stream
);
945 print_spaces (2 * recurse
, stream
);
947 gdb_puts ("}", stream
);
951 /* Play it safe, make sure ITER doesn't get GC'd. */
952 scm_remember_upto_here_1 (iter
);
955 /* This is the extension_language_ops.apply_val_pretty_printer "method". */
958 gdbscm_apply_val_pretty_printer (const struct extension_language_defn
*extlang
,
960 struct ui_file
*stream
, int recurse
,
961 const struct value_print_options
*options
,
962 const struct language_defn
*language
)
964 struct type
*type
= value
->type ();
965 struct gdbarch
*gdbarch
= type
->arch ();
966 SCM exception
= SCM_BOOL_F
;
967 SCM printer
= SCM_BOOL_F
;
968 SCM val_obj
= SCM_BOOL_F
;
969 enum display_hint hint
;
970 enum ext_lang_rc result
= EXT_LANG_RC_NOP
;
971 enum guile_string_repr_result print_result
;
974 value
->fetch_lazy ();
976 /* No pretty-printer support for unavailable values. */
977 if (!value
->bytes_available (0, type
->length ()))
978 return EXT_LANG_RC_NOP
;
980 if (!gdb_scheme_initialized
)
981 return EXT_LANG_RC_NOP
;
983 /* Instantiate the printer. */
984 val_obj
= vlscm_scm_from_value_no_release (value
);
985 if (gdbscm_is_exception (val_obj
))
988 result
= EXT_LANG_RC_ERROR
;
992 printer
= ppscm_find_pretty_printer (val_obj
);
994 if (gdbscm_is_exception (printer
))
997 result
= EXT_LANG_RC_ERROR
;
1000 if (gdbscm_is_false (printer
))
1002 result
= EXT_LANG_RC_NOP
;
1005 gdb_assert (ppscm_is_pretty_printer_worker (printer
));
1007 /* If we are printing a map, we want some special formatting. */
1008 hint
= ppscm_get_display_hint_enum (printer
);
1009 if (hint
== HINT_ERROR
)
1011 /* Print the error as an exception for consistency. */
1012 SCM hint_scm
= ppscm_get_display_hint_scm (printer
);
1014 ppscm_print_pp_type_error ("Invalid display hint", hint_scm
);
1015 /* Fall through. A bad hint doesn't stop pretty-printing. */
1019 /* Print the section. */
1020 print_result
= ppscm_print_string_repr (printer
, hint
, stream
, recurse
,
1021 options
, gdbarch
, language
);
1022 if (print_result
!= STRING_REPR_ERROR
)
1024 ppscm_print_children (printer
, hint
, stream
, recurse
, options
,
1026 print_result
== STRING_REPR_NONE
);
1029 result
= EXT_LANG_RC_OK
;
1032 if (gdbscm_is_exception (exception
))
1033 ppscm_print_exception_unless_memory_error (exception
, stream
);
1037 /* Initialize the Scheme pretty-printer code. */
1039 static const scheme_function pretty_printer_functions
[] =
1041 { "make-pretty-printer", 2, 0, 0,
1042 as_a_scm_t_subr (gdbscm_make_pretty_printer
),
1044 Create a <gdb:pretty-printer> object.\n\
1046 Arguments: name lookup\n\
1047 name: a string naming the matcher\n\
1048 lookup: a procedure:\n\
1049 (pretty-printer <gdb:value>) -> <gdb:pretty-printer-worker> | #f." },
1051 { "pretty-printer?", 1, 0, 0, as_a_scm_t_subr (gdbscm_pretty_printer_p
),
1053 Return #t if the object is a <gdb:pretty-printer> object." },
1055 { "pretty-printer-enabled?", 1, 0, 0,
1056 as_a_scm_t_subr (gdbscm_pretty_printer_enabled_p
),
1058 Return #t if the pretty-printer is enabled." },
1060 { "set-pretty-printer-enabled!", 2, 0, 0,
1061 as_a_scm_t_subr (gdbscm_set_pretty_printer_enabled_x
),
1063 Set the enabled flag of the pretty-printer.\n\
1064 Returns \"unspecified\"." },
1066 { "make-pretty-printer-worker", 3, 0, 0,
1067 as_a_scm_t_subr (gdbscm_make_pretty_printer_worker
),
1069 Create a <gdb:pretty-printer-worker> object.\n\
1071 Arguments: display-hint to-string children\n\
1072 display-hint: either #f or one of \"array\", \"map\", or \"string\"\n\
1073 to-string: a procedure:\n\
1074 (pretty-printer) -> string | #f | <gdb:value>\n\
1075 children: either #f or a procedure:\n\
1076 (pretty-printer) -> <gdb:iterator>" },
1078 { "pretty-printer-worker?", 1, 0, 0,
1079 as_a_scm_t_subr (gdbscm_pretty_printer_worker_p
),
1081 Return #t if the object is a <gdb:pretty-printer-worker> object." },
1083 { "pretty-printers", 0, 0, 0, as_a_scm_t_subr (gdbscm_pretty_printers
),
1085 Return the list of global pretty-printers." },
1087 { "set-pretty-printers!", 1, 0, 0,
1088 as_a_scm_t_subr (gdbscm_set_pretty_printers_x
),
1090 Set the list of global pretty-printers." },
1096 gdbscm_initialize_pretty_printers (void)
1098 pretty_printer_smob_tag
1099 = gdbscm_make_smob_type (pretty_printer_smob_name
,
1100 sizeof (pretty_printer_smob
));
1101 scm_set_smob_print (pretty_printer_smob_tag
,
1102 ppscm_print_pretty_printer_smob
);
1104 pretty_printer_worker_smob_tag
1105 = gdbscm_make_smob_type (pretty_printer_worker_smob_name
,
1106 sizeof (pretty_printer_worker_smob
));
1107 scm_set_smob_print (pretty_printer_worker_smob_tag
,
1108 ppscm_print_pretty_printer_worker_smob
);
1110 gdbscm_define_functions (pretty_printer_functions
, 1);
1112 pretty_printer_list
= SCM_EOL
;
1114 pp_type_error_symbol
= scm_from_latin1_symbol ("gdb:pp-type-error");
1116 ppscm_map_string
= scm_from_latin1_string ("map");
1117 ppscm_array_string
= scm_from_latin1_string ("array");
1118 ppscm_string_string
= scm_from_latin1_string ("string");