mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-16 00:30:21 +02:00
RTL programs print with their name
* libguile/print.c (iprin1): Use scm_i_program_print for RTL programs too. * libguile/procprop.c (scm_procedure_name): For RTL programs, call scm_i_rtl_program_name if there is no override. * libguile/programs.h: * libguile/programs.c (scm_i_rtl_program_name): New helper, dispatches to (system vm program). (scm_i_program_print): For RTL programs, the fallback prints the code pointer too. * module/system/vm/program.scm (rtl-program-name): Use the debug info to get an RTL program name. (write-program): Work with RTL programs too. * test-suite/tests/rtl.test ("procedure name"): Add test.
This commit is contained in:
parent
e2cbf527c4
commit
e65f80af42
6 changed files with 60 additions and 17 deletions
|
@ -223,10 +223,25 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
|
|||
"Return the name of the procedure @var{proc}")
|
||||
#define FUNC_NAME s_scm_procedure_name
|
||||
{
|
||||
SCM props, ret;
|
||||
|
||||
SCM_VALIDATE_PROC (1, proc);
|
||||
|
||||
while (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
|
||||
proc = SCM_STRUCT_PROCEDURE (proc);
|
||||
return scm_procedure_property (proc, scm_sym_name);
|
||||
|
||||
props = scm_weak_table_refq (overrides, proc, SCM_BOOL_F);
|
||||
|
||||
if (scm_is_pair (props))
|
||||
ret = scm_assq_ref (props, scm_sym_name);
|
||||
else if (SCM_RTL_PROGRAM_P (proc))
|
||||
ret = scm_i_rtl_program_name (proc);
|
||||
else if (SCM_PROGRAM_P (proc))
|
||||
ret = scm_assq_ref (scm_i_program_properties (proc), scm_sym_name);
|
||||
else
|
||||
ret = SCM_BOOL_F;
|
||||
|
||||
return ret;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue