mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

* Use SCM{_SET}?_CELL_OBJECT to access cells that are no valid pairs yet.

Browse source 
* Eliminated redundant SCM_IMP test.
This commit is contained in:
Dirk Herrmann 2000-05-05 16:19:30 +00:00
parent b2e37c5a52
commit 4983cbe405
2 changed files with 31 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

7
libguile/ChangeLog
View file

@ -1,3 +1,10 @@
2000-05-05 Dirk Herrmann <D.Herrmann@tu-bs.de>
* pairs.c (scm_cons, scm_cons2): Use SCM{_SET}?_CELL_OBJECT as
long as a cell is not known to be a valid pair.
(scm_pair_p): Eliminated redundant SCM_IMP test.
2000-05-05 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (scm_m_body, scm_macroexp, unmemocopy, scm_eval_args,

45
libguile/pairs.c
View file

@ -43,28 +43,29 @@
gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
#include <stdio.h>
#include "libguile/_scm.h"
#include "libguile/validate.h"
#include "libguile/pairs.h"
/* {Pairs}
*/
SCM_DEFINE (scm_cons, "cons", 2, 0, 0,
(SCM x, SCM y),
(SCM x, SCM y),
"Returns a newly allocated pair whose car is @var{x} and whose cdr is\n"
"@var{y}. The pair is guaranteed to be different (in the sense of\n"
"@code{eqv?}) from every previously existing object.")
#define FUNC_NAME s_scm_cons
{
register SCM z;
SCM z;
SCM_NEWCELL (z);
SCM_SETCAR (z, x);
SCM_SETCDR (z, y);
SCM_SET_CELL_OBJECT_0 (z, x);
SCM_SET_CELL_OBJECT_1 (z, y);
return z;
}
#undef FUNC_NAME
@ -73,15 +74,18 @@ SCM_DEFINE (scm_cons, "cons", 2, 0, 0,
SCM
scm_cons2 (SCM w, SCM x, SCM y)
{
register SCM z;
SCM_NEWCELL (z);
SCM_SETCAR (z, x);
SCM_SETCDR (z, y);
x = z;
SCM_NEWCELL (z);
SCM_SETCAR (z, w);
SCM_SETCDR (z, x);
return z;
SCM z1;
SCM z2;
SCM_NEWCELL (z1);
SCM_SET_CELL_OBJECT_0 (z1, x);
SCM_SET_CELL_OBJECT_1 (z1, y);
SCM_NEWCELL (z2);
SCM_SET_CELL_OBJECT_0 (z2, w);
SCM_SET_CELL_OBJECT_1 (z2, z1);
return z2;
}
@ -90,37 +94,36 @@ SCM_DEFINE (scm_pair_p, "pair?", 1, 0, 0,
"Returns @code{#t} if @var{x} is a pair; otherwise returns @code{#f}.")
#define FUNC_NAME s_scm_pair_p
{
if (SCM_IMP (x))
return SCM_BOOL_F;
return SCM_BOOL(SCM_CONSP (x));
return SCM_BOOL (SCM_CONSP (x));
}
#undef FUNC_NAME
SCM_DEFINE (scm_set_car_x, "set-car!", 2, 0, 0,
(SCM pair, SCM value),
"Stores @var{value} in the car field of @var{pair}. The value returned\n"
"by @code{set-car!} is unspecified.")
#define FUNC_NAME s_scm_set_car_x
{
SCM_VALIDATE_CONS (1,pair);
SCM_VALIDATE_CONS (1, pair);
SCM_SETCAR (pair, value);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
SCM_DEFINE (scm_set_cdr_x, "set-cdr!", 2, 0, 0,
(SCM pair, SCM value),
"Stores @var{value} in the cdr field of @var{pair}. The value returned\n"
"by @code{set-cdr!} is unspecified.")
#define FUNC_NAME s_scm_set_cdr_x
{
SCM_VALIDATE_CONS (1,pair);
SCM_VALIDATE_CONS (1, pair);
SCM_SETCDR (pair, value);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
static const char * cxrs[] =