1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 06:41:13 +02:00

* read.c (scm_read_hash_extend): make scm_read_hash_procedures a

pointer to the Scheme variable read-hash-procedures and intern it
in scm_init_read. Modify scm_read_hash_extend and
scm_get_hash_procedure to use the pointer.
This commit is contained in:
Gary Houston 1997-03-11 03:57:04 +00:00
parent 88e863c90b
commit 14de3b4206
2 changed files with 34 additions and 17 deletions

View file

@ -1,4 +1,11 @@
Mon Mar 10 06:28:54 1997 Gary Houston <ghouston@actrix.gen.nz> Tue Mar 11 03:51:00 1997 Gary Houston <ghouston@actrix.gen.nz>
* read.c (scm_read_hash_extend): make scm_read_hash_procedures a
pointer to the Scheme variable read-hash-procedures and intern it
in scm_init_read. Modify scm_read_hash_extend and
scm_get_hash_procedure to use the pointer.
Mon Mar 10 06:28:54 1997 Gary Houston <ghouston@actrix.gen.nz>
* read.h (SCM_N_READ_OPTIONS): increase SCM_N_READ_OPTIONS to 4. * read.h (SCM_N_READ_OPTIONS): increase SCM_N_READ_OPTIONS to 4.
(SCM_KEYWORD_STYLE): defined. (SCM_KEYWORD_STYLE): defined.

View file

@ -86,9 +86,8 @@ scm_read_options (setting)
return ans; return ans;
} }
/* CDR contains an association list mapping extra hash characters to /* An association list mapping extra hash characters to procedures. */
procedures. */ static SCM *scm_read_hash_procedures;
static SCM scm_read_hash_procedures;
SCM_PROC (s_read, "read", 0, 1, 0, scm_read); SCM_PROC (s_read, "read", 0, 1, 0, scm_read);
@ -762,8 +761,8 @@ exit:
/* Register a procedure for extended # object processing and the character /* Manipulate the read-hash-procedures alist. This could be written in
that will trigger it. */ Scheme, but maybe it will also be used by C code during initialisation. */
SCM_PROC (s_read_hash_extend, "read-hash-extend", 2, 0, 0, scm_read_hash_extend); SCM_PROC (s_read_hash_extend, "read-hash-extend", 2, 0, 0, scm_read_hash_extend);
SCM SCM
scm_read_hash_extend (chr, proc) scm_read_hash_extend (chr, proc)
@ -777,9 +776,9 @@ scm_read_hash_extend (chr, proc)
SCM_ASSERT (SCM_FALSEP (proc) || SCM_NIMP(proc), proc, SCM_ARG2, SCM_ASSERT (SCM_FALSEP (proc) || SCM_NIMP(proc), proc, SCM_ARG2,
s_read_hash_extend); s_read_hash_extend);
/* See it this chr is already in the alist. */ /* Check if chr is already in the alist. */
this = SCM_CDR (scm_read_hash_procedures); this = *scm_read_hash_procedures;
prev = scm_read_hash_procedures; prev = SCM_BOOL_F;
while (1) while (1)
{ {
if (SCM_NULLP (this)) if (SCM_NULLP (this))
@ -787,9 +786,8 @@ scm_read_hash_extend (chr, proc)
/* not found, so add it to the beginning. */ /* not found, so add it to the beginning. */
if (SCM_NFALSEP (proc)) if (SCM_NFALSEP (proc))
{ {
scm_set_cdr_x (scm_read_hash_procedures, *scm_read_hash_procedures =
scm_cons (scm_cons (chr, proc), scm_cons (scm_cons (chr, proc), *scm_read_hash_procedures);
SCM_CDR (scm_read_hash_procedures)));
} }
break; break;
} }
@ -797,9 +795,21 @@ scm_read_hash_extend (chr, proc)
{ {
/* already in the alist. */ /* already in the alist. */
if (SCM_FALSEP (proc)) if (SCM_FALSEP (proc))
scm_set_cdr_x (prev, SCM_CDR (this)); /* remove it. */ {
/* remove it. */
if (prev == SCM_BOOL_F)
{
*scm_read_hash_procedures =
SCM_CDR (*scm_read_hash_procedures);
}
else
scm_set_cdr_x (prev, SCM_CDR (this));
}
else else
scm_set_cdr_x (SCM_CAR (this), proc); /* replace it. */ {
/* replace it. */
scm_set_cdr_x (SCM_CAR (this), proc);
}
break; break;
} }
prev = this; prev = this;
@ -814,7 +824,7 @@ static SCM
scm_get_hash_procedure (c) scm_get_hash_procedure (c)
int c; int c;
{ {
SCM rest = SCM_CDR (scm_read_hash_procedures); SCM rest = *scm_read_hash_procedures;
while (1) while (1)
{ {
@ -831,8 +841,8 @@ scm_get_hash_procedure (c)
void void
scm_init_read () scm_init_read ()
{ {
scm_read_hash_procedures = scm_cons (SCM_BOOL_F, SCM_EOL); scm_read_hash_procedures =
scm_permanent_object (scm_read_hash_procedures); SCM_CDRLOC (scm_sysintern ("read-hash-procedures", SCM_EOL));
scm_init_opts (scm_read_options, scm_read_opts, SCM_N_READ_OPTIONS); scm_init_opts (scm_read_options, scm_read_opts, SCM_N_READ_OPTIONS);
#include "read.x" #include "read.x"