[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
guile/guile-core/libguile ChangeLog continuatio...
|
From: |
Keisuke Nishida |
|
Subject: |
guile/guile-core/libguile ChangeLog continuatio... |
|
Date: |
Wed, 27 Jun 2001 18:11:59 -0700 |
CVSROOT: /cvs
Module name: guile
Changes by: Keisuke Nishida <address@hidden> 01/06/27 18:11:59
Modified files:
guile-core/libguile: ChangeLog continuations.c deprecation.c
dynl.c environments.c error.c eval.c
evalext.c filesys.c fluids.c gc.c gh.h
gh_list.c goops.c gsubr.c guardians.c
hooks.c list.c list.h load.c modules.c
net_db.c objects.c options.c pairs.c
ports.c print.c procprop.c read.c script.c
smob.c socket.c strings.c struct.c
symbols-deprecated.c unif.c variable.c
vectors.c
Log message:
* list.h (scm_list_1, scm_list_2, scm_list_3, scm_list_4, scm_list_5,
scm_list_n): New functions.
(SCM_LIST0, SCM_LIST1, SCM_LIST2, SCM_LIST3, SCM_LIST4, SCM_LIST5,
SCM_LIST6, SCM_LIST7, SCM_LIST8, SCM_LIST9, scm_listify): Deprecated.
(lots of files): Use the new functions.
* goops.c (CALL_GF1, CALL_GF2, CALL_GF3, CALL_GF4): Use scm_call_N.
* strings.c: #include "libguile/deprecation.h".
CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/ChangeLog.diff?cvsroot=OldCVS&tr1=1.1455&tr2=1.1456&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/continuations.c.diff?cvsroot=OldCVS&tr1=1.37&tr2=1.38&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/deprecation.c.diff?cvsroot=OldCVS&tr1=1.8&tr2=1.9&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/dynl.c.diff?cvsroot=OldCVS&tr1=1.62&tr2=1.63&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/environments.c.diff?cvsroot=OldCVS&tr1=1.22&tr2=1.23&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/error.c.diff?cvsroot=OldCVS&tr1=1.61&tr2=1.62&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/eval.c.diff?cvsroot=OldCVS&tr1=1.233&tr2=1.234&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/evalext.c.diff?cvsroot=OldCVS&tr1=1.34&tr2=1.35&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/filesys.c.diff?cvsroot=OldCVS&tr1=1.103&tr2=1.104&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/fluids.c.diff?cvsroot=OldCVS&tr1=1.40&tr2=1.41&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/gc.c.diff?cvsroot=OldCVS&tr1=1.206&tr2=1.207&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/gh.h.diff?cvsroot=OldCVS&tr1=1.34&tr2=1.35&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/gh_list.c.diff?cvsroot=OldCVS&tr1=1.11&tr2=1.12&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/goops.c.diff?cvsroot=OldCVS&tr1=1.38&tr2=1.39&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/gsubr.c.diff?cvsroot=OldCVS&tr1=1.39&tr2=1.40&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/guardians.c.diff?cvsroot=OldCVS&tr1=1.35&tr2=1.36&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/hooks.c.diff?cvsroot=OldCVS&tr1=1.19&tr2=1.20&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/list.c.diff?cvsroot=OldCVS&tr1=1.56&tr2=1.57&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/list.h.diff?cvsroot=OldCVS&tr1=1.20&tr2=1.21&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/load.c.diff?cvsroot=OldCVS&tr1=1.63&tr2=1.64&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/modules.c.diff?cvsroot=OldCVS&tr1=1.30&tr2=1.31&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/net_db.c.diff?cvsroot=OldCVS&tr1=1.61&tr2=1.62&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/objects.c.diff?cvsroot=OldCVS&tr1=1.62&tr2=1.63&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/options.c.diff?cvsroot=OldCVS&tr1=1.33&tr2=1.34&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/pairs.c.diff?cvsroot=OldCVS&tr1=1.24&tr2=1.25&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/ports.c.diff?cvsroot=OldCVS&tr1=1.152&tr2=1.153&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/print.c.diff?cvsroot=OldCVS&tr1=1.127&tr2=1.128&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/procprop.c.diff?cvsroot=OldCVS&tr1=1.36&tr2=1.37&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/read.c.diff?cvsroot=OldCVS&tr1=1.73&tr2=1.74&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/script.c.diff?cvsroot=OldCVS&tr1=1.42&tr2=1.43&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/smob.c.diff?cvsroot=OldCVS&tr1=1.46&tr2=1.47&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/socket.c.diff?cvsroot=OldCVS&tr1=1.79&tr2=1.80&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/strings.c.diff?cvsroot=OldCVS&tr1=1.59&tr2=1.60&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/struct.c.diff?cvsroot=OldCVS&tr1=1.80&tr2=1.81&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/symbols-deprecated.c.diff?cvsroot=OldCVS&tr1=1.3&tr2=1.4&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/unif.c.diff?cvsroot=OldCVS&tr1=1.117&tr2=1.118&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/variable.c.diff?cvsroot=OldCVS&tr1=1.36&tr2=1.37&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/vectors.c.diff?cvsroot=OldCVS&tr1=1.52&tr2=1.53&r1=text&r2=text
Patches:
Index: guile/guile-core/libguile/ChangeLog
diff -u guile/guile-core/libguile/ChangeLog:1.1455
guile/guile-core/libguile/ChangeLog:1.1456
--- guile/guile-core/libguile/ChangeLog:1.1455 Wed Jun 27 06:15:20 2001
+++ guile/guile-core/libguile/ChangeLog Wed Jun 27 18:11:58 2001
@@ -1,3 +1,15 @@
+2001-06-28 Keisuke Nishida <address@hidden>
+
+ * list.h (scm_list_1, scm_list_2, scm_list_3, scm_list_4, scm_list_5,
+ scm_list_n): New functions.
+ (SCM_LIST0, SCM_LIST1, SCM_LIST2, SCM_LIST3, SCM_LIST4, SCM_LIST5,
+ SCM_LIST6, SCM_LIST7, SCM_LIST8, SCM_LIST9, scm_listify): Deprecated.
+ (lots of files): Use the new functions.
+
+ * goops.c (CALL_GF1, CALL_GF2, CALL_GF3, CALL_GF4): Use scm_call_N.
+
+ * strings.c: #include "libguile/deprecation.h".
+
2001-06-27 Martin Grabmueller <address@hidden>
* read.c (scm_lreadr): When reading a hash token, check for a
Index: guile/guile-core/libguile/continuations.c
diff -u guile/guile-core/libguile/continuations.c:1.37
guile/guile-core/libguile/continuations.c:1.38
--- guile/guile-core/libguile/continuations.c:1.37 Thu Jun 14 12:50:43 2001
+++ guile/guile-core/libguile/continuations.c Wed Jun 27 18:11:58 2001
@@ -232,7 +232,7 @@
|| continuation->base != rootcont->base)
{
SCM_MISC_ERROR ("continuation from wrong top level: ~S",
- SCM_LIST1 (cont));
+ scm_list_1 (cont));
}
scm_dowinds (continuation->dynenv,
Index: guile/guile-core/libguile/deprecation.c
diff -u guile/guile-core/libguile/deprecation.c:1.8
guile/guile-core/libguile/deprecation.c:1.9
--- guile/guile-core/libguile/deprecation.c:1.8 Wed Jun 20 10:33:43 2001
+++ guile/guile-core/libguile/deprecation.c Wed Jun 27 18:11:58 2001
@@ -66,7 +66,7 @@
if (SCM_BOOLP (issued_msgs))
issued_msgs = SCM_BOOL_T;
else
- scm_issue_deprecation_warning (SCM_LIST1 (scm_makfrom0str (msg)));
+ scm_issue_deprecation_warning (scm_list_1 (scm_makfrom0str (msg)));
}
SCM_DEFINE(scm_issue_deprecation_warning,
Index: guile/guile-core/libguile/dynl.c
diff -u guile/guile-core/libguile/dynl.c:1.62
guile/guile-core/libguile/dynl.c:1.63
--- guile/guile-core/libguile/dynl.c:1.62 Thu Jun 14 12:50:43 2001
+++ guile/guile-core/libguile/dynl.c Wed Jun 27 18:11:58 2001
@@ -254,7 +254,7 @@
SCM_ALLOW_INTS;
fn = scm_makfrom0str (fname);
msg = scm_makfrom0str (lt_dlerror ());
- scm_misc_error (subr, "file: ~S, message: ~S", SCM_LIST2 (fn, msg));
+ scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg));
}
return (void *) handle;
}
Index: guile/guile-core/libguile/environments.c
diff -u guile/guile-core/libguile/environments.c:1.22
guile/guile-core/libguile/environments.c:1.23
--- guile/guile-core/libguile/environments.c:1.22 Tue Jun 26 08:46:40 2001
+++ guile/guile-core/libguile/environments.c Wed Jun 27 18:11:58 2001
@@ -816,7 +816,7 @@
SCM observer = data->observer;
SCM message = scm_makfrom0str ("Observer `~A' signals `~A' error: ~S");
- return scm_cons (message, SCM_LIST3 (observer, tag, args));
+ return scm_cons (message, scm_list_3 (observer, tag, args));
}
Index: guile/guile-core/libguile/error.c
diff -u guile/guile-core/libguile/error.c:1.61
guile/guile-core/libguile/error.c:1.62
--- guile/guile-core/libguile/error.c:1.61 Wed May 23 17:50:44 2001
+++ guile/guile-core/libguile/error.c Wed Jun 27 18:11:58 2001
@@ -81,10 +81,10 @@
message ? message : "<empty message>");
abort ();
}
- arg_list = SCM_LIST4 (subr ? scm_makfrom0str (subr) : SCM_BOOL_F,
- message ? scm_makfrom0str (message) : SCM_BOOL_F,
- args,
- rest);
+ arg_list = scm_list_4 (subr ? scm_makfrom0str (subr) : SCM_BOOL_F,
+ message ? scm_makfrom0str (message) : SCM_BOOL_F,
+ args,
+ rest);
scm_ithrow (key, arg_list, 1);
/* No return, but just in case: */
@@ -202,7 +202,7 @@
scm_error (scm_out_of_range_key,
subr,
"Argument out of range: ~S",
- SCM_LIST1(bad_value),
+ scm_list_1 (bad_value),
SCM_BOOL_F);
}
@@ -212,7 +212,7 @@
scm_error (scm_out_of_range_key,
subr,
"Argument ~S out of range: ~S",
- SCM_LIST2(pos,bad_value),
+ scm_list_2 (pos,bad_value),
SCM_BOOL_F);
}
@@ -224,7 +224,7 @@
scm_error (scm_args_number_key,
NULL,
"Wrong number of arguments to ~A",
- SCM_LIST1(proc),
+ scm_list_1 (proc),
SCM_BOOL_F);
}
@@ -235,7 +235,7 @@
scm_error (scm_args_number_key,
NULL,
"Wrong number of arguments to ~A",
- SCM_LIST1 (scm_makfrom0str (subr)),
+ scm_list_1 (scm_makfrom0str (subr)),
SCM_BOOL_F);
}
@@ -248,8 +248,8 @@
subr,
(pos == 0) ? "Wrong type argument: ~S"
: "Wrong type argument in position ~A: ~S",
- (pos == 0) ? SCM_LIST1(bad_value)
- : SCM_LIST2(SCM_MAKINUM(pos), bad_value),
+ (pos == 0) ? scm_list_1 (bad_value)
+ : scm_list_2 (SCM_MAKINUM (pos), bad_value),
SCM_BOOL_F);
}
@@ -260,13 +260,13 @@
if (pos == 0) {
scm_error (scm_arg_type_key,
subr, "Wrong type argument (expecting ~A): ~S",
- SCM_LIST2(msg,bad_value),
+ scm_list_2 (msg, bad_value),
SCM_BOOL_F);
} else {
scm_error (scm_arg_type_key,
subr,
"Wrong type argument in position ~A (expecting ~A): ~S",
- SCM_LIST3(SCM_MAKINUM(pos),msg,bad_value),
+ scm_list_3 (SCM_MAKINUM (pos), msg, bad_value),
SCM_BOOL_F);
}
}
@@ -300,7 +300,7 @@
if ((~0x1fL) & (long) pos)
{
/* error string supplied. */
- scm_misc_error (s_subr, pos, SCM_LIST1 (arg));
+ scm_misc_error (s_subr, pos, scm_list_1 (arg));
}
else
{
Index: guile/guile-core/libguile/eval.c
diff -u guile/guile-core/libguile/eval.c:1.233
guile/guile-core/libguile/eval.c:1.234
--- guile/guile-core/libguile/eval.c:1.233 Tue Jun 26 14:55:45 2001
+++ guile/guile-core/libguile/eval.c Wed Jun 27 18:11:58 2001
@@ -2523,7 +2523,7 @@
proc = x;
badfun:
/* scm_everr (x, env,...) */
- scm_misc_error (NULL, "Wrong type to apply: ~S", SCM_LIST1 (proc));
+ scm_misc_error (NULL, "Wrong type to apply: ~S", scm_list_1 (proc));
case scm_tc7_vector:
case scm_tc7_wvect:
#ifdef HAVE_ARRAYS
Index: guile/guile-core/libguile/evalext.c
diff -u guile/guile-core/libguile/evalext.c:1.34
guile/guile-core/libguile/evalext.c:1.35
--- guile/guile-core/libguile/evalext.c:1.34 Thu Jun 7 14:12:19 2001
+++ guile/guile-core/libguile/evalext.c Wed Jun 27 18:11:58 2001
@@ -63,8 +63,8 @@
if (SCM_SYMBOLP (SCM_CAR (x)))
return scm_cons (SCM_IM_SET_X, x);
else if (SCM_CONSP (SCM_CAR (x)))
- return scm_cons (SCM_LIST2 (scm_sym_setter, SCM_CAAR (x)),
- scm_append (SCM_LIST2 (SCM_CDAR (x), SCM_CDR (x))));
+ return scm_cons (scm_list_2 (scm_sym_setter, SCM_CAAR (x)),
+ scm_append (scm_list_2 (SCM_CDAR (x), SCM_CDR (x))));
else
scm_misc_error (scm_s_set_x, scm_s_variable, SCM_EOL);
}
Index: guile/guile-core/libguile/filesys.c
diff -u guile/guile-core/libguile/filesys.c:1.103
guile/guile-core/libguile/filesys.c:1.104
--- guile/guile-core/libguile/filesys.c:1.103 Tue Jun 26 10:53:09 2001
+++ guile/guile-core/libguile/filesys.c Wed Jun 27 18:11:58 2001
@@ -574,7 +574,8 @@
int en = errno;
SCM_SYSERROR_MSG ("~A: ~S",
- SCM_LIST2 (scm_makfrom0str (strerror (errno)), object),
+ scm_list_2 (scm_makfrom0str (strerror (errno)),
+ object),
en);
}
return scm_stat2scm (&stat_temp);
@@ -753,7 +754,7 @@
SCM_VALIDATE_DIR (1, port);
if (!SCM_DIR_OPEN_P (port))
- SCM_MISC_ERROR ("Directory ~S is not open.", SCM_LIST1 (port));
+ SCM_MISC_ERROR ("Directory ~S is not open.", scm_list_1 (port));
errno = 0;
SCM_SYSCALL (rdent = readdir ((DIR *) SCM_CELL_WORD_1 (port)));
@@ -774,7 +775,7 @@
{
SCM_VALIDATE_DIR (1, port);
if (!SCM_DIR_OPEN_P (port))
- SCM_MISC_ERROR ("Directory ~S is not open.", SCM_LIST1 (port));
+ SCM_MISC_ERROR ("Directory ~S is not open.", scm_list_1 (port));
rewinddir ((DIR *) SCM_CELL_WORD_1 (port));
@@ -1162,9 +1163,9 @@
if (rv < 0)
SCM_SYSERROR;
}
- return SCM_LIST3 (retrieve_select_type (&read_set, read_ports_ready, reads),
- retrieve_select_type (&write_set, write_ports_ready,
writes),
- retrieve_select_type (&except_set, SCM_EOL, excepts));
+ return scm_list_3 (retrieve_select_type (&read_set, read_ports_ready, reads),
+ retrieve_select_type (&write_set, write_ports_ready,
writes),
+ retrieve_select_type (&except_set, SCM_EOL, excepts));
}
#undef FUNC_NAME
#endif /* HAVE_SELECT */
@@ -1325,7 +1326,7 @@
int en = errno;
SCM_SYSERROR_MSG ("~A: ~S",
- SCM_LIST2 (scm_makfrom0str (strerror (errno)), str),
+ scm_list_2 (scm_makfrom0str (strerror (errno)), str),
en);
}
return scm_stat2scm(&stat_temp);
Index: guile/guile-core/libguile/fluids.c
diff -u guile/guile-core/libguile/fluids.c:1.40
guile/guile-core/libguile/fluids.c:1.41
--- guile/guile-core/libguile/fluids.c:1.40 Tue Jun 26 08:46:40 2001
+++ guile/guile-core/libguile/fluids.c Wed Jun 27 18:11:58 2001
@@ -253,7 +253,7 @@
scm_c_with_fluid (SCM fluid, SCM value, SCM (*cproc) (), void *cdata)
#define FUNC_NAME "scm_c_with_fluid"
{
- return scm_c_with_fluids (SCM_LIST1 (fluid), SCM_LIST1 (value),
+ return scm_c_with_fluids (scm_list_1 (fluid), SCM_LIST1 (value),
cproc, cdata);
}
#undef FUNC_NAME
Index: guile/guile-core/libguile/gc.c
diff -u guile/guile-core/libguile/gc.c:1.206
guile/guile-core/libguile/gc.c:1.207
--- guile/guile-core/libguile/gc.c:1.206 Thu Jun 14 12:50:43 2001
+++ guile/guile-core/libguile/gc.c Wed Jun 27 18:11:58 2001
@@ -841,18 +841,18 @@
local_scm_gc_cells_swept = scm_gc_cells_swept_acc;
local_scm_gc_cells_marked = scm_gc_cells_marked_acc;
- answer = scm_listify (scm_cons (sym_gc_time_taken, scm_ulong2num
(local_scm_gc_time_taken)),
- scm_cons (sym_cells_allocated, scm_ulong2num
(local_scm_cells_allocated)),
- scm_cons (sym_heap_size, scm_ulong2num
(local_scm_heap_size)),
- scm_cons (sym_mallocated, scm_ulong2num
(local_scm_mallocated)),
- scm_cons (sym_mtrigger, scm_ulong2num
(local_scm_mtrigger)),
- scm_cons (sym_times, scm_ulong2num
(local_scm_gc_times)),
- scm_cons (sym_gc_mark_time_taken, scm_ulong2num
(local_scm_gc_mark_time_taken)),
- scm_cons (sym_gc_sweep_time_taken, scm_ulong2num
(local_scm_gc_sweep_time_taken)),
- scm_cons (sym_cells_marked, scm_i_dbl2big
(local_scm_gc_cells_marked)),
- scm_cons (sym_cells_swept, scm_i_dbl2big
(local_scm_gc_cells_swept)),
- scm_cons (sym_heap_segments, heap_segs),
- SCM_UNDEFINED);
+ answer = scm_list_n (scm_cons (sym_gc_time_taken, scm_ulong2num
(local_scm_gc_time_taken)),
+ scm_cons (sym_cells_allocated, scm_ulong2num
(local_scm_cells_allocated)),
+ scm_cons (sym_heap_size, scm_ulong2num
(local_scm_heap_size)),
+ scm_cons (sym_mallocated, scm_ulong2num
(local_scm_mallocated)),
+ scm_cons (sym_mtrigger, scm_ulong2num
(local_scm_mtrigger)),
+ scm_cons (sym_times, scm_ulong2num (local_scm_gc_times)),
+ scm_cons (sym_gc_mark_time_taken, scm_ulong2num
(local_scm_gc_mark_time_taken)),
+ scm_cons (sym_gc_sweep_time_taken, scm_ulong2num
(local_scm_gc_sweep_time_taken)),
+ scm_cons (sym_cells_marked, scm_i_dbl2big
(local_scm_gc_cells_marked)),
+ scm_cons (sym_cells_swept, scm_i_dbl2big
(local_scm_gc_cells_swept)),
+ scm_cons (sym_heap_segments, heap_segs),
+ SCM_UNDEFINED);
SCM_ALLOW_INTS;
return answer;
}
Index: guile/guile-core/libguile/gh.h
diff -u guile/guile-core/libguile/gh.h:1.34 guile/guile-core/libguile/gh.h:1.35
--- guile/guile-core/libguile/gh.h:1.34 Thu Jun 14 12:50:43 2001
+++ guile/guile-core/libguile/gh.h Wed Jun 27 18:11:58 2001
@@ -188,7 +188,7 @@
SCM gh_module_lookup (SCM module, const char *sname);
SCM gh_cons(SCM x, SCM y);
-#define gh_list scm_listify
+#define gh_list scm_list_n
unsigned long gh_length(SCM l);
SCM gh_append(SCM args);
SCM gh_append2(SCM l1, SCM l2);
Index: guile/guile-core/libguile/gh_list.c
diff -u guile/guile-core/libguile/gh_list.c:1.11
guile/guile-core/libguile/gh_list.c:1.12
--- guile/guile-core/libguile/gh_list.c:1.11 Sat May 26 13:51:20 2001
+++ guile/guile-core/libguile/gh_list.c Wed Jun 27 18:11:58 2001
@@ -59,27 +59,27 @@
them all together into a single list, which is returned. This is
equivalent to the Scheme procedure (append list1 list2 ...) */
SCM
-gh_append(SCM args)
+gh_append (SCM args)
{
- return scm_append(args);
+ return scm_append (args);
}
SCM
-gh_append2(SCM l1, SCM l2)
+gh_append2 (SCM l1, SCM l2)
{
- return scm_append(scm_listify(l1, l2, SCM_UNDEFINED));
+ return scm_append (scm_list_2 (l1, l2));
}
SCM
gh_append3(SCM l1, SCM l2, SCM l3)
{
- return scm_append(scm_listify(l1, l2, l3, SCM_UNDEFINED));
+ return scm_append (scm_list_3 (l1, l2, l3));
}
SCM
-gh_append4(SCM l1, SCM l2, SCM l3, SCM l4)
+gh_append4 (SCM l1, SCM l2, SCM l3, SCM l4)
{
- return scm_append(scm_listify(l1, l2, l3, l4, SCM_UNDEFINED));
+ return scm_append (scm_list_4 (l1, l2, l3, l4));
}
/* gh_reverse() is defined as a macro in gh.h */
Index: guile/guile-core/libguile/goops.c
diff -u guile/guile-core/libguile/goops.c:1.38
guile/guile-core/libguile/goops.c:1.39
--- guile/guile-core/libguile/goops.c:1.38 Tue Jun 26 08:46:40 2001
+++ guile/guile-core/libguile/goops.c Wed Jun 27 18:11:58 2001
@@ -76,22 +76,22 @@
#define SPEC_OF(x) SCM_SLOT (x, scm_si_specializers)
#define DEFVAR(v,val) \
-{ scm_eval (SCM_LIST3 (scm_sym_define_public, (v), (val)), \
- scm_module_goops); }
+{ scm_eval (scm_list_3 (scm_sym_define_public, (v), (val)), \
+ scm_module_goops); }
/* Temporary hack until we get the new module system */
/*fixme* Should optimize by keeping track of the variable object itself */
#define GETVAR(v) (SCM_VARIABLE_REF (scm_call_2 (scm_goops_lookup_closure, \
(v), SCM_BOOL_F)))
/* Fixme: Should use already interned symbols */
-#define CALL_GF1(name,a) (scm_apply (GETVAR (scm_str2symbol (name)), \
- SCM_LIST1 (a), SCM_EOL))
-#define CALL_GF2(name,a,b) (scm_apply (GETVAR (scm_str2symbol (name)), \
- SCM_LIST2 (a, b), SCM_EOL))
-#define CALL_GF3(name,a,b,c) (scm_apply (GETVAR (scm_str2symbol (name)), \
- SCM_LIST3 (a, b, c), SCM_EOL))
-#define CALL_GF4(name,a,b,c,d) (scm_apply (GETVAR (scm_str2symbol (name)), \
- SCM_LIST4 (a, b, c, d), SCM_EOL))
+#define CALL_GF1(name,a) (scm_call_1 (GETVAR (scm_str2symbol (name)), \
+ a))
+#define CALL_GF2(name,a,b) (scm_call_2 (GETVAR (scm_str2symbol (name)), \
+ a, b))
+#define CALL_GF3(name,a,b,c) (scm_call_3 (GETVAR (scm_str2symbol (name)), \
+ a, b, c))
+#define CALL_GF4(name,a,b,c,d) (scm_call_4 (GETVAR (scm_str2symbol (name)), \
+ a, b, c, d))
/* Class redefinition protocol:
@@ -245,7 +245,7 @@
tmp = SCM_CAAR (l);
if (!SCM_SYMBOLP (tmp))
- scm_misc_error ("%compute-slots", "bad slot name ~S", SCM_LIST1 (tmp));
+ scm_misc_error ("%compute-slots", "bad slot name ~S", scm_list_1 (tmp));
if (SCM_FALSEP (scm_c_memq (tmp, slots_already_seen))) {
res = scm_cons (SCM_CAR (l), res);
@@ -261,8 +261,9 @@
register SCM res = dslots;
for (cpl = SCM_CDR(cpl); SCM_NNULLP(cpl); cpl = SCM_CDR(cpl))
- res = scm_append (SCM_LIST2 (SCM_SLOT (SCM_CAR (cpl), scm_si_direct_slots),
- res));
+ res = scm_append (scm_list_2 (SCM_SLOT (SCM_CAR (cpl),
+ scm_si_direct_slots),
+ res));
/* res contains a list of slots. Remove slots which appears more than once */
return remove_duplicate_slots (scm_reverse (res), SCM_EOL, SCM_EOL);
@@ -323,7 +324,7 @@
{
init = scm_get_keyword (k_init_value, options, 0);
if (init)
- init = scm_closure (SCM_LIST2 (SCM_EOL, init), SCM_EOL);
+ init = scm_closure (scm_list_2 (SCM_EOL, init), SCM_EOL);
else
init = scm_get_keyword (k_init_thunk, options, SCM_BOOL_F);
}
@@ -353,7 +354,7 @@
SCM obj = SCM_CAR (l);
if (!SCM_KEYWORDP (obj))
- scm_misc_error (subr, "bad keyword: ~S", SCM_LIST1 (obj));
+ scm_misc_error (subr, "bad keyword: ~S", scm_list_1 (obj));
else if (SCM_EQ_P (obj, key))
return SCM_CADR (l);
else
@@ -379,7 +380,7 @@
SCM_ASSERT (SCM_KEYWORDP (key), key, SCM_ARG1, FUNC_NAME);
len = scm_ilength (l);
if (len < 0 || len % 2 == 1)
- scm_misc_error (FUNC_NAME, "Bad keyword-value list: ~S", SCM_LIST1 (l));
+ scm_misc_error (FUNC_NAME, "Bad keyword-value list: ~S", scm_list_1 (l));
return scm_i_get_keyword (key, l, len, default_value, FUNC_NAME);
}
@@ -422,7 +423,7 @@
long n = scm_ilength (SCM_CDR (slot_name));
if (n & 1) /* odd or -1 */
SCM_MISC_ERROR ("class contains bogus slot definition: ~S",
- SCM_LIST1 (slot_name));
+ scm_list_1 (slot_name));
tmp = scm_i_get_keyword (k_init_keyword,
SCM_CDR (slot_name),
n,
@@ -434,7 +435,7 @@
/* an initarg was provided for this slot */
if (!SCM_KEYWORDP (tmp))
SCM_MISC_ERROR ("initarg must be a keyword. It was ~S",
- SCM_LIST1 (tmp));
+ scm_list_1 (tmp));
slot_value = scm_i_get_keyword (tmp,
initargs,
n_initargs,
@@ -487,12 +488,12 @@
nfields = SCM_SLOT (class, scm_si_nfields);
if (!SCM_INUMP (nfields) || SCM_INUM (nfields) < 0)
SCM_MISC_ERROR ("bad value in nfields slot: ~S",
- SCM_LIST1 (nfields));
+ scm_list_1 (nfields));
n = 2 * SCM_INUM (nfields);
if (n < sizeof (SCM_CLASS_CLASS_LAYOUT) - 1
&& SCM_SUBCLASSP (class, scm_class_class))
SCM_MISC_ERROR ("class object doesn't have enough fields: ~S",
- SCM_LIST1 (nfields));
+ scm_list_1 (nfields));
s = n > 0 ? scm_must_malloc (n, FUNC_NAME) : 0;
for (i = 0; i < n; i += 2)
@@ -606,7 +607,7 @@
/* Initialize its slots */
#if 0
- cpl = compute_cpl (dsupers, SCM_LIST1(z));
+ cpl = compute_cpl (dsupers, scm_list_1 (z));
#endif
SCM_SET_SLOT (z, scm_si_direct_supers, dsupers);
cpl = compute_cpl (z);
@@ -661,47 +662,47 @@
build_class_class_slots ()
{
return maplist (
- scm_cons (SCM_LIST3 (scm_str2symbol ("layout"),
- k_class,
- scm_class_protected_read_only),
- scm_cons (SCM_LIST3 (scm_str2symbol ("vcell"),
- k_class,
- scm_class_opaque),
- scm_cons (SCM_LIST3 (scm_str2symbol ("vtable"),
- k_class,
- scm_class_self),
+ scm_cons (scm_list_3 (scm_str2symbol ("layout"),
+ k_class,
+ scm_class_protected_read_only),
+ scm_cons (scm_list_3 (scm_str2symbol ("vcell"),
+ k_class,
+ scm_class_opaque),
+ scm_cons (scm_list_3 (scm_str2symbol ("vtable"),
+ k_class,
+ scm_class_self),
scm_cons (scm_str2symbol ("print"),
- scm_cons (SCM_LIST3 (scm_str2symbol ("procedure"),
- k_class,
- scm_class_protected_opaque),
- scm_cons (SCM_LIST3 (scm_str2symbol ("setter"),
- k_class,
- scm_class_protected_opaque),
+ scm_cons (scm_list_3 (scm_str2symbol ("procedure"),
+ k_class,
+ scm_class_protected_opaque),
+ scm_cons (scm_list_3 (scm_str2symbol ("setter"),
+ k_class,
+ scm_class_protected_opaque),
scm_cons (scm_str2symbol ("redefined"),
- scm_cons (SCM_LIST3 (scm_str2symbol ("h0"),
- k_class,
- scm_class_int),
- scm_cons (SCM_LIST3 (scm_str2symbol ("h1"),
- k_class,
- scm_class_int),
- scm_cons (SCM_LIST3 (scm_str2symbol ("h2"),
- k_class,
- scm_class_int),
- scm_cons (SCM_LIST3 (scm_str2symbol ("h3"),
- k_class,
- scm_class_int),
- scm_cons (SCM_LIST3 (scm_str2symbol ("h4"),
- k_class,
- scm_class_int),
- scm_cons (SCM_LIST3 (scm_str2symbol ("h5"),
- k_class,
- scm_class_int),
- scm_cons (SCM_LIST3 (scm_str2symbol ("h6"),
- k_class,
- scm_class_int),
- scm_cons (SCM_LIST3 (scm_str2symbol ("h7"),
- k_class,
- scm_class_int),
+ scm_cons (scm_list_3 (scm_str2symbol ("h0"),
+ k_class,
+ scm_class_int),
+ scm_cons (scm_list_3 (scm_str2symbol ("h1"),
+ k_class,
+ scm_class_int),
+ scm_cons (scm_list_3 (scm_str2symbol ("h2"),
+ k_class,
+ scm_class_int),
+ scm_cons (scm_list_3 (scm_str2symbol ("h3"),
+ k_class,
+ scm_class_int),
+ scm_cons (scm_list_3 (scm_str2symbol ("h4"),
+ k_class,
+ scm_class_int),
+ scm_cons (scm_list_3 (scm_str2symbol ("h5"),
+ k_class,
+ scm_class_int),
+ scm_cons (scm_list_3 (scm_str2symbol ("h6"),
+ k_class,
+ scm_class_int),
+ scm_cons (scm_list_3 (scm_str2symbol ("h7"),
+ k_class,
+ scm_class_int),
scm_cons (scm_str2symbol ("name"),
scm_cons (scm_str2symbol ("direct-supers"),
scm_cons (scm_str2symbol ("direct-slots"),
@@ -763,16 +764,16 @@
name = scm_str2symbol ("<object>");
scm_class_object = scm_permanent_object (scm_basic_make_class
(scm_class_class,
name,
- SCM_LIST1
(scm_class_top),
+ scm_list_1
(scm_class_top),
SCM_EOL));
DEFVAR (name, scm_class_object);
/* <top> <object> and <class> were partially initialized. Correct them here
*/
- SCM_SET_SLOT (scm_class_object, scm_si_direct_subclasses, SCM_LIST1
(scm_class_class));
+ SCM_SET_SLOT (scm_class_object, scm_si_direct_subclasses, scm_list_1
(scm_class_class));
- SCM_SET_SLOT (scm_class_class, scm_si_direct_supers, SCM_LIST1
(scm_class_object));
- SCM_SET_SLOT (scm_class_class, scm_si_cpl, SCM_LIST3 (scm_class_class,
scm_class_object, scm_class_top));
+ SCM_SET_SLOT (scm_class_class, scm_si_direct_supers, scm_list_1
(scm_class_object));
+ SCM_SET_SLOT (scm_class_class, scm_si_cpl, scm_list_3 (scm_class_class,
scm_class_object, scm_class_top));
}
/******************************************************************************/
@@ -1065,7 +1066,7 @@
if (!SCM_CLOSUREP (code))
return SCM_SUBRF (code) (obj);
env = SCM_EXTEND_ENV (SCM_CLOSURE_FORMALS (code),
- SCM_LIST1 (obj),
+ scm_list_1 (obj),
SCM_ENV (code));
/* Evaluate the closure body */
return scm_eval_body (SCM_CDR (SCM_CODE (code)), env);
@@ -1104,7 +1105,7 @@
else
{
env = SCM_EXTEND_ENV (SCM_CLOSURE_FORMALS (code),
- SCM_LIST2 (obj, value),
+ scm_list_2 (obj, value),
SCM_ENV (code));
/* Evaluate the closure body */
scm_eval_body (SCM_CDR (SCM_CODE (code)), env);
@@ -1521,7 +1522,7 @@
{
if (!burnin (obj))
scm_internal_dynamic_wind (go_to_hell, purgatory, go_to_heaven,
- (void *) SCM_LIST2 (obj, new_class),
+ (void *) scm_list_2 (obj, new_class),
(void *) obj);
}
@@ -1552,10 +1553,12 @@
SCM
scm_make_method_cache (SCM gf)
{
- return SCM_LIST5 (SCM_IM_DISPATCH, scm_sym_args, SCM_MAKINUM (1),
- scm_c_make_vector (SCM_INITIAL_MCACHE_SIZE,
- list_of_no_method),
- gf);
+ return scm_list_5 (SCM_IM_DISPATCH,
+ scm_sym_args,
+ SCM_MAKINUM (1),
+ scm_c_make_vector (SCM_INITIAL_MCACHE_SIZE,
+ list_of_no_method),
+ gf);
}
static void
@@ -1616,9 +1619,9 @@
SCM_ASSERT (scm_subr_p (subr) && SCM_SUBR_GENERIC (subr),
subr, SCM_ARGn, FUNC_NAME);
*SCM_SUBR_GENERIC (subr)
- = scm_make (SCM_LIST3 (scm_class_generic,
- k_name,
- SCM_SNAME (subr)));
+ = scm_make (scm_list_3 (scm_class_generic,
+ k_name,
+ SCM_SNAME (subr)));
subrs = SCM_CDR (subrs);
}
return SCM_UNSPECIFIED;
@@ -1915,7 +1918,7 @@
x = SCM_CDR (x);
gf = SCM_XEVALCAR (x, env);
SCM_VALIDATE_PUREGENERIC (SCM_ARG4, gf);
- return SCM_LIST5 (SCM_IM_DISPATCH, args, n, v, gf);
+ return scm_list_5 (SCM_IM_DISPATCH, args, n, v, gf);
}
#undef FUNC_NAME
@@ -2003,13 +2006,13 @@
{
#ifdef USE_THREADS
z = scm_make_struct (class, SCM_INUM0,
- SCM_LIST4 (SCM_EOL,
- SCM_INUM0,
- SCM_BOOL_F,
- scm_make_mutex ()));
+ scm_list_4 (SCM_EOL,
+ SCM_INUM0,
+ SCM_BOOL_F,
+ scm_make_mutex ()));
#else
z = scm_make_struct (class, SCM_INUM0,
- SCM_LIST3 (SCM_EOL, SCM_INUM0, SCM_BOOL_F));
+ scm_list_3 (SCM_EOL, SCM_INUM0, SCM_BOOL_F));
#endif
scm_set_procedure_property_x (z, scm_sym_name,
scm_get_keyword (k_name,
@@ -2092,7 +2095,7 @@
gf = SCM_CAR(l); l = SCM_CDR(l);
SCM_VALIDATE_GENERIC (1, gf);
if (SCM_NULLP (SCM_SLOT (gf, scm_si_methods)))
- SCM_MISC_ERROR ("no methods for generic ~S", SCM_LIST1 (gf));
+ SCM_MISC_ERROR ("no methods for generic ~S", scm_list_1 (gf));
return scm_compute_applicable_methods (gf, l, len - 1, 1);
}
@@ -2139,7 +2142,7 @@
tmp,
SCM_CONSP (super)
? super
- : SCM_LIST1 (super),
+ : scm_list_1 (super),
slots));
DEFVAR(tmp, *var);
}
@@ -2151,30 +2154,30 @@
create_standard_classes (void)
{
SCM slots;
- SCM method_slots = SCM_LIST4 (scm_str2symbol ("generic-function"),
- scm_str2symbol ("specializers"),
- scm_str2symbol ("procedure"),
- scm_str2symbol ("code-table"));
- SCM amethod_slots = SCM_LIST1 (SCM_LIST3 (scm_str2symbol ("slot-definition"),
- k_init_keyword,
- k_slot_definition));
+ SCM method_slots = scm_list_4 (scm_str2symbol ("generic-function"),
+ scm_str2symbol ("specializers"),
+ scm_str2symbol ("procedure"),
+ scm_str2symbol ("code-table"));
+ SCM amethod_slots = scm_list_1 (scm_list_3 (scm_str2symbol
("slot-definition"),
+ k_init_keyword,
+ k_slot_definition));
#ifdef USE_THREADS
- SCM mutex_slot = SCM_LIST1 (scm_str2symbol ("make-mutex"));
+ SCM mutex_slot = scm_list_1 (scm_str2symbol ("make-mutex"));
#else
SCM mutex_slot = SCM_BOOL_F;
#endif
- SCM gf_slots = SCM_LIST4 (scm_str2symbol ("methods"),
- SCM_LIST3 (scm_str2symbol ("n-specialized"),
- k_init_value,
- SCM_INUM0),
- SCM_LIST3 (scm_str2symbol ("used-by"),
- k_init_value,
- SCM_BOOL_F),
- SCM_LIST3 (scm_str2symbol ("cache-mutex"),
- k_init_thunk,
- scm_closure (SCM_LIST2 (SCM_EOL,
- mutex_slot),
- SCM_EOL)));
+ SCM gf_slots = scm_list_4 (scm_str2symbol ("methods"),
+ scm_list_3 (scm_str2symbol ("n-specialized"),
+ k_init_value,
+ SCM_INUM0),
+ scm_list_3 (scm_str2symbol ("used-by"),
+ k_init_value,
+ SCM_BOOL_F),
+ scm_list_3 (scm_str2symbol ("cache-mutex"),
+ k_init_thunk,
+ scm_closure (scm_list_2 (SCM_EOL,
+ mutex_slot),
+ SCM_EOL)));
/* Foreign class slot classes */
make_stdcls (&scm_class_foreign_slot, "<foreign-slot>",
@@ -2187,15 +2190,15 @@
scm_class_class, scm_class_foreign_slot, SCM_EOL);
make_stdcls (&scm_class_self, "<self-slot>",
scm_class_class,
- SCM_LIST2 (scm_class_foreign_slot, scm_class_read_only),
+ scm_list_2 (scm_class_foreign_slot, scm_class_read_only),
SCM_EOL);
make_stdcls (&scm_class_protected_opaque, "<protected-opaque-slot>",
scm_class_class,
- SCM_LIST2 (scm_class_protected, scm_class_opaque),
+ scm_list_2 (scm_class_protected, scm_class_opaque),
SCM_EOL);
make_stdcls (&scm_class_protected_read_only, "<protected-read-only-slot>",
scm_class_class,
- SCM_LIST2 (scm_class_protected, scm_class_read_only),
+ scm_list_2 (scm_class_protected, scm_class_read_only),
SCM_EOL);
make_stdcls (&scm_class_scm, "<scm-slot>",
scm_class_class, scm_class_protected, SCM_EOL);
@@ -2216,12 +2219,12 @@
make_stdcls (&scm_class_foreign_class, "<foreign-class>",
scm_class_class, scm_class_class,
- SCM_LIST2 (SCM_LIST3 (scm_str2symbol ("constructor"),
- k_class,
- scm_class_opaque),
- SCM_LIST3 (scm_str2symbol ("destructor"),
- k_class,
- scm_class_opaque)));
+ scm_list_2 (scm_list_3 (scm_str2symbol ("constructor"),
+ k_class,
+ scm_class_opaque),
+ scm_list_3 (scm_str2symbol ("destructor"),
+ k_class,
+ scm_class_opaque)));
make_stdcls (&scm_class_foreign_object, "<foreign-object>",
scm_class_foreign_class, scm_class_object, SCM_EOL);
SCM_SET_CLASS_FLAGS (scm_class_foreign_object, SCM_CLASSF_FOREIGN);
@@ -2253,16 +2256,16 @@
SCM_SET_CLASS_FLAGS (scm_class_generic, SCM_CLASSF_PURE_GENERIC);
make_stdcls (&scm_class_generic_with_setter, "<generic-with-setter>",
scm_class_entity_class,
- SCM_LIST2 (scm_class_generic, scm_class_entity_with_setter),
+ scm_list_2 (scm_class_generic, scm_class_entity_with_setter),
SCM_EOL);
#if 0
/* Patch cpl since compute_cpl doesn't support multiple inheritance. */
SCM_SET_SLOT (scm_class_generic_with_setter, scm_si_cpl,
- scm_append (SCM_LIST3 (SCM_LIST2 (scm_class_generic_with_setter,
- scm_class_generic),
- SCM_SLOT (scm_class_entity_with_setter,
- scm_si_cpl),
- SCM_EOL)));
+ scm_append (scm_list_3 (scm_list_2 (scm_class_generic_with_setter,
+ scm_class_generic),
+ SCM_SLOT (scm_class_entity_with_setter,
+ scm_si_cpl),
+ SCM_EOL)));
#endif
SCM_SET_CLASS_FLAGS (scm_class_generic_with_setter, SCM_CLASSF_PURE_GENERIC);
@@ -2309,7 +2312,7 @@
scm_class_class, scm_class_port, SCM_EOL);
make_stdcls (&scm_class_input_output_port, "<input-output-port>",
scm_class_class,
- SCM_LIST2 (scm_class_input_port, scm_class_output_port),
+ scm_list_2 (scm_class_input_port, scm_class_output_port),
SCM_EOL);
}
@@ -2349,7 +2352,7 @@
{
return make_class_from_template ("<%s>",
type_name,
- SCM_LIST1 (scm_class_top));
+ scm_list_1 (scm_class_top));
}
static void
@@ -2376,21 +2379,20 @@
{
SCM c, class = make_class_from_template ("<%s-port>",
type_name,
- SCM_LIST1 (scm_class_port));
+ scm_list_1 (scm_class_port));
scm_port_class[SCM_IN_PCLASS_INDEX + ptobnum]
= make_class_from_template ("<%s-input-port>",
type_name,
- SCM_LIST2 (class, scm_class_input_port));
+ scm_list_2 (class, scm_class_input_port));
scm_port_class[SCM_OUT_PCLASS_INDEX + ptobnum]
= make_class_from_template ("<%s-output-port>",
type_name,
- SCM_LIST2 (class, scm_class_output_port));
+ scm_list_2 (class, scm_class_output_port));
scm_port_class[SCM_INOUT_PCLASS_INDEX + ptobnum]
= c
= make_class_from_template ("<%s-input-output-port>",
type_name,
- SCM_LIST2 (class,
- scm_class_input_output_port));
+ scm_list_2 (class,
scm_class_input_output_port));
/* Patch cpl (since this tree is too complex for the C level compute-cpl) */
SCM_SET_SLOT (c, scm_si_cpl,
scm_cons2 (c, class, SCM_SLOT (scm_class_input_output_port,
scm_si_cpl)));
@@ -2447,7 +2449,7 @@
void * (*constructor) (SCM)
= (void * (*) (SCM)) SCM_SLOT (class, scm_si_constructor);
if (constructor == 0)
- SCM_MISC_ERROR ("Can't make instances of class ~S", SCM_LIST1 (class));
+ SCM_MISC_ERROR ("Can't make instances of class ~S", scm_list_1 (class));
return scm_wrap_object (class, constructor (initargs));
}
#undef FUNC_NAME
@@ -2469,7 +2471,7 @@
SCM name, class;
name = scm_str2symbol (s_name);
if (SCM_IMP (supers))
- supers = SCM_LIST1 (scm_class_foreign_object);
+ supers = scm_list_1 (scm_class_foreign_object);
class = scm_basic_basic_make_class (meta, name, supers, SCM_EOL);
scm_sys_inherit_magic_x (class, supers);
@@ -2513,40 +2515,42 @@
SCM get = scm_c_make_subr ("goops:get", scm_tc7_subr_1, getter);
SCM set = scm_c_make_subr ("goops:set", scm_tc7_subr_2,
setter ? setter : default_setter);
- SCM getm = scm_closure (SCM_LIST2 (SCM_LIST1 (sym_o),
- SCM_LIST2 (get, sym_o)),
+ SCM getm = scm_closure (scm_list_2 (scm_list_1 (sym_o),
+ scm_list_2 (get, sym_o)),
SCM_EOL);
- SCM setm = scm_closure (SCM_LIST2 (SCM_LIST2 (sym_o, sym_x),
- SCM_LIST3 (set, sym_o, sym_x)),
+ SCM setm = scm_closure (scm_list_2 (scm_list_2 (sym_o, sym_x),
+ scm_list_3 (set, sym_o, sym_x)),
SCM_EOL);
{
SCM name = scm_str2symbol (slot_name);
SCM aname = scm_str2symbol (accessor_name);
SCM gf = scm_ensure_accessor (aname);
- SCM slot = SCM_LIST5 (name,
- k_class, slot_class,
- setter ? k_accessor : k_getter,
- gf);
- SCM gns = SCM_LIST4 (name, SCM_BOOL_F, get, set);
-
- scm_add_method (gf, scm_make (SCM_LIST5 (scm_class_accessor,
- k_specializers,
- SCM_LIST1 (class),
- k_procedure, getm)));
+ SCM slot = scm_list_5 (name,
+ k_class,
+ slot_class,
+ setter ? k_accessor : k_getter,
+ gf);
+ SCM gns = scm_list_4 (name, SCM_BOOL_F, get, set);
+
+ scm_add_method (gf, scm_make (scm_list_5 (scm_class_accessor,
+ k_specializers,
+ scm_list_1 (class),
+ k_procedure,
+ getm)));
scm_add_method (scm_setter (gf),
- scm_make (SCM_LIST5 (scm_class_accessor,
- k_specializers,
- SCM_LIST2 (class,
- scm_class_top),
- k_procedure, setm)));
+ scm_make (scm_list_5 (scm_class_accessor,
+ k_specializers,
+ scm_list_2 (class, scm_class_top),
+ k_procedure,
+ setm)));
DEFVAR (aname, gf);
SCM_SET_SLOT (class, scm_si_slots,
- scm_append_x (SCM_LIST2 (SCM_SLOT (class, scm_si_slots),
- SCM_LIST1 (slot))));
+ scm_append_x (scm_list_2 (SCM_SLOT (class, scm_si_slots),
+ scm_list_1 (slot))));
SCM_SET_SLOT (class, scm_si_getters_n_setters,
- scm_append_x (SCM_LIST2 (SCM_SLOT (class,
scm_si_getters_n_setters),
- SCM_LIST1 (gns))));
+ scm_append_x (scm_list_2 (SCM_SLOT (class,
scm_si_getters_n_setters),
+ scm_list_1 (gns))));
}
}
{
@@ -2589,10 +2593,9 @@
SCM gf = scm_call_2 (SCM_TOP_LEVEL_LOOKUP_CLOSURE, name, SCM_BOOL_F);
if (!SCM_IS_A_P (gf, scm_class_generic_with_setter))
{
- gf = scm_make (SCM_LIST3 (scm_class_generic, k_name, name));
- gf = scm_make (SCM_LIST5 (scm_class_generic_with_setter,
- k_name, name,
- k_setter, gf));
+ gf = scm_make (scm_list_3 (scm_class_generic, k_name, name));
+ gf = scm_make (scm_list_5 (scm_class_generic_with_setter,
+ k_name, name, k_setter, gf));
}
return gf;
}
@@ -2602,7 +2605,7 @@
void
scm_add_method (SCM gf, SCM m)
{
- scm_eval (SCM_LIST3 (sym_internal_add_method_x, gf, m), scm_module_goops);
+ scm_eval (scm_list_3 (sym_internal_add_method_x, gf, m), scm_module_goops);
}
#ifdef GUILE_DEBUG
@@ -2661,7 +2664,7 @@
#include "libguile/goops.x"
#endif
- list_of_no_method = scm_permanent_object (SCM_LIST1 (sym_no_method));
+ list_of_no_method = scm_permanent_object (scm_list_1 (sym_no_method));
hell = scm_must_malloc (hell_size, "hell");
#ifdef USE_THREADS
@@ -2677,9 +2680,9 @@
{
SCM name = scm_str2symbol ("no-applicable-method");
scm_no_applicable_method
- = scm_permanent_object (scm_make (SCM_LIST3 (scm_class_generic,
- k_name,
- name)));
+ = scm_permanent_object (scm_make (scm_list_3 (scm_class_generic,
+ k_name,
+ name)));
DEFVAR (name, scm_no_applicable_method);
}
Index: guile/guile-core/libguile/gsubr.c
diff -u guile/guile-core/libguile/gsubr.c:1.39
guile/guile-core/libguile/gsubr.c:1.40
--- guile/guile-core/libguile/gsubr.c:1.39 Sat May 26 13:51:20 2001
+++ guile/guile-core/libguile/gsubr.c Wed Jun 27 18:11:58 2001
@@ -220,7 +220,7 @@
if (n > SCM_GSUBR_MAX)
scm_misc_error (FUNC_NAME,
"Function ~S has illegal arity ~S.",
- SCM_LIST2 (self, SCM_MAKINUM (n)));
+ scm_list_2 (self, SCM_MAKINUM (n)));
#endif
args = SCM_CDR (args);
for (i = 0; i < SCM_GSUBR_REQ (typ); i++) {
Index: guile/guile-core/libguile/guardians.c
diff -u guile/guile-core/libguile/guardians.c:1.35
guile/guile-core/libguile/guardians.c:1.36
--- guile/guile-core/libguile/guardians.c:1.35 Thu Jun 14 12:50:43 2001
+++ guile/guile-core/libguile/guardians.c Wed Jun 27 18:11:58 2001
@@ -230,7 +230,7 @@
{
if (DESTROYED_P (GUARDIAN (guardian)))
scm_misc_error ("guard", "attempted use of destroyed guardian: ~A",
- SCM_LIST1 (guardian));
+ scm_list_1 (guardian));
if (!SCM_UNBNDP (obj))
return scm_guard (guardian, obj,
@@ -266,7 +266,7 @@
if (throw_p)
scm_misc_error ("guard",
"object is already greedily guarded: ~A",
- SCM_LIST1 (obj));
+ scm_list_1 (obj));
else
return SCM_BOOL_F;
}
@@ -401,7 +401,8 @@
if (DESTROYED_P (g))
{
SCM_ALLOW_INTS;
- SCM_MISC_ERROR ("guardian is already destroyed: ~A", SCM_LIST1
(guardian));
+ SCM_MISC_ERROR ("guardian is already destroyed: ~A",
+ scm_list_1 (guardian));
}
if (GREEDY_P (g))
Index: guile/guile-core/libguile/hooks.c
diff -u guile/guile-core/libguile/hooks.c:1.19
guile/guile-core/libguile/hooks.c:1.20
--- guile/guile-core/libguile/hooks.c:1.19 Tue Jun 26 08:46:40 2001
+++ guile/guile-core/libguile/hooks.c Wed Jun 27 18:11:58 2001
@@ -252,7 +252,7 @@
rest = scm_delq_x (proc, SCM_HOOK_PROCEDURES (hook));
SCM_SET_HOOK_PROCEDURES (hook,
(!SCM_UNBNDP (append_p) && !SCM_FALSEP (append_p)
- ? scm_append_x (SCM_LIST2 (rest, SCM_LIST1 (proc)))
+ ? scm_append_x (scm_list_2 (rest, scm_list_1
(proc)))
: scm_cons (proc, rest)));
return SCM_UNSPECIFIED;
}
@@ -294,7 +294,7 @@
SCM_VALIDATE_HOOK (1,hook);
if (scm_ilength (args) != SCM_HOOK_ARITY (hook))
SCM_MISC_ERROR ("Hook ~S requires ~A arguments",
- SCM_LIST2 (hook,SCM_MAKINUM (SCM_HOOK_ARITY (hook))));
+ scm_list_2 (hook, SCM_MAKINUM (SCM_HOOK_ARITY (hook))));
scm_c_run_hook (hook, args);
return SCM_UNSPECIFIED;
}
Index: guile/guile-core/libguile/list.c
diff -u guile/guile-core/libguile/list.c:1.56
guile/guile-core/libguile/list.c:1.57
--- guile/guile-core/libguile/list.c:1.56 Sat May 26 13:51:20 2001
+++ guile/guile-core/libguile/list.c Wed Jun 27 18:11:58 2001
@@ -60,8 +60,54 @@
/* creating lists */
+#define SCM_I_CONS(cell,x,y) \
+do { \
+ SCM_NEWCELL (cell); \
+ SCM_SET_CELL_OBJECT_0 (cell, x); \
+ SCM_SET_CELL_OBJECT_1 (cell, y); \
+} while (0)
+
+SCM
+scm_list_1 (SCM e1)
+{
+ SCM c1;
+ SCM_I_CONS (c1, e1, SCM_EOL);
+ return c1;
+}
+
+SCM
+scm_list_2 (SCM e1, SCM e2)
+{
+ SCM c1, c2;
+ SCM_I_CONS (c2, e2, SCM_EOL);
+ SCM_I_CONS (c1, e1, c2);
+ return c1;
+}
+
+SCM
+scm_list_3 (SCM e1, SCM e2, SCM e3)
+{
+ SCM c1, c2, c3;
+ SCM_I_CONS (c3, e3, SCM_EOL);
+ SCM_I_CONS (c2, e2, c3);
+ SCM_I_CONS (c1, e1, c2);
+ return c1;
+}
+
+SCM
+scm_list_4 (SCM e1, SCM e2, SCM e3, SCM e4)
+{
+ return scm_cons2 (e1, e2, scm_list_2 (e3, e4));
+}
+
+SCM
+scm_list_5 (SCM e1, SCM e2, SCM e3, SCM e4, SCM e5)
+{
+ return scm_cons2 (e1, e2, scm_list_3 (e3, e4, e5));
+}
+
SCM
-scm_listify (SCM elt, ...)
+scm_list_n (SCM elt, ...)
{
va_list foo;
SCM answer = SCM_EOL;
@@ -286,7 +332,7 @@
tortoise = SCM_CDR(tortoise);
}
while (! SCM_EQ_P (hare, tortoise));
- SCM_MISC_ERROR ("Circular structure in position 1: ~S", SCM_LIST1 (lst));
+ SCM_MISC_ERROR ("Circular structure in position 1: ~S", scm_list_1 (lst));
}
#undef FUNC_NAME
@@ -315,7 +361,7 @@
tortoise = SCM_CDR (tortoise);
}
while (! SCM_EQ_P (hare, tortoise));
- SCM_MISC_ERROR ("Circular structure in position 1: ~S", SCM_LIST1 (lst));
+ SCM_MISC_ERROR ("Circular structure in position 1: ~S", scm_list_1 (lst));
}
#undef FUNC_NAME
Index: guile/guile-core/libguile/list.h
diff -u guile/guile-core/libguile/list.h:1.20
guile/guile-core/libguile/list.h:1.21
--- guile/guile-core/libguile/list.h:1.20 Sat May 26 13:51:20 2001
+++ guile/guile-core/libguile/list.h Wed Jun 27 18:11:58 2001
@@ -48,26 +48,13 @@
-#define SCM_LIST0 SCM_EOL
-#define SCM_LIST1(e0) scm_cons ((e0), SCM_EOL)
-#define SCM_LIST2(e0, e1) scm_cons2 ((e0), (e1), SCM_EOL)
-#define SCM_LIST3(e0, e1, e2) scm_cons ((e0), SCM_LIST2 ((e1), (e2)))
-#define SCM_LIST4(e0, e1, e2, e3)\
- scm_cons2 ((e0), (e1), SCM_LIST2 ((e2), (e3)))
-#define SCM_LIST5(e0, e1, e2, e3, e4)\
- scm_cons ((e0), SCM_LIST4 ((e1), (e2), (e3), (e4)))
-#define SCM_LIST6(e0, e1, e2, e3, e4, e5)\
- scm_cons2 ((e0), (e1), SCM_LIST4 ((e2), (e3), (e4), (e5)))
-#define SCM_LIST7(e0, e1, e2, e3, e4, e5, e6)\
- scm_cons ((e0), SCM_LIST6 ((e1), (e2), (e3), (e4), (e5), (e6)))
-#define SCM_LIST8(e0, e1, e2, e3, e4, e5, e6, e7)\
- scm_cons2 ((e0), (e1), SCM_LIST6 ((e2), (e3), (e4), (e5), (e6), (e7)))
-#define SCM_LIST9(e0, e1, e2, e3, e4, e5, e6, e7, e8)\
- scm_cons ((e0),\
- SCM_LIST8 ((e1), (e2), (e3), (e4), (e5), (e6), (e7), (e8)))
-
+extern SCM scm_list_1 (SCM e1);
+extern SCM scm_list_2 (SCM e1, SCM e2);
+extern SCM scm_list_3 (SCM e1, SCM e2, SCM e3);
+extern SCM scm_list_4 (SCM e1, SCM e2, SCM e3, SCM e4);
+extern SCM scm_list_5 (SCM e1, SCM e2, SCM e3, SCM e4, SCM e5);
+extern SCM scm_list_n (SCM elt, ...);
extern SCM scm_list_head (SCM lst, SCM k);
-extern SCM scm_listify (SCM elt, ...);
extern SCM scm_list (SCM objs);
extern SCM scm_cons_star (SCM arg, SCM objs);
extern SCM scm_null_p (SCM x);
@@ -102,6 +89,26 @@
#if (SCM_DEBUG_DEPRECATED == 0)
+
+#define SCM_LIST0 SCM_EOL
+#define SCM_LIST1(e0) scm_cons ((e0), SCM_EOL)
+#define SCM_LIST2(e0, e1) scm_cons2 ((e0), (e1), SCM_EOL)
+#define SCM_LIST3(e0, e1, e2) scm_cons ((e0), SCM_LIST2 ((e1), (e2)))
+#define SCM_LIST4(e0, e1, e2, e3)\
+ scm_cons2 ((e0), (e1), SCM_LIST2 ((e2), (e3)))
+#define SCM_LIST5(e0, e1, e2, e3, e4)\
+ scm_cons ((e0), SCM_LIST4 ((e1), (e2), (e3), (e4)))
+#define SCM_LIST6(e0, e1, e2, e3, e4, e5)\
+ scm_cons2 ((e0), (e1), SCM_LIST4 ((e2), (e3), (e4), (e5)))
+#define SCM_LIST7(e0, e1, e2, e3, e4, e5, e6)\
+ scm_cons ((e0), SCM_LIST6 ((e1), (e2), (e3), (e4), (e5), (e6)))
+#define SCM_LIST8(e0, e1, e2, e3, e4, e5, e6, e7)\
+ scm_cons2 ((e0), (e1), SCM_LIST6 ((e2), (e3), (e4), (e5), (e6), (e7)))
+#define SCM_LIST9(e0, e1, e2, e3, e4, e5, e6, e7, e8)\
+ scm_cons ((e0),\
+ SCM_LIST8 ((e1), (e2), (e3), (e4), (e5), (e6), (e7), (e8)))
+
+#define scm_listify scm_list_n
extern SCM scm_sloppy_memq (SCM x, SCM lst);
extern SCM scm_sloppy_memv (SCM x, SCM lst);
Index: guile/guile-core/libguile/load.c
diff -u guile/guile-core/libguile/load.c:1.63
guile/guile-core/libguile/load.c:1.64
--- guile/guile-core/libguile/load.c:1.63 Tue Jun 26 08:46:40 2001
+++ guile/guile-core/libguile/load.c Wed Jun 27 18:11:58 2001
@@ -243,9 +243,9 @@
SCM path = SCM_EOL;
#ifdef SCM_LIBRARY_DIR
- path = SCM_LIST3 (scm_makfrom0str (SCM_SITE_DIR),
- scm_makfrom0str (SCM_LIBRARY_DIR),
- scm_makfrom0str (SCM_PKGDATA_DIR));
+ path = scm_list_3 (scm_makfrom0str (SCM_SITE_DIR),
+ scm_makfrom0str (SCM_LIBRARY_DIR),
+ scm_makfrom0str (SCM_PKGDATA_DIR));
#endif /* SCM_LIBRARY_DIR */
path = scm_internal_parse_path (getenv ("GUILE_LOAD_PATH"), path);
@@ -453,7 +453,7 @@
SCM_MISC_ERROR ((absolute
? "Unable to load file ~S"
: "Unable to find file ~S in load path"),
- SCM_LIST1 (filename));
+ scm_list_1 (filename));
}
return scm_primitive_load (full_filename);
@@ -507,12 +507,12 @@
void
scm_init_load ()
{
- scm_listofnullstr = scm_permanent_object (SCM_LIST1 (scm_nullstr));
+ scm_listofnullstr = scm_permanent_object (scm_list_1 (scm_nullstr));
scm_loc_load_path = SCM_VARIABLE_LOC (scm_c_define ("%load-path", SCM_EOL));
scm_loc_load_extensions
= SCM_VARIABLE_LOC (scm_c_define ("%load-extensions",
- SCM_LIST2 (scm_makfrom0str (".scm"),
- scm_nullstr)));
+ scm_list_2 (scm_makfrom0str (".scm"),
+ scm_nullstr)));
scm_loc_load_hook = SCM_VARIABLE_LOC (scm_c_define ("%load-hook",
SCM_BOOL_F));
init_build_info ();
Index: guile/guile-core/libguile/modules.c
diff -u guile/guile-core/libguile/modules.c:1.30
guile/guile-core/libguile/modules.c:1.31
--- guile/guile-core/libguile/modules.c:1.30 Tue Jun 26 08:46:40 2001
+++ guile/guile-core/libguile/modules.c Wed Jun 27 18:11:58 2001
@@ -170,7 +170,7 @@
void (*init)(void *), void *data)
{
SCM module = scm_call_1 (SCM_VARIABLE_REF (process_define_module_var),
- SCM_LIST1 (convert_module_name (name)));
+ scm_list_1 (convert_module_name (name)));
if (init)
scm_c_call_with_current_module (module, (SCM (*)(void*))init, data);
return module;
@@ -180,7 +180,7 @@
scm_c_use_module (const char *name)
{
scm_call_1 (SCM_VARIABLE_REF (process_use_modules_var),
- SCM_LIST1 (convert_module_name (name)));
+ scm_list_1 (convert_module_name (name)));
}
static SCM module_export_x_var;
@@ -440,7 +440,7 @@
}
if (var != SCM_BOOL_F && !SCM_VARIABLEP (var))
- SCM_MISC_ERROR ("~S is not bound to a variable", SCM_LIST1 (sym));
+ SCM_MISC_ERROR ("~S is not bound to a variable", scm_list_1 (sym));
return var;
}
@@ -461,7 +461,7 @@
var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
if (SCM_FALSEP (var))
- SCM_MISC_ERROR ("unbound variable: ~S", SCM_LIST1 (sym));
+ SCM_MISC_ERROR ("unbound variable: ~S", scm_list_1 (sym));
return var;
}
#undef FUNC_NAME
@@ -478,7 +478,7 @@
SCM var =
scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_F);
if (SCM_FALSEP (var))
- scm_misc_error ("scm_lookup", "unbound variable: ~S", SCM_LIST1 (sym));
+ scm_misc_error ("scm_lookup", "unbound variable: ~S", scm_list_1 (sym));
return var;
}
@@ -639,7 +639,7 @@
#if SCM_DEBUG_DEPRECATED == 0
- module_prefix = PERM (SCM_LIST2 (scm_sym_app, scm_sym_modules));
+ module_prefix = PERM (scm_list_2 (scm_sym_app, scm_sym_modules));
make_modules_in_var = PERM (scm_c_lookup ("make-modules-in"));
root_module_lookup_closure =
PERM (scm_module_lookup_closure (SCM_VARIABLE_REF (the_root_module_var)));
@@ -669,7 +669,7 @@
if (SCM_EQ_P (SCM_CAR (name), scm_sym_app))
return name;
else
- return scm_append (SCM_LIST2 (module_prefix, name));
+ return scm_append (scm_list_2 (module_prefix, name));
}
SCM
Index: guile/guile-core/libguile/net_db.c
diff -u guile/guile-core/libguile/net_db.c:1.61
guile/guile-core/libguile/net_db.c:1.62
--- guile/guile-core/libguile/net_db.c:1.61 Tue Jun 26 10:53:09 2001
+++ guile/guile-core/libguile/net_db.c Wed Jun 27 18:11:58 2001
@@ -260,7 +260,7 @@
entry = getnetbyaddr (netnum, AF_INET);
}
if (!entry)
- SCM_SYSERROR_MSG ("no such network ~A", SCM_LIST1 (net), errno);
+ SCM_SYSERROR_MSG ("no such network ~A", scm_list_1 (net), errno);
ve[0] = scm_mem2string (entry->n_name, strlen (entry->n_name));
ve[1] = scm_makfromstrs (-1, entry->n_aliases);
ve[2] = SCM_MAKINUM (entry->n_addrtype + 0L);
@@ -310,7 +310,7 @@
entry = getprotobynumber (protonum);
}
if (!entry)
- SCM_SYSERROR_MSG ("no such protocol ~A", SCM_LIST1 (protocol), errno);
+ SCM_SYSERROR_MSG ("no such protocol ~A", scm_list_1 (protocol), errno);
ve[0] = scm_mem2string (entry->p_name, strlen (entry->p_name));
ve[1] = scm_makfromstrs (-1, entry->p_aliases);
ve[2] = SCM_MAKINUM (entry->p_proto + 0L);
@@ -374,7 +374,7 @@
entry = getservbyport (htons (SCM_INUM (name)), SCM_STRING_CHARS
(protocol));
}
if (!entry)
- SCM_SYSERROR_MSG("no such service ~A", SCM_LIST1 (name), errno);
+ SCM_SYSERROR_MSG("no such service ~A", scm_list_1 (name), errno);
return scm_return_entry (entry);
}
#undef FUNC_NAME
Index: guile/guile-core/libguile/objects.c
diff -u guile/guile-core/libguile/objects.c:1.62
guile/guile-core/libguile/objects.c:1.63
--- guile/guile-core/libguile/objects.c:1.62 Tue Jun 26 03:59:34 2001
+++ guile/guile-core/libguile/objects.c Wed Jun 27 18:11:59 2001
@@ -344,19 +344,19 @@
SCM
scm_call_generic_1 (SCM gf, SCM a1)
{
- return scm_apply_generic (gf, SCM_LIST1 (a1));
+ return scm_apply_generic (gf, scm_list_1 (a1));
}
SCM
scm_call_generic_2 (SCM gf, SCM a1, SCM a2)
{
- return scm_apply_generic (gf, SCM_LIST2 (a1, a2));
+ return scm_apply_generic (gf, scm_list_2 (a1, a2));
}
SCM
scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3)
{
- return scm_apply_generic (gf, SCM_LIST3 (a1, a2, a3));
+ return scm_apply_generic (gf, scm_list_3 (a1, a2, a3));
}
SCM_DEFINE (scm_entity_p, "entity?", 1, 0, 0,
@@ -460,7 +460,7 @@
SCM layout = scm_make_struct_layout (layout_string);
c = scm_make_struct (meta,
SCM_INUM0,
- SCM_LIST4 (layout, SCM_BOOL_F, SCM_EOL, SCM_EOL));
+ scm_list_4 (layout, SCM_BOOL_F, SCM_EOL, SCM_EOL));
SCM_SET_CLASS_FLAGS (c, flags);
return c;
}
@@ -493,7 +493,7 @@
/* Convert symbol->string */
pl = scm_mem2string (SCM_SYMBOL_CHARS (pl), SCM_SYMBOL_LENGTH (pl));
return scm_i_make_class_object (SCM_STRUCT_VTABLE (class),
- scm_string_append (SCM_LIST2 (pl, layout)),
+ scm_string_append (scm_list_2 (pl, layout)),
SCM_CLASS_FLAGS (class));
}
#undef FUNC_NAME
@@ -503,16 +503,16 @@
{
SCM ms = scm_makfrom0str (SCM_METACLASS_STANDARD_LAYOUT);
SCM mt = scm_make_vtable_vtable (ms, SCM_INUM0,
- SCM_LIST3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
+ scm_list_3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
SCM os = scm_makfrom0str (SCM_METACLASS_OPERATOR_LAYOUT);
SCM ot = scm_make_vtable_vtable (os, SCM_INUM0,
- SCM_LIST3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
+ scm_list_3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
SCM es = scm_makfrom0str (SCM_ENTITY_LAYOUT);
SCM el = scm_make_struct_layout (es);
SCM et = scm_make_struct (mt, SCM_INUM0,
- SCM_LIST4 (el, SCM_BOOL_F, SCM_EOL, SCM_EOL));
+ scm_list_4 (el, SCM_BOOL_F, SCM_EOL, SCM_EOL));
scm_c_define ("<class>", mt);
scm_metaclass_standard = mt;
Index: guile/guile-core/libguile/options.c
diff -u guile/guile-core/libguile/options.c:1.33
guile/guile-core/libguile/options.c:1.34
--- guile/guile-core/libguile/options.c:1.33 Thu Jun 14 12:50:43 2001
+++ guile/guile-core/libguile/options.c Wed Jun 27 18:11:59 2001
@@ -190,7 +190,7 @@
#ifndef SCM_RECKLESS
scm_must_free ((char *) flags);
scm_misc_error (s, "Unknown mode flag: ~S",
- SCM_LIST1 (SCM_CAR (new_mode)));
+ scm_list_1 (SCM_CAR (new_mode)));
#endif
cont:
new_mode = SCM_CDR (new_mode);
Index: guile/guile-core/libguile/pairs.c
diff -u guile/guile-core/libguile/pairs.c:1.24
guile/guile-core/libguile/pairs.c:1.25
--- guile/guile-core/libguile/pairs.c:1.24 Fri Jun 8 03:02:33 2001
+++ guile/guile-core/libguile/pairs.c Wed Jun 27 18:11:59 2001
@@ -68,7 +68,7 @@
{
running = 1;
scm_simple_format (scm_current_error_port (),
- message, SCM_LIST1 (non_pair));
+ message, scm_list_1 (non_pair));
abort ();
}
}
Index: guile/guile-core/libguile/ports.c
diff -u guile/guile-core/libguile/ports.c:1.152
guile/guile-core/libguile/ports.c:1.153
--- guile/guile-core/libguile/ports.c:1.152 Tue Jun 26 10:53:09 2001
+++ guile/guile-core/libguile/ports.c Wed Jun 27 18:11:59 2001
@@ -483,7 +483,7 @@
long i = p->entry;
if (i >= scm_t_portable_size)
- SCM_MISC_ERROR ("Port not in table: ~S", SCM_LIST1 (port));
+ SCM_MISC_ERROR ("Port not in table: ~S", scm_list_1 (port));
if (p->putback_buf)
scm_must_free (p->putback_buf);
scm_must_free (p);
Index: guile/guile-core/libguile/print.c
diff -u guile/guile-core/libguile/print.c:1.127
guile/guile-core/libguile/print.c:1.128
--- guile/guile-core/libguile/print.c:1.127 Tue Jun 26 08:46:40 2001
+++ guile/guile-core/libguile/print.c Wed Jun 27 18:11:59 2001
@@ -973,16 +973,15 @@
start = p + 1;
continue;
default:
- scm_misc_error (s_scm_simple_format,
- "FORMAT: Unsupported format option ~~~A - use (ice-9 format)
instead",
- SCM_LIST1 (SCM_MAKE_CHAR (*p)));
+ SCM_MISC_ERROR ("FORMAT: Unsupported format option ~~~A - use
(ice-9 format) instead",
+ scm_list_1 (SCM_MAKE_CHAR (*p)));
}
if (!SCM_CONSP (args))
- scm_misc_error (s_scm_simple_format, "FORMAT: Missing argument for
~~~A",
- SCM_LIST1 (SCM_MAKE_CHAR (*p)));
+ SCM_MISC_ERROR ("FORMAT: Missing argument for ~~~A",
+ scm_list_1 (SCM_MAKE_CHAR (*p)));
scm_lfwrite (start, p - start - 1, destination);
scm_prin1 (SCM_CAR (args), destination, writingp);
@@ -992,8 +991,8 @@
scm_lfwrite (start, p - start, destination);
if (args != SCM_EOL)
- scm_misc_error (s_scm_simple_format,
- "FORMAT: ~A superfluous arguments", SCM_LIST1 (scm_length
(args)));
+ SCM_MISC_ERROR ("FORMAT: ~A superfluous arguments",
+ scm_list_1 (scm_length (args)));
if (fReturnString)
answer = scm_strport_to_string (destination);
@@ -1110,7 +1109,7 @@
scm_init_opts (scm_print_options, scm_print_opts, SCM_N_PRINT_OPTIONS);
vtable = scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL);
layout = scm_make_struct_layout (scm_makfrom0str (SCM_PRINT_STATE_LAYOUT));
- type = scm_make_struct (vtable, SCM_INUM0, SCM_LIST1 (layout));
+ type = scm_make_struct (vtable, SCM_INUM0, scm_list_1 (layout));
scm_set_struct_vtable_name_x (type, scm_str2symbol ("print-state"));
print_state_pool = scm_permanent_object (scm_cons (type, SCM_EOL));
Index: guile/guile-core/libguile/procprop.c
diff -u guile/guile-core/libguile/procprop.c:1.36
guile/guile-core/libguile/procprop.c:1.37
--- guile/guile-core/libguile/procprop.c:1.36 Thu Apr 19 07:46:01 2001
+++ guile/guile-core/libguile/procprop.c Wed Jun 27 18:11:59 2001
@@ -155,9 +155,7 @@
default:
return SCM_BOOL_F;
}
- return SCM_LIST3 (SCM_MAKINUM (a),
- SCM_MAKINUM (o),
- SCM_BOOL(r));
+ return scm_list_3 (SCM_MAKINUM (a), SCM_MAKINUM (o), SCM_BOOL(r));
}
static SCM
@@ -167,7 +165,7 @@
answer = scm_assoc (proc, scm_stand_in_procs);
if (SCM_FALSEP (answer))
{
- answer = scm_closure (SCM_LIST2 (SCM_EOL, SCM_BOOL_F), SCM_EOL);
+ answer = scm_closure (scm_list_2 (SCM_EOL, SCM_BOOL_F), SCM_EOL);
scm_stand_in_procs = scm_acons (proc, answer, scm_stand_in_procs);
}
else
Index: guile/guile-core/libguile/read.c
diff -u guile/guile-core/libguile/read.c:1.73
guile/guile-core/libguile/read.c:1.74
--- guile/guile-core/libguile/read.c:1.73 Wed Jun 27 06:15:20 2001
+++ guile/guile-core/libguile/read.c Wed Jun 27 18:11:59 2001
@@ -153,7 +153,7 @@
if (!SCM_FALSEP (SCM_FILENAME (port)))
scm_misc_error (eoferr,
"end of file in ~A",
- SCM_LIST1 (SCM_FILENAME (port)));
+ scm_list_1 (SCM_FILENAME (port)));
else
scm_misc_error (eoferr, "end of file", SCM_EOL);
}
@@ -457,7 +457,7 @@
}
unkshrp:
scm_misc_error (s_scm_read, "Unknown # object: ~S",
- SCM_LIST1 (SCM_MAKE_CHAR (c)));
+ scm_list_1 (SCM_MAKE_CHAR (c)));
}
case '"':
Index: guile/guile-core/libguile/script.c
diff -u guile/guile-core/libguile/script.c:1.42
guile/guile-core/libguile/script.c:1.43
--- guile/guile-core/libguile/script.c:1.42 Wed May 23 17:50:48 2001
+++ guile/guile-core/libguile/script.c Wed Jun 27 18:11:59 2001
@@ -565,11 +565,8 @@
if (scm_ilength (srfis) <= 0)
scm_shell_usage (1, "invalid SRFI specification");
srfis = scm_reverse_x (srfis, SCM_UNDEFINED);
- tail = scm_cons (scm_listify
- (sym_use_srfis,
- scm_listify (scm_sym_quote,
- srfis, SCM_UNDEFINED),
- SCM_UNDEFINED),
+ tail = scm_cons (scm_list_2 (sym_use_srfis,
+ scm_list_2 (scm_sym_quote, srfis)),
tail);
}
Index: guile/guile-core/libguile/smob.c
diff -u guile/guile-core/libguile/smob.c:1.46
guile/guile-core/libguile/smob.c:1.47
--- guile/guile-core/libguile/smob.c:1.46 Thu Jun 14 12:50:43 2001
+++ guile/guile-core/libguile/smob.c Wed Jun 27 18:11:59 2001
@@ -200,7 +200,7 @@
static SCM
scm_smob_apply_1_001 (SCM smob, SCM a1)
{
- return SCM_SMOB_APPLY1 (smob, SCM_LIST1 (a1));
+ return SCM_SMOB_APPLY1 (smob, scm_list_1 (a1));
}
static SCM
@@ -230,13 +230,13 @@
static SCM
scm_smob_apply_2_001 (SCM smob, SCM a1, SCM a2)
{
- return SCM_SMOB_APPLY1 (smob, SCM_LIST2 (a1, a2));
+ return SCM_SMOB_APPLY1 (smob, scm_list_2 (a1, a2));
}
static SCM
scm_smob_apply_2_011 (SCM smob, SCM a1, SCM a2)
{
- return SCM_SMOB_APPLY2 (smob, a1, SCM_LIST1 (a2));
+ return SCM_SMOB_APPLY2 (smob, a1, scm_list_1 (a2));
}
static SCM
Index: guile/guile-core/libguile/socket.c
diff -u guile/guile-core/libguile/socket.c:1.79
guile/guile-core/libguile/socket.c:1.80
--- guile/guile-core/libguile/socket.c:1.79 Tue Jun 26 10:53:09 2001
+++ guile/guile-core/libguile/socket.c Wed Jun 27 18:11:59 2001
@@ -970,7 +970,7 @@
#endif
default:
scm_misc_error (proc, "Unrecognised address family: ~A",
- SCM_LIST1 (SCM_MAKINUM (fam)));
+ scm_list_1 (SCM_MAKINUM (fam)));
}
return result;
}
Index: guile/guile-core/libguile/strings.c
diff -u guile/guile-core/libguile/strings.c:1.59
guile/guile-core/libguile/strings.c:1.60
--- guile/guile-core/libguile/strings.c:1.59 Tue Jun 26 03:59:34 2001
+++ guile/guile-core/libguile/strings.c Wed Jun 27 18:11:59 2001
@@ -50,7 +50,9 @@
#include "libguile/chars.h"
#include "libguile/root.h"
#include "libguile/strings.h"
+#include "libguile/deprecation.h"
#include "libguile/validate.h"
+
/* {Strings}
Index: guile/guile-core/libguile/struct.c
diff -u guile/guile-core/libguile/struct.c:1.80
guile/guile-core/libguile/struct.c:1.81
--- guile/guile-core/libguile/struct.c:1.80 Thu Jun 14 12:50:43 2001
+++ guile/guile-core/libguile/struct.c Wed Jun 27 18:11:59 2001
@@ -90,7 +90,7 @@
len = SCM_STRING_LENGTH (fields);
if (len % 2 == 1)
SCM_MISC_ERROR ("odd length field specification: ~S",
- SCM_LIST1 (fields));
+ scm_list_1 (fields));
field_desc = SCM_STRING_CHARS (fields);
@@ -108,7 +108,7 @@
break;
default:
SCM_MISC_ERROR ("unrecognized field type: ~S",
- SCM_LIST1 (SCM_MAKE_CHAR (field_desc[x])));
+ scm_list_1 (SCM_MAKE_CHAR (field_desc[x])));
}
switch (field_desc[x + 1])
@@ -131,14 +131,14 @@
break;
default:
SCM_MISC_ERROR ("unrecognized ref specification: ~S",
- SCM_LIST1 (SCM_MAKE_CHAR (field_desc[x + 1])));
+ scm_list_1 (SCM_MAKE_CHAR (field_desc[x + 1])));
}
#if 0
if (field_desc[x] == 'd')
{
if (field_desc[x + 2] != '-')
SCM_MISC_ERROR ("missing dash field at position ~A",
- SCM_LIST1 (SCM_MAKINUM (x / 2)));
+ scm_list_1 (SCM_MAKINUM (x / 2)));
x += 2;
goto recheck_ref;
}
@@ -539,7 +539,8 @@
SCM_VALIDATE_INUM (2, tail_array_size);
SCM_VALIDATE_REST_ARGUMENT (init);
- fields = scm_string_append (SCM_LIST2 (required_vtable_fields, user_fields));
+ fields = scm_string_append (scm_list_2 (required_vtable_fields,
+ user_fields));
layout = scm_make_struct_layout (fields);
basic_size = SCM_SYMBOL_LENGTH (layout) / 2;
tail_elts = SCM_INUM (tail_array_size);
@@ -601,13 +602,13 @@
if ((ref == 'R') || (ref == 'W'))
field_type = 'u';
else
- SCM_MISC_ERROR ("ref denied for field ~A", SCM_LIST1 (pos));
+ SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
}
}
else if (fields_desc[SCM_SYMBOL_LENGTH (layout) - 1] != 'O')
field_type = fields_desc[SCM_SYMBOL_LENGTH (layout) - 2];
else
- SCM_MISC_ERROR ("ref denied for field ~A", SCM_LIST1 (pos));
+ SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
switch (field_type)
{
@@ -633,7 +634,7 @@
default:
SCM_MISC_ERROR ("unrecognized field type: ~S",
- SCM_LIST1 (SCM_MAKE_CHAR (field_type)));
+ scm_list_1 (SCM_MAKE_CHAR (field_type)));
}
return answer;
@@ -673,12 +674,12 @@
field_type = fields_desc[p * 2];
set_x = fields_desc [p * 2 + 1];
if (set_x != 'w')
- SCM_MISC_ERROR ("set! denied for field ~A", SCM_LIST1 (pos));
+ SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
}
else if (fields_desc[SCM_SYMBOL_LENGTH (layout) - 1] == 'W')
field_type = fields_desc[SCM_SYMBOL_LENGTH (layout) - 2];
else
- SCM_MISC_ERROR ("set! denied for field ~A", SCM_LIST1 (pos));
+ SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
switch (field_type)
{
@@ -705,7 +706,7 @@
default:
SCM_MISC_ERROR ("unrecognized field type: ~S",
- SCM_LIST1 (SCM_MAKE_CHAR (field_type)));
+ scm_list_1 (SCM_MAKE_CHAR (field_type)));
}
return val;
Index: guile/guile-core/libguile/symbols-deprecated.c
diff -u guile/guile-core/libguile/symbols-deprecated.c:1.3
guile/guile-core/libguile/symbols-deprecated.c:1.4
--- guile/guile-core/libguile/symbols-deprecated.c:1.3 Wed May 23 17:50:49 2001
+++ guile/guile-core/libguile/symbols-deprecated.c Wed Jun 27 18:11:59 2001
@@ -112,7 +112,7 @@
answer = scm_sym2ovcell_soft (sym, obarray);
if (!SCM_FALSEP (answer))
return answer;
- SCM_MISC_ERROR ("uninterned symbol: ~S", SCM_LIST1 (sym));
+ SCM_MISC_ERROR ("uninterned symbol: ~S", scm_list_1 (sym));
return SCM_UNSPECIFIED; /* not reached */
}
#undef FUNC_NAME
Index: guile/guile-core/libguile/unif.c
diff -u guile/guile-core/libguile/unif.c:1.117
guile/guile-core/libguile/unif.c:1.118
--- guile/guile-core/libguile/unif.c:1.117 Tue Jun 26 08:46:40 2001
+++ guile/guile-core/libguile/unif.c Wed Jun 27 18:11:59 2001
@@ -2222,7 +2222,8 @@
if (l2ra (lst, ra, SCM_ARRAY_BASE (ra), 0))
return ra;
else
- badlst:SCM_MISC_ERROR ("Bad scm_array contents list: ~S", SCM_LIST1 (lst));
+ badlst:SCM_MISC_ERROR ("Bad scm_array contents list: ~S",
+ scm_list_1 (lst));
}
#undef FUNC_NAME
Index: guile/guile-core/libguile/variable.c
diff -u guile/guile-core/libguile/variable.c:1.36
guile/guile-core/libguile/variable.c:1.37
--- guile/guile-core/libguile/variable.c:1.36 Thu Jun 14 12:50:43 2001
+++ guile/guile-core/libguile/variable.c Wed Jun 27 18:11:59 2001
@@ -130,7 +130,7 @@
SCM_VALIDATE_VARIABLE (1, var);
val = SCM_VARIABLE_REF (var);
if (val == SCM_UNDEFINED)
- SCM_MISC_ERROR ("variable is unbound: ~S", SCM_LIST1 (var));
+ SCM_MISC_ERROR ("variable is unbound: ~S", scm_list_1 (var));
return val;
}
#undef FUNC_NAME
Index: guile/guile-core/libguile/vectors.c
diff -u guile/guile-core/libguile/vectors.c:1.52
guile/guile-core/libguile/vectors.c:1.53
--- guile/guile-core/libguile/vectors.c:1.52 Thu Jun 14 12:50:43 2001
+++ guile/guile-core/libguile/vectors.c Wed Jun 27 18:11:59 2001
@@ -244,10 +244,10 @@
#define FUNC_NAME s_vector_set_x
{
SCM_GASSERTn (SCM_VECTORP (v),
- g_vector_set_x, SCM_LIST3 (v, k, obj),
+ g_vector_set_x, scm_list_3 (v, k, obj),
SCM_ARG1, s_vector_set_x);
SCM_GASSERTn (SCM_INUMP (k),
- g_vector_set_x, SCM_LIST3 (v, k, obj),
+ g_vector_set_x, scm_list_3 (v, k, obj),
SCM_ARG2, s_vector_set_x);
SCM_ASSERT_RANGE (2, k, SCM_INUM (k) < SCM_VECTOR_LENGTH (v) && SCM_INUM (k)
>= 0);
SCM_VELTS(v)[(long) SCM_INUM(k)] = obj;
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- guile/guile-core/libguile ChangeLog continuatio...,
Keisuke Nishida <=