1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 09:10:22 +02:00

* debug.c (scm_make_iloc): Prefer !SCM_<foo> over SCM_N<foo>.

(scm_memcons, scm_mem_to_proc):  When building lists, prefer
scm_list_<n> over scm_cons[2]?.

(scm_mem_to_proc):  Prefer SCM_CONSP over SCM_NIMP.

(scm_procedure_name):  Use SCM_CADR instead of explicit form.

(debugobj_print):  Coerce scm_intprint arg 1 to long, not int.
Thanks to Rob Browning for the patch (see log entry 2001-09-21) -
for some reason his patch didn't make it into the cvs.
This commit is contained in:
Dirk Herrmann 2001-10-11 22:26:25 +00:00
parent 79d34f68e7
commit 37c56aecf8
2 changed files with 23 additions and 8 deletions

View file

@ -1,3 +1,18 @@
2001-10-11 Dirk Herrmann <D.Herrmann@tu-bs.de>
* debug.c (scm_make_iloc): Prefer !SCM_<foo> over SCM_N<foo>.
(scm_memcons, scm_mem_to_proc): When building lists, prefer
scm_list_<n> over scm_cons[2]?.
(scm_mem_to_proc): Prefer SCM_CONSP over SCM_NIMP.
(scm_procedure_name): Use SCM_CADR instead of explicit form.
(debugobj_print): Coerce scm_intprint arg 1 to long, not int.
Thanks to Rob Browning for the patch (see log entry 2001-09-21) -
for some reason his patch didn't make it into the cvs.
2001-10-09 Dirk Herrmann <D.Herrmann@tu-bs.de>
* numbers.c (mem2decimal_from_point): Cleaned up the parsing a

View file

@ -47,6 +47,7 @@
#include "libguile/_scm.h"
#include "libguile/eval.h"
#include "libguile/list.h"
#include "libguile/stackchk.h"
#include "libguile/throw.h"
#include "libguile/macros.h"
@ -251,7 +252,7 @@ SCM_DEFINE (scm_make_iloc, "make-iloc", 3, 0, 0,
SCM_VALIDATE_INUM (2,binding);
return SCM_PACK (SCM_UNPACK (SCM_ILOC00)
+ SCM_IFRINC * SCM_INUM (frame)
+ (SCM_NFALSEP (cdrp) ? SCM_ICDR : 0)
+ (!SCM_FALSEP (cdrp) ? SCM_ICDR : 0)
+ SCM_IDINC * SCM_INUM (binding));
}
#undef FUNC_NAME
@ -276,7 +277,7 @@ SCM_DEFINE (scm_memcons, "memcons", 2, 1, 0,
/*fixme* environments may be two different but equal top-level envs */
if (!SCM_UNBNDP (env) && SCM_MEMOIZED_ENV (car) != env)
SCM_MISC_ERROR ("environment mismatch arg1 <-> arg3",
scm_cons2 (car, env, SCM_EOL));
scm_list_2 (car, env));
else
env = SCM_MEMOIZED_ENV (car);
car = SCM_MEMOIZED_EXP (car);
@ -285,7 +286,7 @@ SCM_DEFINE (scm_memcons, "memcons", 2, 1, 0,
{
if (!SCM_UNBNDP (env) && SCM_MEMOIZED_ENV (cdr) != env)
SCM_MISC_ERROR ("environment mismatch arg2 <-> arg3",
scm_cons2 (cdr, env, SCM_EOL));
scm_list_2 (cdr, env));
else
env = SCM_MEMOIZED_ENV (cdr);
cdr = SCM_MEMOIZED_EXP (cdr);
@ -308,9 +309,8 @@ SCM_DEFINE (scm_mem_to_proc, "mem->proc", 1, 0, 0,
SCM_VALIDATE_MEMOIZED (1,obj);
env = SCM_MEMOIZED_ENV (obj);
obj = SCM_MEMOIZED_EXP (obj);
if (!(SCM_NIMP (obj) && SCM_CAR (obj) == SCM_IM_LAMBDA))
SCM_MISC_ERROR ("expected lambda expression",
scm_cons (obj, SCM_EOL));
if (!SCM_CONSP (obj) || !SCM_EQ_P (CAR (obj), SCM_IM_LAMBDA))
SCM_MISC_ERROR ("expected lambda expression", scm_list_1 (obj));
return scm_closure (SCM_CDR (obj), env);
}
#undef FUNC_NAME
@ -362,7 +362,7 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
SCM name = scm_procedure_property (proc, scm_sym_name);
#if 0
/* Source property scm_sym_procname not implemented yet... */
SCM name = scm_source_property (SCM_CAR (SCM_CDR (SCM_CODE (proc))), scm_sym_procname);
SCM name = scm_source_property (SCM_CADR (SCM_CODE (proc)), scm_sym_procname);
if (SCM_FALSEP (name))
name = scm_procedure_property (proc, scm_sym_name);
#endif
@ -521,7 +521,7 @@ static int
debugobj_print (SCM obj, SCM port, scm_print_state *pstate SCM_UNUSED)
{
scm_puts ("#<debug-object ", port);
scm_intprint ((int) SCM_DEBUGOBJ_FRAME (obj), 16, port);
scm_intprint ((long) SCM_DEBUGOBJ_FRAME (obj), 16, port);
scm_putc ('>', port);
return 1;
}