mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +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> 2000-05-05 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (scm_m_body, scm_macroexp, unmemocopy, scm_eval_args, * 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 */ gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
#include <stdio.h> #include <stdio.h>
#include "libguile/_scm.h" #include "libguile/_scm.h"
#include "libguile/validate.h" #include "libguile/validate.h"
#include "libguile/pairs.h"
/* {Pairs} /* {Pairs}
*/ */
SCM_DEFINE (scm_cons, "cons", 2, 0, 0, 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" "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" "@var{y}. The pair is guaranteed to be different (in the sense of\n"
"@code{eqv?}) from every previously existing object.") "@code{eqv?}) from every previously existing object.")
#define FUNC_NAME s_scm_cons #define FUNC_NAME s_scm_cons
{ {
register SCM z; SCM z;
SCM_NEWCELL (z); SCM_NEWCELL (z);
SCM_SETCAR (z, x); SCM_SET_CELL_OBJECT_0 (z, x);
SCM_SETCDR (z, y); SCM_SET_CELL_OBJECT_1 (z, y);
return z; return z;
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -73,15 +74,18 @@ SCM_DEFINE (scm_cons, "cons", 2, 0, 0,
SCM SCM
scm_cons2 (SCM w, SCM x, SCM y) scm_cons2 (SCM w, SCM x, SCM y)
{ {
register SCM z; SCM z1;
SCM_NEWCELL (z); SCM z2;
SCM_SETCAR (z, x);
SCM_SETCDR (z, y); SCM_NEWCELL (z1);
x = z; SCM_SET_CELL_OBJECT_0 (z1, x);
SCM_NEWCELL (z); SCM_SET_CELL_OBJECT_1 (z1, y);
SCM_SETCAR (z, w);
SCM_SETCDR (z, x); SCM_NEWCELL (z2);
return z; 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}.") "Returns @code{#t} if @var{x} is a pair; otherwise returns @code{#f}.")
#define FUNC_NAME s_scm_pair_p #define FUNC_NAME s_scm_pair_p
{ {
if (SCM_IMP (x)) return SCM_BOOL (SCM_CONSP (x));
return SCM_BOOL_F;
return SCM_BOOL(SCM_CONSP (x));
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE (scm_set_car_x, "set-car!", 2, 0, 0, SCM_DEFINE (scm_set_car_x, "set-car!", 2, 0, 0,
(SCM pair, SCM value), (SCM pair, SCM value),
"Stores @var{value} in the car field of @var{pair}. The value returned\n" "Stores @var{value} in the car field of @var{pair}. The value returned\n"
"by @code{set-car!} is unspecified.") "by @code{set-car!} is unspecified.")
#define FUNC_NAME s_scm_set_car_x #define FUNC_NAME s_scm_set_car_x
{ {
SCM_VALIDATE_CONS (1,pair); SCM_VALIDATE_CONS (1, pair);
SCM_SETCAR (pair, value); SCM_SETCAR (pair, value);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE (scm_set_cdr_x, "set-cdr!", 2, 0, 0, SCM_DEFINE (scm_set_cdr_x, "set-cdr!", 2, 0, 0,
(SCM pair, SCM value), (SCM pair, SCM value),
"Stores @var{value} in the cdr field of @var{pair}. The value returned\n" "Stores @var{value} in the cdr field of @var{pair}. The value returned\n"
"by @code{set-cdr!} is unspecified.") "by @code{set-cdr!} is unspecified.")
#define FUNC_NAME s_scm_set_cdr_x #define FUNC_NAME s_scm_set_cdr_x
{ {
SCM_VALIDATE_CONS (1,pair); SCM_VALIDATE_CONS (1, pair);
SCM_SETCDR (pair, value); SCM_SETCDR (pair, value);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
static const char * cxrs[] = static const char * cxrs[] =