summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorIOhannes m zmölnig <zmoelnig@umlautQ.umlaeute.mur.at>2017-09-19 14:13:01 +0200
committerIOhannes m zmölnig <zmoelnig@umlautQ.umlaeute.mur.at>2017-09-19 14:13:01 +0200
commita34abe0c374d2a9ec1bb5b1825bc0f88eaa7166c (patch)
tree947aa68818ffb3a0c7123ef11567cb80aaaa7537
parent75bedf4141806f1b12c07964ae633c6893a2efa6 (diff)
New upstream version 17.7
-rw-r--r--HISTORY.Snd1
-rw-r--r--NEWS19
-rw-r--r--clm.c16
-rw-r--r--clm.h5
-rw-r--r--clm.rb2
-rw-r--r--clm2xen.c40
-rw-r--r--clm2xen.h2
-rw-r--r--cload.scm13
-rwxr-xr-xconfigure20
-rw-r--r--configure.ac4
-rw-r--r--effects.rb8
-rw-r--r--gl.c22
-rw-r--r--gtkex.scm134
-rw-r--r--headers.c112
-rw-r--r--io.c4
-rw-r--r--json.scm318
-rw-r--r--libc.scm118
-rw-r--r--libgsl.scm2
-rw-r--r--libgtk_s7.c593
-rw-r--r--lint.scm1841
-rw-r--r--mockery.scm3
-rw-r--r--peak-phases.scm46
-rw-r--r--profile.scm13
-rw-r--r--repl.c25
-rw-r--r--repl.scm104
-rw-r--r--s7.c5574
-rw-r--r--s7.h159
-rw-r--r--s7.html114
-rw-r--r--s7test.scm666
-rw-r--r--snd-0.h6
-rw-r--r--snd-chn.c17
-rw-r--r--snd-dac.c133
-rw-r--r--snd-edits.c167
-rw-r--r--snd-fft.c11
-rw-r--r--snd-file.c10
-rw-r--r--snd-find.c2
-rw-r--r--snd-gprefs.c2
-rw-r--r--snd-gutils.c2
-rw-r--r--snd-gxcolormaps.c8
-rw-r--r--snd-kbd.c6
-rw-r--r--snd-lint.scm48
-rw-r--r--snd-main.c14
-rw-r--r--snd-marks.c26
-rw-r--r--snd-mix.c63
-rw-r--r--snd-motif.c44
-rw-r--r--snd-prefs.c2
-rw-r--r--snd-region.c33
-rw-r--r--snd-select.c21
-rw-r--r--snd-sig.c74
-rw-r--r--snd-snd.c150
-rw-r--r--snd-test.rb8
-rw-r--r--snd-test.scm82
-rw-r--r--snd-trans.c2
-rw-r--r--snd-utils.c2
-rw-r--r--snd-xen.c11
-rw-r--r--snd-xref.c5
-rw-r--r--snd.h6
-rw-r--r--sndlib.h8
-rw-r--r--sndscm.html10
-rw-r--r--sound.c6
-rw-r--r--stuff.scm9
-rw-r--r--tools/compare-calls.scm2
-rw-r--r--tools/ffitest.c85
-rw-r--r--tools/gdbinit8
-rwxr-xr-xtools/gtk-header-diffs4
-rwxr-xr-xtools/makexg.scm37
-rw-r--r--tools/tauto.scm21
-rwxr-xr-xtools/testsnd1
-rw-r--r--tools/tform.scm10
-rw-r--r--tools/xgdata.scm48
-rw-r--r--vct.c6
-rw-r--r--vct.h2
-rw-r--r--write.scm30
-rw-r--r--ws.rb13
-rw-r--r--xen.c2
-rw-r--r--xen.h39
-rw-r--r--xg.c323
-rw-r--r--xm.c4
78 files changed, 6877 insertions, 4724 deletions
diff --git a/HISTORY.Snd b/HISTORY.Snd
index 6c3a1d4..33a85f3 100644
--- a/HISTORY.Snd
+++ b/HISTORY.Snd
@@ -1,5 +1,6 @@
Snd change log
+ 11-Sep: Snd 17.7.
2-Aug: Snd 17.6.
16-Jun: Snd 17.5.
6-May: Snd 17.4. New clm optimizer.
diff --git a/NEWS b/NEWS
index 281e7d3..e585d32 100644
--- a/NEWS
+++ b/NEWS
@@ -1,15 +1,12 @@
-Snd 17.6.
+Snd 17.7:
-s7: (*s7* 'heap-size) is settable
- added s7_define_typed_function_star to s7.h
- changed to the new (c99?) int64_t style int types.
- added two optional args to c-pointer: type, info
- and added s7_is_c_pointer_of_type.
- libgtk_s7.c (in-progress)
+Mike Scholz provided changes for Ruby 2.5.
-clm: removed clm-default-frequency
- object->let support for generators
+s7: changed various "object" names to "c_object" in s7.h ("object" was ambiguous)
+ c-pointers can participate in the generic function stuff
+ gtkex.scm
+ json.scm (aimed at the Language Server Protocol, eventually in emacs perhaps)
-checked: sbcl 1.3.19|20, gtk 3.91.1
+checked: gtk 3.91.2, sbcl 1.3.21
-Thanks!: Mike Scholz, James Hearon
+Thanks!: Kjetil Mattheussen, Mike Scholz
diff --git a/clm.c b/clm.c
index 5c441fa..0dcdb31 100644
--- a/clm.c
+++ b/clm.c
@@ -4174,7 +4174,7 @@ static char *describe_wt(mus_any *ptr)
{
char *describe_buffer;
describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
- snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, size: %lld, interp: %s",
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s freq: %.3fHz, phase: %.3f, size: %" PRId64 ", interp: %s",
mus_name(ptr),
mus_frequency(ptr),
mus_phase(ptr),
@@ -9787,7 +9787,7 @@ static char *describe_env(mus_any *ptr)
seg *e = (seg *)ptr;
char *describe_buffer;
describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
- snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %s, pass: %lld (dur: %lld), index: %d, scaler: %.4f, offset: %.4f, data: %s",
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %s, pass: %" PRId64 " (dur: %" PRId64 "), index: %d, scaler: %.4f, offset: %.4f, data: %s",
mus_name(ptr),
((e->style == MUS_ENV_LINEAR) ? "linear" : ((e->style == MUS_ENV_EXPONENTIAL) ? "exponential" : "step")),
(e->locs) ? (e->locs[e->index] - e->loc) : -1,
@@ -10672,7 +10672,7 @@ mus_any *mus_make_file_to_sample_with_buffer_size(const char *filename, mus_long
gen->file_end = mus_sound_framples(gen->file_name);
if (gen->file_end < 0)
- mus_error(MUS_NO_LENGTH, S_make_file_to_sample ": %s framples: %lld", filename, gen->file_end);
+ mus_error(MUS_NO_LENGTH, S_make_file_to_sample ": %s framples: %" PRId64, filename, gen->file_end);
if (buffer_size < gen->file_end)
gen->file_buffer_size = buffer_size;
@@ -10718,7 +10718,7 @@ static char *describe_readin(mus_any *ptr)
rdin *gen = (rdin *)ptr;
char *describe_buffer;
describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
- snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %s[chan %d], loc: %lld, dir: %d",
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s %s[chan %d], loc: %" PRId64 ", dir: %d",
mus_name(ptr),
gen->file_name, gen->chan, gen->loc, gen->dir);
return(describe_buffer);
@@ -11205,7 +11205,7 @@ static void flush_buffers(rdout *gen)
mus_sound_close_input(fd);
old_file_buffer_size = clm_file_buffer_size;
clm_file_buffer_size = MUS_DEFAULT_FILE_BUFFER_SIZE;
- mus_error(MUS_MEMORY_ALLOCATION_FAILED, S_mus_file_buffer_size " (%lld) is too large: we can't allocate the output buffers!", old_file_buffer_size);
+ mus_error(MUS_MEMORY_ALLOCATION_FAILED, S_mus_file_buffer_size " (%" PRId64 ") is too large: we can't allocate the output buffers!", old_file_buffer_size);
return;
}
}
@@ -11219,7 +11219,7 @@ static void flush_buffers(rdout *gen)
*/
if (framples_to_add >= clm_file_buffer_size)
{
- mus_print("clm-file-buffer-size changed? %lld <= %lld (start: %lld, end: %lld, %lld)",
+ mus_print("clm-file-buffer-size changed? %" PRId64 " <= %" PRId64 " (start: %" PRId64 ", end: %" PRId64 ", %" PRId64 ")",
clm_file_buffer_size, framples_to_add, gen->data_start, gen->data_end, gen->out_end);
framples_to_add = clm_file_buffer_size - 1;
@@ -12618,7 +12618,7 @@ static char *describe_move_sound(mus_any *ptr)
char *allstr = NULL;
int len;
- starts = mus_format("%s start: %lld, end: %lld, out chans %d, rev chans: %d",
+ starts = mus_format("%s start: %" PRId64 ", end: %" PRId64 ", out chans %d, rev chans: %d",
mus_name(ptr),
gen->start,
gen->end,
@@ -15314,7 +15314,7 @@ static char *describe_convolve(mus_any *ptr)
conv *gen = (conv *)ptr;
char *describe_buffer;
describe_buffer = (char *)malloc(DESCRIBE_BUFFER_SIZE);
- snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s size: %lld",
+ snprintf(describe_buffer, DESCRIBE_BUFFER_SIZE, "%s size: %" PRId64,
mus_name(ptr),
gen->fftsize);
return(describe_buffer);
diff --git a/clm.h b/clm.h
index d6b5ee5..910f01f 100644
--- a/clm.h
+++ b/clm.h
@@ -2,8 +2,8 @@
#define CLM_H
#define MUS_VERSION 6
-#define MUS_REVISION 16
-#define MUS_DATE "18-Jul-17"
+#define MUS_REVISION 17
+#define MUS_DATE "3-Aug-17"
/* isn't mus_env_interp backwards? */
@@ -616,6 +616,7 @@ MUS_EXPORT mus_any *mus_bank_generator(mus_any *g, int i);
/* Change log.
*
+ * 3-Aug: mus_long_t is now int64_t.
* 18-Jul: mus_<method>_exists.
* 13-Jul: mus_run1_function.
* 11-Jul-17: removed *clm-default-frequency*.
diff --git a/clm.rb b/clm.rb
index 92b87db..0134310 100644
--- a/clm.rb
+++ b/clm.rb
@@ -2,7 +2,7 @@
# Author: Michael Scholz <mi-scholz@users.sourceforge.net>
# Created: 09/10/14 23:02:57
-# Changed: 16/11/17 15:26:36
+# Changed: 17/08/14 02:47:15
# Ruby extensions:
#
diff --git a/clm2xen.c b/clm2xen.c
index fbf9c0b..a54060f 100644
--- a/clm2xen.c
+++ b/clm2xen.c
@@ -142,7 +142,7 @@ mus_any *mus_xen_gen(mus_xen *x) {return(x->gen);}
#define Xen_to_C_integer_or_error(Xen_Arg, C_Val, Caller, ArgNum) \
do {if (s7_is_integer(Xen_Arg)) C_Val = s7_integer(Xen_Arg); else {C_Val = 0.0; Xen_check_type(false, Xen_Arg, ArgNum, Caller, "an integer");}} while (0)
-#define Xen_object_ref_checked(Obj, Type) s7_object_value_checked(Obj, Type)
+#define Xen_object_ref_checked(Obj, Type) s7_c_object_value_checked(Obj, Type)
#define XEN_NULL NULL
#endif
@@ -1551,7 +1551,7 @@ static s7_pointer g_clm_let;
Xen mus_xen_to_object(mus_xen *gn) /* global for user-defined gens */
{
#if HAVE_SCHEME
- return(s7_make_object_with_let(s7, mus_xen_tag, gn, g_clm_let));
+ return(s7_make_c_object_with_let(s7, mus_xen_tag, gn, g_clm_let));
#else
return(Xen_make_object(mus_xen_tag, gn, mark_mus_xen, free_mus_xen));
#endif
@@ -9718,7 +9718,8 @@ static void set_as_needed_input_choices(mus_any *gen, Xen obj, mus_xen *gn)
{
s7_pointer arg;
arg = s7_car(s7_closure_args(s7, obj));
- if ((arg == s7_caddr(res)) &&
+ if ((s7_is_pair(s7_cddr(res))) &&
+ (arg == s7_caddr(res)) &&
(s7_car(res) == s7_make_symbol(s7, "read-sample-with-direction")))
{
gn->vcts[MUS_INPUT_DATA] = (Xen)xen_to_sampler(s7_symbol_local_value(s7, s7_cadr(res), s7_closure_let(s7, obj)));
@@ -11061,6 +11062,7 @@ it in conjunction with matrix to scale/envelope all the various ins and outs. \
const char *outfile = NULL, *infile = NULL;
/* -------- setup output gen -------- */
+ Xen_check_type(Xen_is_pair(args), args, 0, S_mus_file_mix, "a filename or a " S_frample_to_file " generator");
arg = args;
out = Xen_car(arg);
Xen_check_type(Xen_is_string(out) || ((mus_is_xen(out)) && (mus_is_output(Xen_to_mus_any(out)))),
@@ -11529,7 +11531,7 @@ static mus_float_t mus_convolve_simple(mus_any *p) {return(mus_convolve(p, NULL)
static s7_double mus_ ## Type ## _dp(s7_pointer p) \
{ \
mus_xen *gn; \
- gn = (mus_xen *)s7_object_value(p); \
+ gn = (mus_xen *)s7_c_object_value(p); \
return(Func(gn->gen)); \
}
@@ -11546,7 +11548,7 @@ static mus_float_t mus_convolve_simple(mus_any *p) {return(mus_convolve(p, NULL)
static s7_double mus_ ## Type ## _dp(s7_pointer p) \
{ \
mus_xen *gn; \
- gn = (mus_xen *)s7_object_value(p); \
+ gn = (mus_xen *)s7_c_object_value(p); \
return(Func1(gn->gen)); \
} \
static s7_double mus_ ## Type ## _dvd(void *o, s7_double d) \
@@ -11556,7 +11558,7 @@ static mus_float_t mus_convolve_simple(mus_any *p) {return(mus_convolve(p, NULL)
} \
static s7_double mus_ ## Type ## _dpd(s7_pointer p, s7_double d) \
{ \
- mus_xen *gn = (mus_xen *)s7_object_value(p); \
+ mus_xen *gn = (mus_xen *)s7_c_object_value(p); \
return(Func2(gn->gen, d)); \
}
@@ -11573,7 +11575,7 @@ static mus_float_t mus_convolve_simple(mus_any *p) {return(mus_convolve(p, NULL)
static s7_double mus_ ## Type ## _dp(s7_pointer p) \
{ \
mus_xen *gn; \
- gn = (mus_xen *)s7_object_value(p); \
+ gn = (mus_xen *)s7_c_object_value(p); \
return(Func1(gn->gen)); \
} \
static s7_double mus_ ## Type ## _dvd(void *o, s7_double d) \
@@ -11583,7 +11585,7 @@ static mus_float_t mus_convolve_simple(mus_any *p) {return(mus_convolve(p, NULL)
} \
static s7_double mus_ ## Type ## _dpd(s7_pointer p, s7_double d) \
{ \
- mus_xen *gn = (mus_xen *)s7_object_value(p); \
+ mus_xen *gn = (mus_xen *)s7_c_object_value(p); \
return(Func2(gn->gen, d)); \
} \
static s7_double mus_ ## Type ## _dvdd(void *o, s7_double x1, s7_double x2) \
@@ -11752,7 +11754,7 @@ static s7_double mus_formant_bank_dvd(void *o, s7_double x)
static s7_double mus_formant_bank_dpd(s7_pointer p, s7_double x)
{
- mus_xen *gn = (mus_xen *)s7_object_value(p);
+ mus_xen *gn = (mus_xen *)s7_c_object_value(p);
return(mus_formant_bank(gn->gen, x));
}
@@ -11764,7 +11766,7 @@ static s7_double mus_formant_bank_dv(void *o)
static s7_double mus_formant_bank_dp(s7_pointer p)
{
- mus_xen *gn = (mus_xen *)s7_object_value(p);
+ mus_xen *gn = (mus_xen *)s7_c_object_value(p);
return(mus_formant_bank(gn->gen, 0.0));
}
@@ -11776,7 +11778,7 @@ static s7_double mus_set_formant_frequency_dvd(void *o, s7_double x)
static s7_double mus_set_formant_frequency_dpd(s7_pointer p, s7_double x)
{
- mus_xen *gn = (mus_xen *)s7_object_value(p);
+ mus_xen *gn = (mus_xen *)s7_c_object_value(p);
return(mus_set_formant_frequency(gn->gen, x));
}
@@ -11795,7 +11797,7 @@ static s7_double out_bank_d_pid(s7_pointer gens, s7_int loc, s7_double x)
els = s7_vector_elements(gens);
len = s7_vector_length(gens);
for (i = 0; i < len; i++)
- out_any_2(loc, mus_apply(((mus_xen *)(s7_object_value(els[i])))->gen, x, 0.0), i, S_out_bank);
+ out_any_2(loc, mus_apply(((mus_xen *)(s7_c_object_value(els[i])))->gen, x, 0.0), i, S_out_bank);
return(x);
}
@@ -12527,7 +12529,7 @@ static s7_pointer generator_to_let(s7_scheme *sc, s7_pointer args)
gen = s7_car(args);
let = s7_cadr(args);
- gn = (mus_xen *)s7_object_value(gen);
+ gn = (mus_xen *)s7_c_object_value(gen);
g = gn->gen; /* gn->nvcts and gn->vcts hold the arrays and functions */
if (mus_name_exists(g))
@@ -12863,9 +12865,15 @@ static void mus_xen_init(void)
current_connect_func = Xen_false;
#if HAVE_SCHEME
- mus_xen_tag = s7_new_type_x(s7, "<generator>", print_mus_xen, free_mus_xen, s7_equalp_mus_xen, mark_mus_xen,
- mus_xen_apply, NULL, s7_mus_length, s7_mus_copy, NULL, NULL);
- s7_set_object_print_readably(mus_xen_tag, mus_generator_to_readable_string);
+ mus_xen_tag = s7_make_c_type(s7, "<generator>");
+ s7_c_type_set_print(s7, mus_xen_tag, print_mus_xen);
+ s7_c_type_set_free(s7, mus_xen_tag, free_mus_xen);
+ s7_c_type_set_equal(s7, mus_xen_tag, s7_equalp_mus_xen);
+ s7_c_type_set_mark(s7, mus_xen_tag, mark_mus_xen);
+ s7_c_type_set_apply(s7, mus_xen_tag, mus_xen_apply);
+ s7_c_type_set_length(s7, mus_xen_tag, s7_mus_length);
+ s7_c_type_set_copy(s7, mus_xen_tag, s7_mus_copy);
+ s7_c_type_set_print_readably(s7, mus_xen_tag, mus_generator_to_readable_string);
mus_error_symbol = s7_make_symbol(s7, "mus-error");
clm_error_info = s7_list(s7, 4, s7_make_string(s7, "~A: ~A ~A"), s7_nil(s7), s7_nil(s7), s7_nil(s7));
diff --git a/clm2xen.h b/clm2xen.h
index 89901a8..1e6d0cd 100644
--- a/clm2xen.h
+++ b/clm2xen.h
@@ -14,7 +14,9 @@ extern "C" {
#endif
MUS_EXPORT mus_long_t clm_default_table_size_c(void);
+#if (!DISABLE_DEPRECATED)
MUS_EXPORT mus_float_t clm_default_frequency_c(void);
+#endif
MUS_EXPORT mus_any *mus_xen_gen(mus_xen *x);
diff --git a/cload.scm b/cload.scm
index 780f361..eeb5423 100644
--- a/cload.scm
+++ b/cload.scm
@@ -481,7 +481,7 @@
(format p ");~%")))
signatures)
(format p " }~%~%")
- (format p " cur_env = s7_outlet(sc, s7_curlet(sc));~%") ; this must exist because we pass load the env ourselves
+ (format p " cur_env = s7_curlet(sc);~%") ; changed from s7_outlet(s7_curlet) 20-Aug-17
;; send out any special initialization code
(for-each
@@ -525,10 +525,11 @@
(trans (C->s7 type)))
(format p "#ifdef ~A~%" c-name)
(if (eq? trans 's7_make_c_pointer_with_type)
- (format p " s7_define(sc, cur_env, s7_make_symbol(sc, ~S), s7_make_c_pointer(sc, (~A)~A));~%"
+ (format p " s7_define(sc, cur_env, s7_make_symbol(sc, ~S), s7_make_c_pointer_with_type(sc, (~A)~A, s7_make_symbol(sc, \"~S\"), s7_f(sc)));~%"
scheme-name
(C->s7-cast type)
- c-name)
+ c-name
+ type)
(format p " s7_define(sc, cur_env, s7_make_symbol(sc, ~S), ~A(sc, (~A)~A));~%"
scheme-name
trans
@@ -671,9 +672,9 @@
(delete-file o-file-name))
;; load the object file, clean up
- (let ((new-env (sublet cur-env 'init_func (string->symbol init-name))))
- (format *stderr* "loading ~A~%" so-file-name)
- (load so-file-name new-env)))))
+ (varlet cur-env 'init_func (string->symbol init-name))
+ (format *stderr* "loading ~A~%" so-file-name)
+ (load so-file-name cur-env))))
#|
diff --git a/configure b/configure
index e3d6a22..a5449ea 100755
--- a/configure
+++ b/configure
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.69 for snd 17.6.
+# Generated by GNU Autoconf 2.69 for snd 17.7.
#
# Report bugs to <bil@ccrma.stanford.edu>.
#
@@ -580,8 +580,8 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='snd'
PACKAGE_TARNAME='ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-17.tar.gz'
-PACKAGE_VERSION='17.6'
-PACKAGE_STRING='snd 17.6'
+PACKAGE_VERSION='17.7'
+PACKAGE_STRING='snd 17.7'
PACKAGE_BUGREPORT='bil@ccrma.stanford.edu'
PACKAGE_URL=''
@@ -1321,7 +1321,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures snd 17.6 to adapt to many kinds of systems.
+\`configure' configures snd 17.7 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1392,7 +1392,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of snd 17.6:";;
+ short | recursive ) echo "Configuration of snd 17.7:";;
esac
cat <<\_ACEOF
@@ -1508,7 +1508,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-snd configure 17.6
+snd configure 17.7
generated by GNU Autoconf 2.69
Copyright (C) 2012 Free Software Foundation, Inc.
@@ -1969,7 +1969,7 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by snd $as_me 17.6, which was
+It was created by snd $as_me 17.7, which was
generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
@@ -3316,7 +3316,7 @@ LOCAL_LANGUAGE="None"
GRAPHICS_TOOLKIT="None"
PACKAGE=Snd
-VERSION=17.6
+VERSION=17.7
#--------------------------------------------------------------------------------
# configuration options
@@ -6703,7 +6703,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by snd $as_me 17.6, which was
+This file was extended by snd $as_me 17.7, which was
generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -6765,7 +6765,7 @@ _ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
-snd config.status 17.6
+snd config.status 17.7
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
diff --git a/configure.ac b/configure.ac
index 3f54d9c..f746b4d 100644
--- a/configure.ac
+++ b/configure.ac
@@ -5,7 +5,7 @@
# gmp, mpfr, and mpc deliberately have none!
-AC_INIT(snd, 17.6, bil@ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-17.tar.gz)
+AC_INIT(snd, 17.7, bil@ccrma.stanford.edu, ftp://ccrma-ftp.stanford.edu/pub/Lisp/snd-17.tar.gz)
AC_CONFIG_SRCDIR(snd.c)
AC_CANONICAL_HOST # needed by case $host below
@@ -24,7 +24,7 @@ LOCAL_LANGUAGE="None"
GRAPHICS_TOOLKIT="None"
PACKAGE=Snd
-VERSION=17.6
+VERSION=17.7
#--------------------------------------------------------------------------------
# configuration options
diff --git a/effects.rb b/effects.rb
index 75ea883..7a6d02d 100644
--- a/effects.rb
+++ b/effects.rb
@@ -2,11 +2,11 @@
# Translator/Author: Michael Scholz <mi-scholz@users.sourceforge.net>
# Created: 03/02/07 23:56:21
-# Changed: 14/11/13 04:43:14
+# Changed: 17/08/14 03:06:26
# Requires --with-motif|gtk
#
-# Tested with Snd 15.x
+# Tested with Snd 17.x
# Ruby 2.x.x
# Motif 2.3.3 X11R6
#
@@ -353,8 +353,6 @@ module Effects
comb4 = make_comb(0.697, 5801)
outdel1 = make_delay((0.013 * srate()).round)
comb_sum = 0.0
- comb_sum_1 = 0.0
- comb_sum_2 = 0.0
samp = 0
lambda do |inval|
allpass_sum = all_pass(allpass3,
@@ -364,8 +362,6 @@ module Effects
inval :
0.0))))
samp += 1
- comb_sum_2 = comb_sum_1
- comb_sum_1 = comb_sum
comb_sum = (comb(comb1, allpass_sum) + comb(comb2, allpass_sum) + \
comb(comb3, allpass_sum) + comb(comb4, allpass_sum))
inval + volume * delay(outdel1, comb_sum)
diff --git a/gl.c b/gl.c
index 4a60400..5b41114 100644
--- a/gl.c
+++ b/gl.c
@@ -4455,7 +4455,7 @@ static void define_functions(void)
{
#if HAVE_SCHEME
static s7_pointer s_boolean, s_integer, s_real, s_any;
-static s7_pointer pl_prrrt, pl_prrrrtttrrt, pl_t, pl_tb, pl_bt, pl_ttri, pl_ttit, pl_ttr, pl_ttir, pl_ttb, pl_tti, pl_ttiti, pl_ttrriir, pl_ttititiiti, pl_ttititi, pl_ttrri, pl_ttrrri, pl_iiiiitiiit, pl_iiiiiiiit, pl_iiiiiiiiiiit, pl_iiiiiiit, pl_iiiiiiiiiit, pl_iiiiiit, pl_iiiiiiiiit, pl_i, pl_bit, pl_bi, pl_tiiit, pl_tiirrrrt, pl_tiiiit, pl_tiiiiiiit, pl_tiiiiiiiit, pl_tirriit, pl_tirriirriit, pl_tirrir, pl_tir, pl_tiit, pl_tit, pl_tiiiiiiiiit, pl_tiiiiiiiiiit, pl_tiiib, pl_ti, pl_tiiiiiit, pl_tiir, pl_tiiiiit, pl_tibiit, pl_tiib, pl_trrrrt, pl_tr, pl_pit, pl_piiit, pl_piit;
+static s7_pointer pl_pit, pl_piiit, pl_piit, pl_t, pl_ttri, pl_ttit, pl_ttr, pl_ttir, pl_prrrt, pl_prrrrtttrrt, pl_ttb, pl_tti, pl_ttiti, pl_ttrriir, pl_ttititiiti, pl_ttititi, pl_ttrri, pl_ttrrri, pl_tb, pl_bt, pl_iiiiitiiit, pl_iiiiiiiit, pl_iiiiiiiiiiit, pl_iiiiiiit, pl_iiiiiiiiiit, pl_iiiiiit, pl_iiiiiiiiit, pl_i, pl_tiiit, pl_tiirrrrt, pl_tiiiit, pl_tiiiiiiit, pl_tiiiiiiiit, pl_tirriit, pl_tirriirriit, pl_tirrir, pl_tir, pl_tiit, pl_tit, pl_tiiiiiiiiit, pl_tiiiiiiiiiit, pl_tiiib, pl_ti, pl_tiiiiiit, pl_tiir, pl_tiiiiit, pl_tibiit, pl_tiib, pl_bit, pl_bi, pl_trrrrt, pl_tr;
#if USE_MOTIF
static s7_pointer pl_tttti, pl_ttttb, pl_pttit, pl_pt;
#endif
@@ -4465,15 +4465,16 @@ static s7_pointer pl_tttti, pl_ttttb, pl_pttit, pl_pt;
s_real = s7_make_symbol(s7, "real?");
s_any = s7_t(s7);
- pl_prrrt = s7_make_circular_signature(s7, 4, 5, s_any, s_real, s_real, s_real, s_any);
- pl_prrrrtttrrt = s7_make_circular_signature(s7, 10, 11, s_any, s_real, s_real, s_real, s_real, s_any, s_any, s_any, s_real, s_real, s_any);
+ pl_pit = s7_make_circular_signature(s7, 2, 3, s_any, s_integer, s_any);
+ pl_piiit = s7_make_circular_signature(s7, 4, 5, s_any, s_integer, s_integer, s_integer, s_any);
+ pl_piit = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_integer, s_any);
pl_t = s7_make_circular_signature(s7, 0, 1, s_any);
- pl_tb = s7_make_circular_signature(s7, 1, 2, s_any, s_boolean);
- pl_bt = s7_make_circular_signature(s7, 1, 2, s_boolean, s_any);
pl_ttri = s7_make_circular_signature(s7, 3, 4, s_any, s_any, s_real, s_integer);
pl_ttit = s7_make_circular_signature(s7, 3, 4, s_any, s_any, s_integer, s_any);
pl_ttr = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_real);
pl_ttir = s7_make_circular_signature(s7, 3, 4, s_any, s_any, s_integer, s_real);
+ pl_prrrt = s7_make_circular_signature(s7, 4, 5, s_any, s_real, s_real, s_real, s_any);
+ pl_prrrrtttrrt = s7_make_circular_signature(s7, 10, 11, s_any, s_real, s_real, s_real, s_real, s_any, s_any, s_any, s_real, s_real, s_any);
pl_ttb = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_boolean);
pl_tti = s7_make_circular_signature(s7, 2, 3, s_any, s_any, s_integer);
pl_ttiti = s7_make_circular_signature(s7, 4, 5, s_any, s_any, s_integer, s_any, s_integer);
@@ -4482,6 +4483,8 @@ static s7_pointer pl_tttti, pl_ttttb, pl_pttit, pl_pt;
pl_ttititi = s7_make_circular_signature(s7, 6, 7, s_any, s_any, s_integer, s_any, s_integer, s_any, s_integer);
pl_ttrri = s7_make_circular_signature(s7, 4, 5, s_any, s_any, s_real, s_real, s_integer);
pl_ttrrri = s7_make_circular_signature(s7, 5, 6, s_any, s_any, s_real, s_real, s_real, s_integer);
+ pl_tb = s7_make_circular_signature(s7, 1, 2, s_any, s_boolean);
+ pl_bt = s7_make_circular_signature(s7, 1, 2, s_boolean, s_any);
pl_iiiiitiiit = s7_make_circular_signature(s7, 9, 10, s_integer, s_integer, s_integer, s_integer, s_integer, s_any, s_integer, s_integer, s_integer, s_any);
pl_iiiiiiiit = s7_make_circular_signature(s7, 8, 9, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_iiiiiiiiiiit = s7_make_circular_signature(s7, 11, 12, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
@@ -4490,8 +4493,6 @@ static s7_pointer pl_tttti, pl_ttttb, pl_pttit, pl_pt;
pl_iiiiiit = s7_make_circular_signature(s7, 6, 7, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_iiiiiiiiit = s7_make_circular_signature(s7, 9, 10, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_i = s7_make_circular_signature(s7, 0, 1, s_integer);
- pl_bit = s7_make_circular_signature(s7, 2, 3, s_boolean, s_integer, s_any);
- pl_bi = s7_make_circular_signature(s7, 1, 2, s_boolean, s_integer);
pl_tiiit = s7_make_circular_signature(s7, 4, 5, s_any, s_integer, s_integer, s_integer, s_any);
pl_tiirrrrt = s7_make_circular_signature(s7, 7, 8, s_any, s_integer, s_integer, s_real, s_real, s_real, s_real, s_any);
pl_tiiiit = s7_make_circular_signature(s7, 5, 6, s_any, s_integer, s_integer, s_integer, s_integer, s_any);
@@ -4512,11 +4513,10 @@ static s7_pointer pl_tttti, pl_ttttb, pl_pttit, pl_pt;
pl_tiiiiit = s7_make_circular_signature(s7, 6, 7, s_any, s_integer, s_integer, s_integer, s_integer, s_integer, s_any);
pl_tibiit = s7_make_circular_signature(s7, 5, 6, s_any, s_integer, s_boolean, s_integer, s_integer, s_any);
pl_tiib = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_integer, s_boolean);
+ pl_bit = s7_make_circular_signature(s7, 2, 3, s_boolean, s_integer, s_any);
+ pl_bi = s7_make_circular_signature(s7, 1, 2, s_boolean, s_integer);
pl_trrrrt = s7_make_circular_signature(s7, 5, 6, s_any, s_real, s_real, s_real, s_real, s_any);
pl_tr = s7_make_circular_signature(s7, 1, 2, s_any, s_real);
- pl_pit = s7_make_circular_signature(s7, 2, 3, s_any, s_integer, s_any);
- pl_piiit = s7_make_circular_signature(s7, 4, 5, s_any, s_integer, s_integer, s_integer, s_any);
- pl_piit = s7_make_circular_signature(s7, 3, 4, s_any, s_integer, s_integer, s_any);
#if USE_MOTIF
pl_tttti = s7_make_circular_signature(s7, 4, 5, s_any, s_any, s_any, s_any, s_integer);
@@ -5736,7 +5736,7 @@ void Init_libgl(void)
define_integers();
define_functions();
Xen_provide_feature("gl");
- Xen_define("gl-version", C_string_to_Xen_string("27-Jul-17"));
+ Xen_define("gl-version", C_string_to_Xen_string("08-Sep-17"));
gl_already_inited = true;
}
}
diff --git a/gtkex.scm b/gtkex.scm
new file mode 100644
index 0000000..3fd0a88
--- /dev/null
+++ b/gtkex.scm
@@ -0,0 +1,134 @@
+
+(if (provided? 'gtk4)
+ (gtk_init)
+ (gtk_init 0 #f))
+
+(let ((shell (gtk_window_new GTK_WINDOW_TOPLEVEL))
+ (s7-prompt "s7> ")
+ (return-key GDK_KEY_Return))
+
+ (g_signal_connect (G_OBJECT shell) "delete_event"
+ (lambda (window event data)
+ (gtk_main_quit)
+ (exit)))
+ (g_signal_connect (G_OBJECT shell) "destroy"
+ (lambda (window data)
+ (gtk_main_quit)
+ (exit)))
+
+ (gtk_window_set_title (GTK_WINDOW shell) "s7")
+
+ (let ((scrolled_window (gtk_scrolled_window_new #f #f)))
+
+ (gtk_scrolled_window_set_policy (GTK_SCROLLED_WINDOW scrolled_window) GTK_POLICY_AUTOMATIC GTK_POLICY_AUTOMATIC)
+ (gtk_container_add (GTK_CONTAINER shell) scrolled_window)
+
+ (let* ((repl (gtk_text_view_new))
+ (repl_buf (gtk_text_buffer_new #f))
+ (prompt_not_editable #f))
+
+ (define (evaluate-expression expr)
+ (let ((pos (GtkTextIter))
+ (result (catch #t
+ (lambda ()
+ (object->string (eval-string expr)))
+ (lambda args
+ (format #f "~A: ~S" (car args) (apply format #f (cadr args)))))))
+ (gtk_text_buffer_get_end_iter repl_buf pos)
+ (gtk_text_buffer_insert repl_buf pos "\n" 1)
+ (gtk_text_buffer_insert repl_buf pos result (length result))))
+
+ (define (get-current-expression)
+ (let ((m (gtk_text_buffer_get_insert repl_buf))
+ (pos (GtkTextIter))
+ (previous (GtkTextIter))
+ (next (GtkTextIter))
+ (temp (GtkTextIter)))
+ (gtk_text_buffer_get_iter_at_mark repl_buf pos m)
+ (if (gtk_text_iter_backward_search pos s7-prompt 0 temp previous #f)
+ (if (not (gtk_text_iter_forward_search pos s7-prompt 0 next temp #f))
+ (begin
+ (gtk_text_buffer_get_end_iter repl_buf next)
+ (gtk_text_buffer_get_text repl_buf previous next #t))
+ (begin
+ (gtk_text_iter_backward_search next "\n" 0 pos temp #f)
+ (gtk_text_iter_backward_search pos "\n" 0 next temp #f)
+ (gtk_text_buffer_get_text repl_buf previous next #t)))
+ "")))
+
+ (define (repl-key-press w event data)
+ (let ((key (gtk_event_keyval event)))
+ (if (equal? key return-key)
+ (let ((pos (GtkTextIter)))
+
+ (evaluate-expression (get-current-expression))
+
+ (gtk_text_buffer_get_end_iter repl_buf pos)
+ (gtk_text_buffer_insert_with_tags repl_buf pos
+ (string-append (string #\newline) s7-prompt)
+ (+ 1 (length s7-prompt))
+ (list prompt_not_editable))
+ (gtk_text_buffer_place_cursor repl_buf pos)
+ (gtk_text_view_scroll_mark_onscreen (GTK_TEXT_VIEW repl)
+ (gtk_text_buffer_get_insert repl_buf))
+ (g_signal_stop_emission (GPOINTER w)
+ (g_signal_lookup "key_press_event"
+ (G_OBJECT_TYPE (G_OBJECT w)))
+ 0)))
+ #f))
+
+ (gtk_container_add (GTK_CONTAINER scrolled_window) repl)
+ (gtk_text_view_set_buffer (GTK_TEXT_VIEW repl) repl_buf)
+ (gtk_text_view_set_editable (GTK_TEXT_VIEW repl) #t)
+ (gtk_text_view_set_wrap_mode (GTK_TEXT_VIEW repl) GTK_WRAP_NONE)
+ (gtk_text_view_set_cursor_visible (GTK_TEXT_VIEW repl) #t)
+ (gtk_text_view_set_left_margin (GTK_TEXT_VIEW repl) 4)
+
+ (if (provided? 'gtk4)
+ (gdk_window_set_event_compression (gtk_widget_get_window repl) #f)
+ (gtk_widget_set_events repl GDK_ALL_EVENTS_MASK))
+ (g_signal_connect (G_OBJECT repl) "key_press_event" repl-key-press)
+ ;; TODO in gtk4 I think repl-key-press receives 2 args
+
+ (gtk_widget_show repl)
+ (gtk_widget_show scrolled_window)
+ (gtk_widget_show shell)
+
+ (set! prompt_not_editable
+ (gtk_text_buffer_create_tag repl_buf "prompt_not_editable"
+ (list "editable" 0 "weight" PANGO_WEIGHT_BOLD)))
+ (let ((pos (GtkTextIter)))
+ (gtk_text_buffer_get_end_iter repl_buf pos)
+ (gtk_text_buffer_insert_with_tags repl_buf pos
+ s7-prompt (length s7-prompt)
+ (list prompt_not_editable))
+ (gdk_window_resize (gtk_widget_get_window shell) 400 200)
+ (gtk_main)))))
+
+
+#|
+;;; here is the calling C program:
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+#include "s7.h"
+void libgtk_s7_init(s7_scheme *sc);
+
+int main(int argc, char **argv)
+{
+ s7_scheme *sc;
+ sc = s7_init();
+ libgtk_s7_init(sc);
+ s7_load(sc, "gtkex.scm");
+}
+
+;;; here is how I build it in linux:
+
+gcc -c libgtk_s7.c -o libgtk_s7.o -I. -fPIC `pkg-config --libs gtk+-3.0 --cflags` -lm -ldl
+gcc libgtk_s7.o -shared -o libgtk_s7.so
+gcc -o gtkex gtkex.c s7.o /home/bil/cl/libgtk_s7.so -lm -I. -Wl,-export-dynamic `pkg-config --libs gtk+-3.0 --cflags` -lm -ldl
+
+|#
+
diff --git a/headers.c b/headers.c
index b8345ab..1ad9314 100644
--- a/headers.c
+++ b/headers.c
@@ -579,7 +579,7 @@ static int read_next_header(const char *filename, int fd)
type_specifier = mus_char_to_uninterpreted_int((unsigned char *)hdrbuf);
data_location = mus_char_to_ubint((unsigned char *)(hdrbuf + 4));
- if (data_location < 24) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data location: %lld?", filename, data_location));
+ if (data_location < 24) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data location: %" PRId64 "?", filename, data_location));
data_size = mus_char_to_ubint((unsigned char *)(hdrbuf + 8)); /* changed to unsigned 11-Nov-06 */
/* can be bogus -- fixup if possible */
@@ -1034,10 +1034,10 @@ static int read_aiff_header(const char *filename, int fd, int overall_offset)
{
if ((got_comm) && (data_location > 0))
{
- mus_print("%s, aiff header: chunks confused at %lld; will try to continue", filename, offset);
+ mus_print("%s, aiff header: chunks confused at %" PRId64 "; will try to continue", filename, offset);
break;
}
- return(mus_error(MUS_HEADER_READ_FAILED, "%s, aiff header: chunks confused at %lld" , filename, offset));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s, aiff header: chunks confused at %" PRId64 , filename, offset));
}
chunksize = mus_char_to_ubint((unsigned char *)(hdrbuf + 4));
@@ -1227,7 +1227,7 @@ static int read_aiff_header(const char *filename, int fd, int overall_offset)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
}
if ((data_size > ssnd_bytes) && (sample_type != MUS_UNKNOWN_SAMPLE))
@@ -2051,7 +2051,7 @@ static int read_riff_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
}
data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
@@ -2261,7 +2261,7 @@ static int read_soundforge_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
}
data_size = mus_bytes_to_samples(sample_type, data_size);
@@ -2388,7 +2388,7 @@ static int read_rf64_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
}
data_size = mus_bytes_to_samples(sample_type, data_size);
@@ -2509,7 +2509,7 @@ static int read_avi_header(const char *filename, int fd)
int chunksize;
offset += chunkloc;
if (seek_and_read(fd, (unsigned char *)hdrbuf, offset, 32) <= 0)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s avi header: chunks confused at %lld", filename, offset));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s avi header: chunks confused at %" PRId64, filename, offset));
chunksize = mus_char_to_lint((unsigned char *)(hdrbuf + 4));
if ((chunksize == 0) && /* can be empty data chunk? */
(hdrbuf[0] == 0) && (hdrbuf[1] == 0) && (hdrbuf[2] == 0) && (hdrbuf[3] == 0))
@@ -2587,7 +2587,7 @@ static int read_avi_header(const char *filename, int fd)
if (data_location == 0)
return(mus_error(MUS_HEADER_READ_FAILED, "%s: no movi chunk?", filename));
if (data_location > true_file_length)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %" PRId64 " > file length: %" PRId64, filename, data_location, true_file_length));
data_size = mus_bytes_to_samples(sample_type, true_file_length - data_location);
return(MUS_NO_ERROR);
}
@@ -2687,7 +2687,7 @@ static int read_soundfont_header(const char *filename, int fd)
int chunksize;
offset += chunkloc;
if (seek_and_read(fd, (unsigned char *)hdrbuf, offset, 32) <= 0)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s soundfont header: chunks confused at %lld", filename, offset));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s soundfont header: chunks confused at %" PRId64, filename, offset));
chunksize = mus_char_to_lint((unsigned char *)(hdrbuf + 4));
if ((chunksize == 0) && /* can be empty data chunk? */
(hdrbuf[0] == 0) && (hdrbuf[1] == 0) && (hdrbuf[2] == 0) && (hdrbuf[3] == 0))
@@ -2969,7 +2969,7 @@ static int read_nist_header(const char *filename, int fd)
if ((data_size > true_file_length) && (original_sample_type != MUS_NIST_SHORTPACK))
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
}
data_size = mus_bytes_to_samples(sample_type, data_size);
@@ -2983,7 +2983,7 @@ static int write_nist_header(int fd, int wsrate, int wchans, mus_long_t size, mu
int datum;
datum = mus_bytes_per_sample(samp_type);
header = (char *)calloc(1024, sizeof(char));
- snprintf(header, 1024, "NIST_1A\n 1024\nchannel_count -i %d\nsample_rate -i %d\nsample_n_bytes -i %d\nsample_byte_format -s2 %s\nsample_sig_bits -i %d\nsample_count -i %lld\nend_head\n",
+ snprintf(header, 1024, "NIST_1A\n 1024\nchannel_count -i %d\nsample_rate -i %d\nsample_n_bytes -i %d\nsample_byte_format -s2 %s\nsample_sig_bits -i %d\nsample_count -i %" PRId64 "\nend_head\n",
wchans, wsrate, datum,
((samp_type == MUS_BSHORT) || (samp_type == MUS_B24INT) || (samp_type == MUS_BINT)) ? "10" : "01",
datum * 8,
@@ -3327,7 +3327,7 @@ static int read_8svx_header(const char *filename, int fd, bool bytewise)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
}
data_size = mus_bytes_to_samples(sample_type, data_size);
@@ -3363,7 +3363,7 @@ static int read_voc_header(const char *filename, int fd)
true_file_length = SEEK_FILE_LENGTH(fd);
curbase = mus_char_to_lshort((unsigned char *)(hdrbuf + 20));
if (true_file_length < curbase)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: block location %lld > file length: %lld", filename, curbase, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: block location %" PRId64 " > file length: %" PRId64, filename, curbase, true_file_length));
lseek(fd, curbase, SEEK_SET);
header_read(fd, hdrbuf, HDRBUFSIZ);
@@ -3448,7 +3448,7 @@ static int read_voc_header(const char *filename, int fd)
if ((data_size > true_file_length) || (data_size < (mus_long_t)(true_file_length / 10))) /* some VOC files seem to have completely bogus lengths */
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
}
data_size = mus_bytes_to_samples(sample_type, data_size);
@@ -3488,7 +3488,7 @@ static int read_twinvq_header(const char *filename, int fd)
srate = 48000;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
return(MUS_NO_ERROR);
}
@@ -3585,7 +3585,7 @@ static int read_nvf_header(const char *filename, int fd)
data_location = 44;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location) * 2; /* 4 bit samps? */
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
return(MUS_NO_ERROR);
}
#endif
@@ -3623,7 +3623,7 @@ static int read_adc_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
}
data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
@@ -3692,7 +3692,7 @@ static int read_avr_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
}
data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
@@ -3740,7 +3740,7 @@ static int read_sndt_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
}
return(MUS_NO_ERROR);
}
@@ -3761,7 +3761,7 @@ static int read_covox_header(const char *filename, int fd)
srate = 8000;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
return(MUS_NO_ERROR);
}
@@ -3796,7 +3796,7 @@ static int read_smp_header(const char *filename, int fd)
if ((data_size * 2) > true_file_length)
{
data_size = (true_file_length - data_location) / 2;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
}
return(MUS_NO_ERROR);
}
@@ -3856,7 +3856,7 @@ static int read_sppack_header(const char *filename, int fd)
}
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %" PRId64 " > file length: %" PRId64, filename, data_location, true_file_length));
if (data_size > mus_bytes_to_samples(sample_type, true_file_length))
data_size = mus_bytes_to_samples(sample_type, true_file_length - data_location);
return(MUS_NO_ERROR);
@@ -3899,7 +3899,7 @@ static int read_esps_header(const char *filename, int fd)
else data_location = mus_char_to_bint((unsigned char *)(hdrbuf + 8));
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
srate = 8000;
chans = 1;
lseek(fd, 132, SEEK_SET);
@@ -4018,7 +4018,7 @@ static int read_inrs_header(const char *filename, int fd, int loc)
data_location = 512;
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %" PRId64 " > file length: %" PRId64, filename, data_location, true_file_length));
data_size = mus_bytes_to_samples(sample_type, true_file_length - data_location);
return(MUS_NO_ERROR);
}
@@ -4119,7 +4119,7 @@ static int read_maud_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
}
data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
@@ -4211,7 +4211,7 @@ static int read_csl_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
}
data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
@@ -4258,7 +4258,7 @@ static int read_file_samp_header(const char *filename, int fd)
free(locbuf);
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %" PRId64 " > file length: %" PRId64, filename, data_location, true_file_length));
data_size = mus_bytes_to_samples(sample_type, true_file_length - data_location);
return(MUS_NO_ERROR);
}
@@ -4295,7 +4295,7 @@ static int read_sd1_header(const char *filename, int fd)
else sample_type = MUS_BYTE;
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %" PRId64 " > file length: %" PRId64, filename, data_location, true_file_length));
data_size = mus_bytes_to_samples(sample_type, true_file_length - data_location);
n = ((unsigned char)hdrbuf[44]);
if (n != 0)
@@ -4333,7 +4333,7 @@ static int read_psion_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
}
data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
@@ -4424,7 +4424,7 @@ static int read_gravis_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
}
data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
@@ -4445,7 +4445,7 @@ static int read_goldwave_header(const char *filename, int fd)
data_size = mus_char_to_lint((unsigned char *)(hdrbuf + 22));
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %" PRId64 " > file length: %" PRId64, filename, data_location, true_file_length));
if ((data_size <= 24) || (data_size > true_file_length))
data_size = (true_file_length - data_location) / 2;
else data_size /= 2;
@@ -4466,7 +4466,7 @@ static int read_srfs_header(const char *filename, int fd)
data_location = 32;
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %" PRId64 " > file length: %" PRId64, filename, data_location, true_file_length));
data_size = (true_file_length - data_location) / 2;
srate = mus_char_to_lint((unsigned char *)(hdrbuf + 6));
sample_type = MUS_LSHORT;
@@ -4487,7 +4487,7 @@ static int read_qt_header(const char *filename, int fd)
data_location = 12;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
srate = 11025; /* ?? */
sample_type = MUS_UBYTE;
return(MUS_NO_ERROR);
@@ -4578,7 +4578,7 @@ static int read_sbstudio_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
}
data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
@@ -4604,7 +4604,7 @@ static int read_delusion_header(const char *filename, int fd)
data_location = 55;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
srate = 8000;
sample_type = MUS_LSHORT;
data_size = mus_bytes_to_samples(sample_type, data_size);
@@ -4634,7 +4634,7 @@ static int read_farandole_header(const char *filename, int fd)
data_location = 51;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
srate = 8000;
if (hdrbuf[49] == 0)
sample_type = MUS_BYTE;
@@ -4669,7 +4669,7 @@ static int read_tx16w_header(const char *filename, int fd)
data_location = 32;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
srate = 16000;
if (hdrbuf[23] == 1) srate = 33000;
else if (hdrbuf[23] == 2) srate = 50000;
@@ -4711,7 +4711,7 @@ static int read_sy85_header(const char *filename, int fd)
data_location = 1024;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
srate = 8000; /* unknown */
sample_type = MUS_BSHORT; /* not right */
data_size = mus_bytes_to_samples(sample_type, data_size);
@@ -4731,7 +4731,7 @@ static int read_kurzweil_2000_header(const char *filename, int fd)
data_location = mus_char_to_bint((unsigned char *)(hdrbuf + 4));
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
srate = 44100; /* unknown */
sample_type = MUS_BSHORT;
data_size = mus_bytes_to_samples(sample_type, data_size);
@@ -4750,7 +4750,7 @@ static int read_korg_header(const char *filename, int fd)
data_location = 70;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
srate = mus_char_to_bint((unsigned char *)(hdrbuf + 48));
sample_type = MUS_BSHORT;
data_size = mus_bytes_to_samples(sample_type, data_size);
@@ -4771,7 +4771,7 @@ static int read_maui_header(const char *filename, int fd)
data_location = 776;
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %" PRId64 " > file length: %" PRId64, filename, data_location, true_file_length));
data_size = mus_char_to_lint((unsigned char *)(hdrbuf + 8));
if ((data_size * 2) > true_file_length)
data_size = (true_file_length - data_location) / 2;
@@ -4812,7 +4812,7 @@ static int read_impulsetracker_header(const char *filename, int fd)
data_location = mus_char_to_lint((unsigned char *)(hdrbuf + 72));
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %" PRId64 " > file length: %" PRId64, filename, data_location, true_file_length));
data_size = (true_file_length - data_location);
srate = mus_char_to_lint((unsigned char *)(hdrbuf + 60));
data_size = mus_bytes_to_samples(sample_type, data_size);
@@ -4828,7 +4828,7 @@ static int read_akai3_header(const char *filename, int fd)
data_location = 192;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
if (hdrbuf[1] == 0) srate = 22050; else srate = 44100;
sample_type = MUS_LSHORT;
data_size = mus_bytes_to_samples(sample_type, data_size);
@@ -4848,7 +4848,7 @@ static int read_akai4_header(const char *filename, int fd)
data_location = 42;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
srate = mus_char_to_ulshort((unsigned char *)(hdrbuf + 40));
sample_type = MUS_LSHORT;
data_size = mus_bytes_to_samples(sample_type, data_size);
@@ -4925,7 +4925,7 @@ static int read_ultratracker_header(const char *filename, int fd)
data_location = 64;
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %" PRId64 " > file length: %" PRId64, filename, data_location, true_file_length));
data_size = (true_file_length - data_location);
srate = 8000;
sample_type = MUS_LSHORT;
@@ -4979,7 +4979,7 @@ static int read_sample_dump_header(const char *filename, int fd)
data_location = i + 3 + len + 23;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
if (hdrbuf[0] == 0)
sample_type = MUS_ULSHORT;
else sample_type = MUS_UNKNOWN_SAMPLE;
@@ -5020,7 +5020,7 @@ static int read_digiplayer_header(const char *filename, int fd)
data_location = 80;
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
srate = 8000;
sample_type = MUS_ULSHORT;
if (hdrbuf[30] & 2) chans = 2;
@@ -5075,7 +5075,7 @@ static int read_adf_header(const char *filename, int fd)
data_location = 512;
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %" PRId64 " > file length: %" PRId64, filename, data_location, true_file_length));
if (data_size > mus_bytes_to_samples(sample_type, true_file_length - data_location))
data_size = mus_bytes_to_samples(sample_type, true_file_length - data_location);
return(MUS_NO_ERROR);
@@ -5127,7 +5127,7 @@ static int read_diamondware_header(const char *filename, int fd)
data_location = mus_char_to_lint((unsigned char *)(hdrbuf + 46));
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %" PRId64 " > file length: %" PRId64, filename, data_location, true_file_length));
if (data_size > true_file_length - data_location)
data_size = true_file_length - data_location;
data_size = mus_bytes_to_samples(sample_type, data_size);
@@ -5173,7 +5173,7 @@ static int read_paf_header(const char *filename, int fd)
data_location = 2048;
true_file_length = SEEK_FILE_LENGTH(fd);
if (true_file_length < data_location)
- return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %lld > file length: %lld", filename, data_location, true_file_length));
+ return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_location %" PRId64 " > file length: %" PRId64, filename, data_location, true_file_length));
if (sample_type != MUS_UNKNOWN_SAMPLE)
data_size = mus_bytes_to_samples(sample_type, true_file_length - 2048);
return(MUS_NO_ERROR);
@@ -5375,7 +5375,7 @@ static int read_asf_header(const char *filename, int fd)
if (data_size > true_file_length)
{
data_size = true_file_length - data_location;
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
}
data_size = mus_bytes_to_samples(sample_type, data_size);
return(MUS_NO_ERROR);
@@ -5424,7 +5424,7 @@ static int read_sox_header(const char *filename, int fd)
}
true_file_length = SEEK_FILE_LENGTH(fd);
data_size = (true_file_length - data_location);
- if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %lld?", filename, data_size));
+ if (data_size < 0) return(mus_error(MUS_HEADER_READ_FAILED, "%s: data_size = %" PRId64 "?", filename, data_size));
data_size = mus_bytes_to_samples(sample_type, data_size);
if (samps < data_size) data_size = samps;
return(MUS_NO_ERROR);
@@ -6285,7 +6285,7 @@ int mus_header_change_data_size(const char *filename, mus_header_t type, mus_lon
if (size < 0)
{
CLOSE(fd, filename);
- return(mus_error(MUS_BAD_SIZE, "%s: change size to %lld?", filename, size));
+ return(mus_error(MUS_BAD_SIZE, "%s: change size to %" PRId64 "?", filename, size));
}
switch (type)
@@ -6314,7 +6314,7 @@ int mus_header_change_data_size(const char *filename, mus_header_t type, mus_lon
if (size > BIGGEST_4_BYTE_SIGNED_INT)
{
err = MUS_BAD_SIZE;
- mus_print("%s size: %lld is too large for %s headers", filename, size, mus_header_type_name(type));
+ mus_print("%s size: %" PRId64 " is too large for %s headers", filename, size, mus_header_type_name(type));
size = BIGGEST_4_BYTE_SIGNED_INT;
}
lseek(fd, 4L, SEEK_SET);
@@ -6364,7 +6364,7 @@ int mus_header_change_data_size(const char *filename, mus_header_t type, mus_lon
if (size > BIGGEST_4_BYTE_SIGNED_INT)
{
err = MUS_BAD_SIZE;
- mus_print("%s size: %lld is too large for %s headers", filename, size, mus_header_type_name(type));
+ mus_print("%s size: %" PRId64 " is too large for %s headers", filename, size, mus_header_type_name(type));
size = BIGGEST_4_BYTE_SIGNED_INT;
}
lseek(fd, 0L, SEEK_SET);
diff --git a/io.c b/io.c
index c2d17f4..ab46ef7 100644
--- a/io.c
+++ b/io.c
@@ -1747,7 +1747,7 @@ mus_long_t mus_file_read(int tfd, mus_long_t beg, mus_long_t num, int chans, mus
mus_float_t *buffer;
buffer = bufs[k];
/* this happens routinely in mus_outa + initial write (reads ahead in effect) */
- /* fprintf(stderr, "clear from %lld for %lld\n", rtn, num-rtn); */
+ /* fprintf(stderr, "clear from %" PRId64 " for %" PRId64 "\n", rtn, num-rtn); */
mus_clear_floats(buffer + rtn, num - rtn);
}
}
@@ -1797,7 +1797,7 @@ static int checked_write(int tfd, char *buf, mus_long_t chars)
fd->name));
else
return(mus_error(MUS_WRITE_ERROR,
- "mus_write: write error for %s%s%s: only %" PRId64 " of %lld" " bytes written",
+ "mus_write: write error for %s%s%s: only %" PRId64 " of %" PRId64 " bytes written",
fd->name, (errno) ? ": " : "", (errno) ? STRERROR(errno) : "",
bytes, chars));
}
diff --git a/json.scm b/json.scm
new file mode 100644
index 0000000..1d7ac1d
--- /dev/null
+++ b/json.scm
@@ -0,0 +1,318 @@
+(define json->s7
+ (let ()
+ (define (strlet . args) ; inlet with keys as strings
+ (apply inlet (do ((p args (cddr p))
+ (fields ()))
+ ((null? p)
+ (reverse! fields))
+ (set! fields (cons (cadr p)
+ (cons (symbol (car p))
+ fields))))))
+ (let ((jlet (curlet)))
+ (lambda (str)
+ (do ((p (open-output-string))
+ (len (length str))
+ (i 0 (+ i 1)))
+ ((= i len)
+ (let ((result (eval-string (get-output-string p) jlet))) ; jlet so that strlet is defined
+ (close-output-port p)
+ result))
+
+ (case (str i)
+ ((#\{) ; {...} -> (inlet ...) via strlet above
+ (display "(strlet " p))
+
+ ((#\[) ; [...] -> (vector ...)
+ (display "(vector " p))
+
+ ((#\} #\])
+ (write-char #\) p))
+
+ ((#\: #\,)
+ (write-char #\space p))
+
+ ((#\")
+ (let ((qpos (char-position #\" str (+ i 1))))
+ (if (not qpos)
+ (format *stderr* "no close quote: ~S ~S~%" (substring str 0 i) (substring str i)))
+ (if (char=? (str (- qpos 1)) #\\) ; stopgap...
+ (set! qpos (char-position #\" str (+ qpos 1))))
+ (display (substring str i (+ qpos 1)) p)
+ (set! i qpos)))
+
+ ((#\t) ; true -> #t
+ (if (and (< i (- len 3))
+ (string=? (substring str i (+ i 4)) "true"))
+ (begin
+ (display "#t" p)
+ (set! i (+ i 3)))
+ (format *stderr* "bad entry: ~S~%" (substring str i))))
+
+ ((#\n) ; null -> ()
+ (if (and (< i (- len 3))
+ (string=? (substring str i (+ i 4)) "null"))
+ (begin
+ (display "()" p)
+ (set! i (+ i 3)))
+ (format *stderr* "bad entry: ~S~%" (substring str i))))
+
+ ((#\f) ; false -> #f
+ (if (and (< i (- len 4))
+ (string=? (substring str i (+ i 5)) "false"))
+ (begin
+ (display "#f" p)
+ (set! i (+ i 4)))
+ (format *stderr* "bad entry: ~S~%" (substring str i))))
+
+ (else
+ (write-char (str i) p))))))))
+
+;;; TODO: in the strings we need to support the 4-digit stuff (\uxxxx I think)
+;;; (json->s7 "{\"test\" : \"a\\u1234b\"}") -> (inlet 'test "a\x1234;b")
+;;; but the real problem is that \u in a string is an error in scheme, so we need use read-error-hook
+;;; to catch the \unnnn stuff before we call json->s7. See lint.scm.
+
+(define* (s7->json obj (port (current-output-port)))
+ (case (type-of obj)
+ ((integer? float?)
+ (display obj port))
+
+ ((string?)
+ (write obj port))
+
+ ((vector? float-vector? int-vector? byte-vector?)
+ (let ((len (length obj)))
+ (if (zero? len)
+ (display "[]" port)
+ (begin
+ (write-char #\[ port)
+ (do ((i 0 (+ i 1)))
+ ((= i (- len 1))
+ (s7->json (obj i) port)
+ (write-char #\] port))
+ (s7->json (obj i) port)
+ (display ", " port))))))
+
+ ((let?)
+ (let ((len (length obj)))
+ (if (zero? len)
+ (display "{}" port)
+ (let ((slot-ctr 1))
+ (write-char #\{ port)
+ (for-each (lambda (slot)
+ (write (symbol->string (car slot)) port)
+ (display " : " port)
+ (s7->json (cdr slot) port)
+ (if (< slot-ctr len)
+ (display ", " port)
+ (write-char #\} port))
+ (set! slot-ctr (+ slot-ctr 1)))
+ (reverse obj))))))
+ (else
+ (format *stderr* "bad entry: ~S~%" obj))))
+
+
+#|
+;;; -------------------------------- tests --------------------------------
+
+(display (with-output-to-string (lambda () (s7->json (vector 1 2))))) (newline) ; "[1, 2]"
+(display (with-output-to-string (lambda () (s7->json (vector "asdf" #i(1 2)))))) (newline) ; "[\"asdf\", [1, 2]]"
+(display (with-output-to-string (lambda () (s7->json (inlet 'a 2))))) (newline) ; "{\"a\" : 2}
+
+(display
+ (with-output-to-string
+ (lambda ()
+ (s7->json (json->s7 "{\"title\": \"Person\", \"type\": \"object\"}")))))
+(newline)
+
+
+(write (json->s7 "{\"test\":\"a\\\\b\"}")) (newline) ; (inlet 'test "a\\b") = (#\a #\\ #\b)
+(write (json->s7 "{\"test\" : \"a\tb\"}")) (newline) ; (string->list ((inlet 'test "a\x09b") 'test)) = (#\a #\tab #\b)
+(write (json->s7 "{\"test\":\"a\fb\"}")) (newline) ; (inlet 'test "a\x0cb")
+(write (json->s7 "{\"test\":\"a\rb\"}")) (newline) ; (inlet 'test "a\x0db")
+(write (json->s7 "{\"test\":\"a\bb\"}")) (newline) ; (inlet 'test "a\x08b")
+(write (json->s7 "{\"test\":\"a\/b\"}")) (newline) ; (inlet 'test "a/b")
+
+(write (json->s7 "[123 321]")) (newline)
+(write (json->s7 "{\"asdf\" : 123}")) (newline)
+(write (json->s7 "{\"asdf\":123}")) (newline)
+(write (json->s7 "[1 {\"asdf\" : \"fsda\"} 2]")) (newline)
+(write (json->s7 "[1.2 [3 [\"asdf\"]]]")) (newline)
+(write (json->s7 "[{} [] \"\"]")) (newline)
+
+;; some examples from json-schema.org and another site -- sitepoint?
+(write (json->s7 "{
+ \"title\": \"Person\",
+ \"type\": \"object\",
+ \"properties\": {
+ \"firstName\": {
+ \"type\": \"string\"
+ },
+ \"lastName\": {
+ \"type\": \"string\"
+ },
+ \"age\": {
+ \"description\": \"Age in years\",
+ \"type\": \"integer\",
+ \"minimum\": 0
+ }
+ },
+ \"required\": [\"firstName\", \"lastName\"]
+}"))
+(newline)
+
+(write (json->s7 "{ \"id\": \"http://json-schema.org/geo\", \"$schema\": \"http://json-schema.org/draft-06/schema#\", \"description\": \"A geographical coordinate\", \"type\": \"object\", \"properties\": { \"latitude\": { \"type\": \"number\" }, \"longitude\": { \"type\": \"number\" } } }")) (newline)
+
+(write (json->s7 "{ \"$schema\": \"http://json-schema.org/draft-06/schema#\", \"description\": \"A representation of a person, company, organization, or place\", \"type\": \"object\", \"required\": [\"familyName\", \"givenName\"], \"properties\": { \"fn\": { \"description\": \"Formatted Name\", \"type\": \"string\" }, \"familyName\": { \"type\": \"string\" }, \"givenName\": { \"type\": \"string\" }, \"additionalName\": { \"type\": \"array\", \"items\": { \"type\": \"string\" } }, \"honorificPrefix\": { \"type\": \"array\", \"items\": { \"type\": \"string\" } }, \"honorificSuffix\": { \"type\": \"array\", \"items\": { \"type\": \"string\" } }, \"nickname\": { \"type\": \"string\" }, \"url\": { \"type\": \"string\", \"format\": \"uri\" }, \"email\": { \"type\": \"object\", \"properties\": { \"type\": { \"type\": \"string\" }, \"value\": { \"type\": \"string\", \"format\": \"email\" } } }, \"tel\": { \"type\": \"object\", \"properties\": { \"type\": { \"type\": \"string\" }, \"value\": { \"type\": \"string\", \"format\": \"phone\" } } }, \"adr\": { \"$ref\": \"http://json-schema.org/address\" }, \"geo\": { \"$ref\": \"http://json-schema.org/geo\" }, \"tz\": { \"type\": \"string\" }, \"photo\": { \"type\": \"string\" }, \"logo\": { \"type\": \"string\" }, \"sound\": { \"type\": \"string\" }, \"bday\": { \"type\": \"string\", \"format\": \"date\" }, \"title\": { \"type\": \"string\" }, \"role\": { \"type\": \"string\" }, \"org\": { \"type\": \"object\", \"properties\": { \"organizationName\": { \"type\": \"string\" }, \"organizationUnit\": { \"type\": \"string\" } } } } } ")) (newline)
+
+(write (json->s7 "{ \"$schema\": \"http://json-schema.org/draft-06/schema#\", \"description\": \"A representation of an event\", \"type\": \"object\", \"required\": [ \"dtstart\", \"summary\" ], \"properties\": { \"dtstart\": { \"format\": \"date-time\", \"type\": \"string\", \"description\": \"Event starting time\" }, \"dtend\": { \"format\": \"date-time\", \"type\": \"string\", \"description\": \"Event ending time\" }, \"summary\": { \"type\": \"string\" }, \"location\": { \"type\": \"string\" }, \"url\": { \"type\": \"string\", \"format\": \"uri\" }, \"duration\": { \"format\": \"time\", \"type\": \"string\", \"description\": \"Event duration\" }, \"rdate\": { \"format\": \"date-time\", \"type\": \"string\", \"description\": \"Recurrence date\" }, \"rrule\": { \"type\": \"string\", \"description\": \"Recurrence rule\" }, \"category\": { \"type\": \"string\" }, \"description\": { \"type\": \"string\" }, \"geo\": { \"$ref\": \"http://json-schema.org/geo\" } } } ")) (newline)
+
+(write (json->s7 "{ \"$schema\": \"http://json-schema.org/draft-06/schema#\", \"description\": \"An Address following the convention of http://microformats.org/wiki/hcard\", \"type\": \"object\", \"properties\": { \"post-office-box\": { \"type\": \"string\" }, \"extended-address\": { \"type\": \"string\" }, \"street-address\": { \"type\": \"string\" }, \"locality\":{ \"type\": \"string\" }, \"region\": { \"type\": \"string\" }, \"postal-code\": { \"type\": \"string\" }, \"country-name\": { \"type\": \"string\"} }, \"required\": [\"locality\", \"region\", \"country-name\"], \"dependencies\": { \"post-office-box\": [\"street-address\"], \"extended-address\": [\"street-address\"] } } ")) (newline)
+
+(write (json->s7 "{
+ \"id\": 1,
+ \"name\": \"A green door\",
+ \"price\": 12.50,
+ \"tags\": [\"home\", \"green\"]
+}")) (newline)
+
+(write (json->s7 "[
+ {
+ \"id\": 2,
+ \"name\": \"An ice sculpture\",
+ \"price\": 12.50,
+ \"tags\": [\"cold\", \"ice\"],
+ \"dimensions\": {
+ \"length\": 7.0,
+ \"width\": 12.0,
+ \"height\": 9.5
+ },
+ \"warehouseLocation\": {
+ \"latitude\": -78.75,
+ \"longitude\": 20.4
+ }
+ },
+ {
+ \"id\": 3,
+ \"name\": \"A blue mouse\",
+ \"price\": 25.50,
+ \"dimensions\": {
+ \"length\": 3.1,
+ \"width\": 1.0,
+ \"height\": 1.0
+ },
+ \"warehouseLocation\": {
+ \"latitude\": 54.4,
+ \"longitude\": -32.7
+ }
+ }
+]"))
+(newline)
+
+(write (json->s7 "{
+ \"id\": \"http://some.site.somewhere/entry-schema#\",
+ \"$schema\": \"http://json-schema.org/draft-06/schema#\",
+ \"description\": \"schema for an fstab entry\",
+ \"type\": \"object\",
+ \"required\": [ \"storage\" ],
+ \"properties\": {
+ \"storage\": {
+ \"type\": \"object\",
+ \"oneOf\": [
+ { \"$ref\": \"#/definitions/diskDevice\" },
+ { \"$ref\": \"#/definitions/diskUUID\" },
+ { \"$ref\": \"#/definitions/nfs\" },
+ { \"$ref\": \"#/definitions/tmpfs\" }
+ ]
+ },
+ \"fstype\": {
+ \"enum\": [ \"ext3\", \"ext4\", \"btrfs\" ]
+ },
+ \"options\": {
+ \"type\": \"array\",
+ \"minItems\": 1,
+ \"items\": { \"type\": \"string\" },
+ \"uniqueItems\": true
+ },
+ \"readonly\": { \"type\": \"boolean\" }
+ },
+ \"definitions\": {
+ \"diskDevice\": {
+ \"properties\": {
+ \"type\": { \"enum\": [ \"disk\" ] },
+ \"device\": {
+ \"type\": \"string\",
+ \"pattern\": \"^/dev/[^/]+(/[^/]+)*$\"
+ }
+ },
+ \"required\": [ \"type\", \"device\" ],
+ \"additionalProperties\": false
+ },
+ \"diskUUID\": {
+ \"properties\": {
+ \"type\": { \"enum\": [ \"disk\" ] },
+ \"label\": {
+ \"type\": \"string\",
+ \"pattern\": \"^[a-fA-F0-9]{8}-[a-fA-F0-9]{4}-[a-fA-F0-9]{4}-[a-fA-F0-9]{4}-[a-fA-F0-9]{12}$\"
+ }
+ },
+ \"required\": [ \"type\", \"label\" ],
+ \"additionalProperties\": false
+ },
+ \"nfs\": {
+ \"properties\": {
+ \"type\": { \"enum\": [ \"nfs\" ] },
+ \"remotePath\": {
+ \"type\": \"string\",
+ \"pattern\": \"^(/[^/]+)+$\"
+ },
+ \"server\": {
+ \"type\": \"string\",
+ \"oneOf\": [
+ { \"format\": \"hostname\" },
+ { \"format\": \"ipv4\" },
+ { \"format\": \"ipv6\" }
+ ]
+ }
+ },
+ \"required\": [ \"type\", \"server\", \"remotePath\" ],
+ \"additionalProperties\": false
+ },
+ \"tmpfs\": {
+ \"properties\": {
+ \"type\": { \"enum\": [ \"tmpfs\" ] },
+ \"sizeInMB\": {
+ \"type\": \"integer\",
+ \"minimum\": 16,
+ \"maximum\": 512
+ }
+ },
+ \"required\": [ \"type\", \"sizeInMB\" ],
+ \"additionalProperties\": false
+ }
+ }
+}
+")) (newline)
+
+
+(write (json->s7 "{
+ \"aliceblue\": [240, 248, 255, 1],
+ \"antiquewhite\": [250, 235, 215, 1],
+ \"aqua\": [0, 255, 255, 1],
+ \"aquamarine\": [127, 255, 212, 1],
+ \"azure\": [240, 255, 255, 1],
+ \"beige\": [245, 245, 220, 1],
+ \"bisque\": [255, 228, 196, 1],
+ \"black\": [0, 0, 0, 1],
+ \"blanchedalmond\": [255, 235, 205, 1],
+ \"blue\": [0, 0, 255, 1],
+ \"blueviolet\": [138, 43, 226, 1],
+ \"brown\": [165, 42, 42, 1],
+ \"burlywood\": [222, 184, 135, 1],
+ \"cadetblue\": [95, 158, 160, 1],
+ \"chartreuse\": [127, 255, 0, 1],
+ \"chocolate\": [210, 105, 30, 1],
+ \"coral\": [255, 127, 80, 1],
+}"))
+(newline)
+|#
diff --git a/libc.scm b/libc.scm
index 5fb440c..d6241f1 100644
--- a/libc.scm
+++ b/libc.scm
@@ -22,7 +22,7 @@
;; -------- stddef.h --------
(define NULL (c-pointer 0 'void*))
- (define (c-null? p) (equal? p NULL))
+ (define (c-null? p) (and (c-pointer? p) (equal? p (c-pointer 0 ((object->let p) 'c-type)))))
;; -------- stdbool.h --------
(define false #f)
@@ -169,16 +169,21 @@
(C-macro (int (FE_INEXACT FE_DIVBYZERO FE_UNDERFLOW FE_OVERFLOW FE_INVALID FE_ALL_EXCEPT
FE_TONEAREST FE_UPWARD FE_DOWNWARD FE_TOWARDZERO)))
(int feclearexcept (int))
- (int fegetexceptflag (fexcept_t* int) )
- (int feraiseexcept (int) )
- (int fesetexceptflag (fexcept_t* int) )
- (int fetestexcept (int) )
- (int fegetround (void) )
- (int fesetround (int) )
- (int fegetenv (fenv_t*) )
- (int feholdexcept (fenv_t*) )
- (int fesetenv (fenv_t*) )
- (int feupdateenv (fenv_t*) )
+ (int fegetexceptflag (fexcept_t* int))
+ (int feraiseexcept (int))
+ (int fesetexceptflag (fexcept_t* int))
+ (int fetestexcept (int))
+ (int fegetround (void))
+ (int fesetround (int))
+ (int fegetenv (fenv_t*))
+ (int feholdexcept (fenv_t*))
+ (int fesetenv (fenv_t*))
+ (int feupdateenv (fenv_t*))
+ ;(C-macro (fenv_t* (FE_DFL_ENV)))
+ (in-C "static s7_pointer g_fenv_t_make(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(fenv_t)), s7_make_symbol(sc, \"fenv_t*\"), s7_f(sc)));}")
+ (C-function ("fenv_t.make" g_fenv_t_make "" 0))
+
;; -------- fnmatch.h --------
@@ -294,7 +299,7 @@
(void* malloc (size_t))
(void* calloc (size_t size_t))
(void* realloc (void* size_t))
- (void free (void*))
+; (void free (void*))
(void abort (void))
(void exit (int))
(char* getenv (char*))
@@ -304,7 +309,7 @@
; (char* mktemp (char*))
(int mkstemp (char*))
(int system (char*))
- (char* realpath (char* char*))
+; (char* realpath (char* char*))
(int abs (int))
(int labs (int))
@@ -316,6 +321,18 @@
return(s7_make_integer(sc, llabs(s7_integer(s7_car(args)))));
#endif
}
+ static s7_pointer g_realpath(s7_scheme *sc, s7_pointer args)
+ {
+ char *s7_dl_realpath_0, *res;
+ if (s7_is_string(s7_car(args)))
+ s7_dl_realpath_0 = (char*)s7_string(s7_car(args));
+ else return(s7_wrong_type_arg_error(sc, \"realpath\", 1, s7_car(args), \"string\"));
+ res = realpath(s7_dl_realpath_0, NULL);
+ if (res) {s7_pointer str; str = s7_make_string(sc, res); free(res); return(str);}
+ return(s7_f(sc));
+ }
+ static s7_pointer g_free(s7_scheme *sc, s7_pointer args)
+ {free(s7_c_pointer(s7_car(args))); return(s7_f(sc));}
static s7_pointer g_strtod(s7_scheme *sc, s7_pointer args)
{return(s7_make_real(sc, strtod(s7_string(s7_car(args)), NULL)));}
static s7_pointer g_strtof(s7_scheme *sc, s7_pointer args)
@@ -327,23 +344,29 @@
static s7_pointer g_div(s7_scheme *sc, s7_pointer args)
{
div_t d;
+ if (!s7_is_integer(s7_car(args))) return(s7_wrong_type_arg_error(sc, \"div\", 1, s7_car(args), \"integer\"));
+ if (!s7_is_integer(s7_cadr(args))) return(s7_wrong_type_arg_error(sc, \"div\", 2, s7_cadr(args), \"integer\"));
d = div(s7_integer(s7_car(args)), s7_integer(s7_cadr(args)));
return(s7_list(sc, 2, s7_make_integer(sc, d.quot), s7_make_integer(sc, d.rem)));
}
static s7_pointer g_ldiv(s7_scheme *sc, s7_pointer args)
{
ldiv_t d;
+ if (!s7_is_integer(s7_car(args))) return(s7_wrong_type_arg_error(sc, \"ldiv\", 1, s7_car(args), \"integer\"));
+ if (!s7_is_integer(s7_cadr(args))) return(s7_wrong_type_arg_error(sc, \"ldiv\", 2, s7_cadr(args), \"integer\"));
d = ldiv(s7_integer(s7_car(args)), s7_integer(s7_cadr(args)));
return(s7_list(sc, 2, s7_make_integer(sc, d.quot), s7_make_integer(sc, d.rem)));
}
")
(C-function ("llabs" g_llabs "" 1))
+ (C-function ("free" g_free "" 1))
(C-function ("strtod" g_strtod "" 1))
(C-function ("strtof" g_strtof "" 1))
(C-function ("strtol" g_strtol "" 2))
(C-function ("strtoll" g_strtoll "" 2))
(C-function ("div" g_div "" 1))
(C-function ("ldiv" g_ldiv "" 1))
+ (C-function ("realpath" g_realpath "" 2))
;; -------- errno.h --------
@@ -655,7 +678,7 @@
static s7_pointer g_st_ctime(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct stat *)s7_c_pointer(s7_car(args)))->st_ctime));}
static s7_pointer g_stat_make(s7_scheme *sc, s7_pointer args)
- {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(struct stat))));}
+ {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct stat)), s7_make_symbol(sc, \"stat*\"), s7_f(sc)));}
")
(C-function ("S_ISDIR" g_isdir "" 1))
@@ -856,7 +879,7 @@
return(s7_make_integer(sc, tcsetattr(s7_integer(s7_car(args)), s7_integer(s7_cadr(args)), p)));
}
static s7_pointer g_termios_make(s7_scheme *sc, s7_pointer args)
- {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(struct termios))));}
+ {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct termios)), s7_make_symbol(sc, \"termios*\"), s7_f(sc)));}
static s7_pointer g_termios_c_lflag(s7_scheme *sc, s7_pointer args)
{
@@ -895,14 +918,31 @@
;; -------- grp.h --------
- (void* getgrgid (int))
- (void* getgrnam (char*))
- (in-C "static s7_pointer g_group_gr_name(s7_scheme *sc, s7_pointer args)
- {return(s7_make_string(sc, ((struct group *)s7_c_pointer(s7_car(args)))->gr_name));}
+ (in-C "static s7_pointer g_getgrgid(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer_with_type(sc, getgrgid(s7_integer(s7_car(args))), s7_make_symbol(sc, \"struct group*\"), s7_f(sc)));}
+ static s7_pointer g_getgrnam(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_c_pointer_with_type(sc, getgrnam(s7_string(s7_car(args))), s7_make_symbol(sc, \"struct group*\"), s7_f(sc)));}
+ static s7_pointer g_group_gr_name(s7_scheme *sc, s7_pointer args)
+ {
+ struct group *g;
+ g = (struct group *)s7_c_pointer(s7_car(args));
+ if (!g) return(s7_make_string(sc, \"\"));
+ return(s7_make_string(sc, ((struct group *)g)->gr_name));
+ }
static s7_pointer g_group_gr_passwd(s7_scheme *sc, s7_pointer args)
- {return(s7_make_string(sc, ((struct group *)s7_c_pointer(s7_car(args)))->gr_passwd));}
+ {
+ struct group *g;
+ g = (struct group *)s7_c_pointer(s7_car(args));
+ if (!g) return(s7_make_string(sc, \"\"));
+ return(s7_make_string(sc, ((struct group *)s7_c_pointer(s7_car(args)))->gr_passwd));
+ }
static s7_pointer g_group_gr_gid(s7_scheme *sc, s7_pointer args)
- {return(s7_make_integer(sc, (s7_int)(((struct group *)s7_c_pointer(s7_car(args)))->gr_gid)));}
+ {
+ struct group *g;
+ g = (struct group *)s7_c_pointer(s7_car(args));
+ if (!g) return(s7_make_integer(sc, -1));
+ return(s7_make_integer(sc, (s7_int)(((struct group *)s7_c_pointer(s7_car(args)))->gr_gid)));
+ }
static s7_pointer g_group_gr_mem(s7_scheme *sc, s7_pointer args)
{
s7_pointer p;
@@ -915,18 +955,22 @@
return(p);
}
")
+ (C-function ("getgrgid" g_getgrgid "" 1))
+ (C-function ("getgrnam" g_getgrnam "" 1))
(C-function ("group.gr_name" g_group_gr_name "" 1))
(C-function ("group.gr_passwd" g_group_gr_passwd "" 1))
(C-function ("group.gr_gid" g_group_gr_gid "" 1))
(C-function ("group.gr_mem" g_group_gr_mem "" 1))
- ;; ((*libc* 'group.gr_name) ((*libc* 'getgrnam) "wheel")) -> "wheel"
+ ;; ((*libc* 'group.gr_name) ((*libc* 'getgrnam) "wheel")) -> "wheel" (if any)
+ ;; ((*libc* 'group.gr_name) ((*libc* 'getgrgid) 0)) -> "root"
+ ;; ((*libc* 'group.gr_gid) ((*libc* 'getgrnam) "root")) -> 0
;; -------- pwd.h --------
(C-macro (int NSS_BUFLEN_PASSWD))
(void setpwent (void))
(void endpwent (void))
- (void* getpwent (void))
+ (void* getpwent (void)) ; we ignore the type below so this should be ok
(void* getpwuid (int))
(void* getpwnam (char*))
(in-C "static s7_pointer g_passwd_pw_name(s7_scheme *sc, s7_pointer args)
@@ -961,7 +1005,7 @@
(int wordexp (char* wordexp_t* int))
(void wordfree (wordexp_t*))
(in-C "static s7_pointer g_wordexp_make(s7_scheme *sc, s7_pointer args)
- {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(wordexp_t))));}
+ {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(wordexp_t)), s7_make_symbol(sc, \"wordexp_t*\"), s7_f(sc)));}
static s7_pointer g_wordexp_we_wordc(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((wordexp_t *)s7_c_pointer(s7_car(args)))->we_wordc));}
static s7_pointer g_wordexp_we_wordv(s7_scheme *sc, s7_pointer args)
@@ -988,7 +1032,7 @@
GLOB_NOSPACE GLOB_ABORTED GLOB_NOMATCH GLOB_NOSYS)))
(void globfree (glob_t*))
(in-C "static s7_pointer g_glob_make(s7_scheme *sc, s7_pointer args)
- {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(glob_t))));}
+ {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(glob_t)), s7_make_symbol(sc, \"glob_t*\"), s7_f(sc)));}
static s7_pointer g_glob_gl_pathc(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((glob_t *)s7_c_pointer(s7_car(args)))->gl_pathc));}
static s7_pointer g_glob(s7_scheme *sc, s7_pointer args)
@@ -1043,14 +1087,14 @@
(int setpriority (int int int))
(in-C "static s7_pointer g_rlimit_make(s7_scheme *sc, s7_pointer args)
- {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(struct rlimit))));}
+ {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct rlimit)), s7_make_symbol(sc, \"rlimit*\"), s7_f(sc)));}
static s7_pointer g_rlimit_rlim_cur(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct rlimit *)s7_c_pointer(s7_car(args)))->rlim_cur));}
static s7_pointer g_rlimit_rlim_max(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct rlimit *)s7_c_pointer(s7_car(args)))->rlim_max));}
static s7_pointer g_rusage_make(s7_scheme *sc, s7_pointer args)
- {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(struct rusage))));}
+ {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct rusage)), s7_make_symbol(sc, \"struct rusage*\"), s7_f(sc)));}
static s7_pointer g_rusage_ru_maxrss(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct rusage *)s7_c_pointer(s7_car(args)))->ru_maxrss));}
static s7_pointer g_rusage_ru_minflt(s7_scheme *sc, s7_pointer args)
@@ -1069,9 +1113,11 @@
{return(s7_make_c_pointer(sc, &(((struct rusage *)s7_c_pointer(s7_car(args)))->ru_utime)));}
static s7_pointer g_rusage_ru_stime(s7_scheme *sc, s7_pointer args)
{return(s7_make_c_pointer(sc, &(((struct rusage *)s7_c_pointer(s7_car(args)))->ru_stime)));}
+ static s7_pointer g_getrusage(s7_scheme *sc, s7_pointer args)
+ {return(s7_make_integer(sc, getrusage(s7_integer(s7_car(args)), (struct rusage *)s7_c_pointer(s7_cadr(args)))));}
static s7_pointer g_sigset_make(s7_scheme *sc, s7_pointer args)
- {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(sigset_t))));}
+ {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(sigset_t)), s7_make_symbol(sc, \"sigset_t*\"), s7_f(sc)));}
#if __linux__
static s7_pointer g_WEXITSTATUS(s7_scheme *sc, s7_pointer args)
@@ -1134,7 +1180,7 @@
}
#if __linux__
static s7_pointer g_siginfo_make(s7_scheme *sc, s7_pointer args)
- {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(siginfo_t))));}
+ {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(siginfo_t)), s7_make_symbol(sc, \"siginfo_t*\"), s7_f(sc)));}
static s7_pointer g_siginfo_si_signo(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_signo));}
static s7_pointer g_siginfo_si_errno(s7_scheme *sc, s7_pointer args)
@@ -1164,20 +1210,20 @@
static s7_pointer g_siginfo_si_fd(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_fd));}
static s7_pointer g_siginfo_si_ptr(s7_scheme *sc, s7_pointer args)
- {return(s7_make_c_pointer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_ptr));}
+ {return(s7_make_c_pointer_with_type(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_ptr, s7_make_symbol(sc, \"siginfo_t*\"), s7_f(sc)));}
static s7_pointer g_siginfo_si_addr(s7_scheme *sc, s7_pointer args)
- {return(s7_make_c_pointer(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_addr));}
+ {return(s7_make_c_pointer_with_type(sc, ((siginfo_t *)s7_c_pointer(s7_car(args)))->si_addr, s7_make_symbol(sc, \"siginfo_t*\"), s7_f(sc)));}
#endif
static s7_pointer g_timespec_make(s7_scheme *sc, s7_pointer args)
- {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(struct timespec))));}
+ {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct timespec)), s7_make_symbol(sc, \"timespec*\"), s7_f(sc)));}
static s7_pointer g_timespec_tv_sec(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct timespec *)s7_c_pointer(s7_car(args)))->tv_sec));}
static s7_pointer g_timespec_tv_nsec(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct timespec *)s7_c_pointer(s7_car(args)))->tv_nsec));}
static s7_pointer g_sigaction_make(s7_scheme *sc, s7_pointer args)
- {return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(sigaction))));}
+ {return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(sigaction)), s7_make_symbol(sc, \"sigaction*\"), s7_f(sc)));}
static s7_pointer g_sigaction_sa_flags(s7_scheme *sc, s7_pointer args)
{return(s7_make_integer(sc, ((struct sigaction *)s7_c_pointer(s7_car(args)))->sa_flags));}
static s7_pointer g_sigaction_set_sa_flags(s7_scheme *sc, s7_pointer args)
@@ -1267,6 +1313,7 @@
(C-function ("rlimit.rlim_max" g_rlimit_rlim_max "" 1))
(C-function ("rusage.make" g_rusage_make "" 0))
+ (C-function ("getrusage" g_getrusage "" 2))
(C-function ("rusage.ru_maxrss" g_rusage_ru_maxrss "" 1))
(C-function ("rusage.ru_minflt" g_rusage_ru_minflt "" 1))
(C-function ("rusage.ru_majflt" g_rusage_ru_majflt "" 1))
@@ -1334,7 +1381,6 @@
(int getrlimit (int void*))
(int setrlimit (int void*))
- (int getrusage (int void*))
(reader-cond ((provided? 'linux)
(int sigwaitinfo (sigset_t* siginfo_t*))
(int waitid (int int siginfo_t* int))))
@@ -1417,7 +1463,7 @@
static s7_pointer g_addrinfo_make(s7_scheme *sc, s7_pointer args)
{
- return(s7_make_c_pointer(sc, (void *)calloc(1, sizeof(struct addrinfo))));
+ return(s7_make_c_pointer_with_type(sc, (void *)calloc(1, sizeof(struct addrinfo)), s7_make_symbol(sc, \"addrinfo*\"), s7_f(sc)));
}
static s7_pointer g_addrinfo_ai_flags(s7_scheme *sc, s7_pointer args)
@@ -1465,7 +1511,7 @@
}
static s7_pointer g_addrinfo_ai_next(s7_scheme *sc, s7_pointer args)
{
- return(s7_make_c_pointer(sc, (void *)(((struct addrinfo *)s7_c_pointer(s7_car(args)))->ai_next)));
+ return(s7_make_c_pointer_with_type(sc, (void *)(((struct addrinfo *)s7_c_pointer(s7_car(args)))->ai_next), s7_make_symbol(sc, \"addrinfo*\"), s7_f(sc)));
}
static s7_pointer g_getaddrinfo(s7_scheme *sc, s7_pointer args)
diff --git a/libgsl.scm b/libgsl.scm
index 378c3ee..3caa933 100644
--- a/libgsl.scm
+++ b/libgsl.scm
@@ -30,7 +30,7 @@
(define gsl-version 0.0) ; define at top-level no matter where we are now
(when (and (provided? 'linux)
(defined? 'system))
- (let* ((version (system "pkg-config gsl --modversion" #t))
+ (let* ((version (#_system "pkg-config gsl --modversion" #t))
(len (length version)))
(when (positive? len)
(set! gsl-version (string->number (if (char=? (version (- len 1)) #\newline)
diff --git a/libgtk_s7.c b/libgtk_s7.c
index 8e47713..6fb58ee 100644
--- a/libgtk_s7.c
+++ b/libgtk_s7.c
@@ -44,118 +44,120 @@ static bool s7_equalp_xm(void *x1, void *x2)
}
static s7_pointer make_xm_obj(s7_scheme *sc, void *ptr)
{
- return(s7_make_object(sc, xm_obj_tag, ptr));
+ return(s7_make_c_object(sc, xm_obj_tag, ptr));
}
static void define_xm_obj(s7_scheme *sc)
{
- xm_obj_tag = s7_new_type_x(sc, "<XmObj>", NULL, xm_obj_free, s7_equalp_xm, NULL, NULL, NULL, NULL, NULL, NULL, NULL);
+ xm_obj_tag = s7_make_c_type(sc, "XgObj");
+ s7_c_type_set_free(sc, xm_obj_tag, xm_obj_free);
+ s7_c_type_set_equal(sc, xm_obj_tag, s7_equalp_xm);
}
-static s7_pointer GtkCenterBox__sym, GtkCheckButton__sym, GdkDrawContext__sym, GtkDrawingAreaDrawFunc_sym, GtkShortcutLabel__sym,
- GtkPadActionType_sym, GtkPadActionEntry__sym, GActionGroup__sym, GtkPadController__sym, GdkDevicePadFeature_sym,
- GdkDevicePad__sym, GdkDrawingContext__sym, GdkSubpixelLayout_sym, GdkMonitor__sym, GdkDeviceTool__sym,
- GdkAxisFlags_sym, GdkSeatGrabPrepareFunc_sym, GdkSeatCapabilities_sym, GdkGrabStatus_sym, GtkPopoverConstraint_sym,
- GtkShortcutsWindow__sym, GtkStackSidebar__sym, GtkSearchEntry__sym, GtkPopoverMenu__sym, GtkStyleContext__sym,
- GdkGLContext__sym, GtkGLArea__sym, GtkPropagationPhase_sym, GtkEventController__sym, GtkGestureZoom__sym,
- GtkGestureSwipe__sym, GtkGestureSingle__sym, GtkGestureRotate__sym, GtkGestureMultiPress__sym, GtkGesturePan__sym,
- GtkGestureDrag__sym, GdkEventSequence__sym, GtkEventSequenceState_sym, GtkGesture__sym, GtkPopover__sym,
- GtkActionBar__sym, GtkFlowBox__sym, GtkFlowBoxChild__sym, GdkEventType_sym, GtkSearchBar__sym,
- GtkListBox__sym, GtkListBoxRow__sym, GtkHeaderBar__sym, GtkRevealerTransitionType_sym, GtkRevealer__sym,
- GtkStackTransitionType_sym, GtkStack__sym, GtkStackSwitcher__sym, GtkPlacesSidebar__sym, GtkPlacesOpenFlags_sym,
- GtkBaselinePosition_sym, GdkFullscreenMode_sym, GtkInputHints_sym, GtkInputPurpose_sym, GtkLevelBarMode_sym,
- GtkLevelBar__sym, GtkMenuButton__sym, GtkColorChooser__sym, GtkApplicationWindow__sym, GtkApplication__sym,
- GMenuModel__sym, guint___sym, GdkModifierIntent_sym, GtkFontChooser__sym, GdkScrollDirection_sym,
- GtkOverlay__sym, GtkWidgetPath__sym, GtkStateFlags_sym, GdkScreen___sym, GtkToolShell__sym,
- GtkWindowGroup__sym, GtkInvisible__sym, GtkOrientable__sym, GtkCellArea__sym, GtkBorder__sym,
- GtkSwitch__sym, GtkScrollablePolicy_sym, GtkScrollable__sym, GtkGrid__sym, GdkRGBA__sym,
- GtkComboBoxText__sym, GtkAlign_sym, GtkSizeRequestMode_sym, cairo_region_overlap_t_sym, cairo_rectangle_int_t__sym,
- double__sym, cairo_rectangle_t__sym, cairo_device_t__sym, cairo_bool_t_sym, cairo_text_cluster_flags_t__sym,
- cairo_text_cluster_t___sym, cairo_glyph_t___sym, cairo_text_cluster_flags_t_sym, cairo_text_cluster_t__sym, cairo_region_t__sym,
- GtkMessageDialog__sym, GdkDevice__sym, GtkAccessible__sym, GdkModifierType__sym, GtkToolPaletteDragTargets_sym,
- GtkToolItemGroup__sym, GtkToolPalette__sym, GtkSpinner__sym, GtkEntryBuffer__sym, GtkMessageType_sym,
- GtkInfoBar__sym, GIcon__sym, GtkEntryIconPosition_sym, GFile__sym, GtkScaleButton__sym,
- GtkCalendarDetailFunc_sym, GtkTooltip__sym, cairo_rectangle_list_t__sym, void__sym, cairo_filter_t_sym,
- cairo_extend_t_sym, cairo_format_t_sym, cairo_path_t__sym, cairo_destroy_func_t_sym, cairo_user_data_key_t__sym,
- cairo_text_extents_t__sym, cairo_font_extents_t__sym, cairo_font_face_t__sym, cairo_glyph_t__sym, cairo_scaled_font_t__sym,
- cairo_font_weight_t_sym, cairo_font_slant_t_sym, cairo_hint_metrics_t_sym, cairo_hint_style_t_sym, cairo_subpixel_order_t_sym,
- cairo_status_t_sym, bool_sym, cairo_matrix_t__sym, cairo_line_join_t_sym, cairo_line_cap_t_sym,
- cairo_fill_rule_t_sym, cairo_antialias_t_sym, cairo_operator_t_sym, cairo_pattern_t__sym, cairo_content_t_sym,
- GtkPageSet_sym, GtkPageRange__sym, GtkPrintPages_sym, GtkPrintQuality_sym, GtkPrintDuplex_sym,
- GtkPaperSize__sym, GtkPageOrientation_sym, GtkPrintSettingsFunc_sym, GtkPageSetupDoneFunc_sym, GtkPrintStatus_sym,
- GtkPrintOperationAction_sym, GtkPrintOperationResult_sym, GtkUnit_sym, GtkPrintSettings__sym, GtkPrintOperation__sym,
- GtkPageSetup__sym, GtkPrintContext__sym, cairo_surface_t__sym, GtkTreeViewGridLines_sym, GtkRecentData__sym,
- GtkTextBufferDeserializeFunc_sym, GtkTextBufferSerializeFunc_sym, time_t_sym, GtkRecentChooserMenu__sym, GtkRecentManager__sym,
- GtkRecentFilter__sym, GtkRecentSortFunc_sym, GtkRecentSortType_sym, GtkRecentChooser__sym, GtkLinkButton__sym,
- GtkAssistantPageType_sym, GtkAssistantPageFunc_sym, GtkAssistant__sym, GDestroyNotify_sym, GtkTreeViewSearchPositionFunc_sym,
- GtkSensitivityType_sym, GtkClipboardRichTextReceivedFunc_sym, GtkMenuBar__sym, GtkPackDirection_sym, GtkIconViewDropPosition_sym,
- GValue__sym, GLogFunc_sym, PangoMatrix__sym, PangoRenderPart_sym, PangoRenderer__sym,
- GtkClipboardImageReceivedFunc_sym, GtkMenuToolButton__sym, GtkFileChooserButton__sym, PangoScriptIter__sym, PangoScript_sym,
- PangoAttrFilterFunc_sym, PangoEllipsizeMode_sym, GtkIconViewForeachFunc_sym, GtkAboutDialog__sym, GtkTreeViewRowSeparatorFunc_sym,
- GtkCellView__sym, GtkAccelMap__sym, GtkClipboardTargetsReceivedFunc_sym, GtkOrientation_sym, GtkToolButton__sym,
- GtkIconLookupFlags_sym, GtkIconInfo__sym, GtkIconTheme__sym, GtkFileChooser__sym, GtkCellLayoutDataFunc_sym,
- GtkCellLayout__sym, GtkFileFilterFunc_sym, GtkFileFilterFlags_sym, GtkFileFilter__sym, GSourceFunc_sym,
- GtkToggleToolButton__sym, GtkSeparatorToolItem__sym, GtkRadioToolButton__sym, GtkEntryCompletionMatchFunc_sym, GtkFontButton__sym,
- GtkExpander__sym, GtkComboBox__sym, GtkTreeModelFilter__sym, GtkFileChooserAction_sym, GtkToolItem__sym,
- GtkEventBox__sym, GtkCalendarDisplayOptions_sym, GdkScreen__sym, PangoLayoutRun__sym, PangoLayoutIter__sym,
- PangoLayoutLine__sym, int__sym, PangoAlignment_sym, PangoWrapMode_sym, PangoItem__sym,
- PangoGlyphString__sym, PangoFontMap__sym, PangoGlyph_sym, PangoFontFace__sym, PangoFontFace___sym,
- PangoFontFamily__sym, PangoFontMask_sym, PangoFontDescription___sym, PangoCoverageLevel_sym, PangoCoverage__sym,
- PangoFontMetrics__sym, PangoFontset__sym, PangoFont__sym, PangoFontFamily___sym, PangoLogAttr__sym,
- PangoAnalysis__sym, PangoAttrList___sym, PangoAttrIterator__sym, PangoRectangle__sym, PangoUnderline_sym,
- PangoStretch_sym, PangoVariant_sym, PangoWeight_sym, PangoStyle_sym, guint16_sym,
- PangoAttribute__sym, PangoAttrType_sym, PangoColor__sym, GdkGravity_sym, GtkWindowPosition_sym,
- GtkWindowType_sym, GtkWindow__sym, GtkTextDirection_sym, AtkObject__sym, GtkDirectionType_sym,
- GtkAllocation__sym, GtkViewport__sym, GtkTreeViewSearchEqualFunc_sym, GtkTreeViewDropPosition_sym, GtkTreeViewMappingFunc_sym,
- GtkTreeViewColumnDropFunc_sym, GtkTreeViewColumnSizing_sym, GtkTreeCellDataFunc_sym, GtkTreeStore__sym, GtkTreeIterCompareFunc_sym,
- GtkSortType_sym, GtkTreeSortable__sym, GtkTreeSelectionForeachFunc_sym, GtkTreeModel___sym, GtkTreeSelectionFunc_sym,
- GtkSelectionMode_sym, GtkTreeModelSort__sym, GtkTreeModelForeachFunc_sym, GtkTreeModelFlags_sym, GtkTreeRowReference__sym,
- GtkTreeDragDest__sym, GtkTreeDragSource__sym, GtkToolbarStyle_sym, GtkToolbar__sym, GtkToggleButton__sym,
- PangoTabArray__sym, GtkWrapMode_sym, GtkTextWindowType_sym, GtkTextView__sym, GtkTextTagTableForeach_sym,
- GtkTextAttributes__sym, GtkTextSearchFlags_sym, GtkTextCharPredicate_sym, GtkTextMark__sym, GtkTextChildAnchor__sym,
- GtkTextIter__sym, GtkTextTagTable__sym, GtkTextBuffer__sym, GtkStatusbar__sym, GtkSpinType_sym,
- GtkSpinButtonUpdatePolicy_sym, GtkSpinButton__sym, GtkSizeGroupMode_sym, GtkSizeGroup__sym, GtkSettings__sym,
- GtkCornerType_sym, GtkPolicyType_sym, GtkScrolledWindow__sym, GtkScale__sym, GtkRange__sym,
- GtkRadioMenuItem__sym, GtkRadioButton__sym, GtkProgressBar__sym, GtkPaned__sym, GtkPositionType_sym,
- GtkNotebook__sym, GtkMenuShell__sym, gint__sym, GtkMenuItem__sym, GtkMenu__sym,
- PangoLanguage__sym, GtkListStore__sym, GtkLayout__sym, GtkJustification_sym, GtkLabel__sym,
- guint16__sym, GtkIMContextSimple__sym, GdkEventKey__sym, PangoAttrList__sym, GtkIMContext__sym,
- GtkImageType_sym, GtkImage__sym, GtkShadowType_sym, GtkFrame__sym, GtkFixed__sym,
- PangoLayout__sym, GtkEntry__sym, GtkEditable__sym, GtkTargetList__sym, GtkDestDefaults_sym,
- etc_sym, GtkDialog__sym, GtkCallback_sym, GtkContainer__sym, GtkClipboardTextReceivedFunc_sym,
- GtkClipboardReceivedFunc_sym, GtkClipboardClearFunc_sym, GtkClipboardGetFunc_sym, GtkTargetEntry__sym, GtkCheckMenuItem__sym,
- GtkCellRendererToggle__sym, GtkCellRendererText__sym, GtkCellRendererState_sym, GtkCellEditable__sym, GtkCalendar__sym,
- GtkReliefStyle_sym, GtkButton__sym, GtkPackType_sym, GtkBox__sym, GtkBin__sym,
- GtkBindingSet__sym, GtkButtonBox__sym, GtkButtonBoxStyle_sym, GtkAspectFrame__sym, GtkAdjustment__sym,
- GtkAccelMapForeach_sym, GtkAccelLabel__sym, GtkAccelGroupEntry__sym, lambda3_sym, GSList__sym,
- GObject__sym, GtkAccelFlags_sym, GtkAccelGroup__sym, GTimeVal__sym, GdkPixbufAnimationIter__sym,
- GdkPixbufAnimation__sym, GdkInterpType_sym, double_sym, gfloat_sym, guchar_sym,
- char___sym, GdkPixbufDestroyNotify_sym, GError__sym, int_sym, GdkColorspace_sym,
- GdkWindowTypeHint_sym, GdkWindowHints_sym, GdkGeometry__sym, GdkWindowEdge_sym, GdkWMFunction_sym,
- GdkWMDecoration_sym, GdkEventMask_sym, GdkWindowState_sym, GdkFilterFunc_sym, GdkWindowType_sym,
- GdkPropMode_sym, guchar__sym, PangoContext__sym, PangoDirection_sym, GdkKeymapKey__sym,
- GdkKeymap__sym, GdkRectangle__sym, char__sym, gchar___sym, GdkEventFunc_sym,
- gdouble_sym, GList__sym, guint32_sym, GdkDragAction_sym, GdkDragContext__sym,
- GdkCursorType_sym, GdkDisplay__sym, GdkCursor__sym, GSignalMatchType_sym, GConnectFlags_sym,
- GtkDestroyNotify_sym, GSignalEmissionHook_sym, gulong_sym, GSignalInvocationHint__sym, GQuark_sym,
- guint__sym, GSignalQuery__sym, GType__sym, GSignalCMarshaller_sym, gpointer_sym,
- GSignalAccumulator_sym, GSignalFlags_sym, GType_sym, GClosureNotify_sym, GCallback_sym,
- GNormalizeMode_sym, glong_sym, gssize_sym, gunichar__sym, void_sym,
- GtkDrawingArea__sym, GdkSeat__sym, GtkRecentInfo__sym, gsize_sym, guint8__sym,
- GdkAtom_sym, GLogLevelFlags_sym, GdkPixbuf__sym, GtkIconView__sym, GtkEntryCompletion__sym,
- GtkFileFilterInfo__sym, GtkTreeSelection__sym, GtkCellRenderer__sym, GtkTreeViewColumn__sym, GtkTreeView__sym,
- gunichar_sym, gint_sym, GdkAtom__sym, GtkSelectionData__sym, GtkClipboard__sym,
- GtkTreeIter__sym, GtkTreePath__sym, GtkTreeModel__sym, gboolean_sym, GdkModifierType_sym,
- guint_sym, gchar__sym, GtkTextTag__sym, GdkXEvent__sym, GtkWidget__sym,
- lambda_data_sym, GClosure__sym, GtkAccelKey__sym, GdkEventMotion__sym, gdouble__sym,
- GdkEventAny__sym, GdkEvent__sym, GdkWindow__sym, cairo_t__sym, cairo_font_options_t__sym,
- PangoFontDescription__sym, idler_sym, GtkCellRendererPixbuf__sym, GtkScrollbar__sym, GtkSeparator__sym,
+static s7_pointer GdkEventScroll__sym, GtkScrollbar__sym, GtkCenterBox__sym, GtkCheckButton__sym, GdkDrawContext__sym,
+ GtkDrawingAreaDrawFunc_sym, GtkShortcutLabel__sym, GtkPadActionType_sym, GtkPadActionEntry__sym, GActionGroup__sym,
+ GtkPadController__sym, GdkDevicePadFeature_sym, GdkDevicePad__sym, GdkDrawingContext__sym, GdkSubpixelLayout_sym,
+ GdkMonitor__sym, GdkDeviceTool__sym, GdkAxisFlags_sym, GdkSeatGrabPrepareFunc_sym, GdkSeatCapabilities_sym,
+ GdkGrabStatus_sym, GtkPopoverConstraint_sym, GtkShortcutsWindow__sym, GtkStackSidebar__sym, GtkSearchEntry__sym,
+ GtkPopoverMenu__sym, GtkStyleContext__sym, GdkGLContext__sym, GtkGLArea__sym, GtkPropagationPhase_sym,
+ GtkEventController__sym, GtkGestureZoom__sym, GtkGestureSwipe__sym, GtkGestureSingle__sym, GtkGestureRotate__sym,
+ GtkGestureMultiPress__sym, GtkGesturePan__sym, GtkGestureDrag__sym, GdkEventSequence__sym, GtkEventSequenceState_sym,
+ GtkGesture__sym, GtkAllocation__sym, GtkPopover__sym, GtkActionBar__sym, GtkFlowBox__sym,
+ GtkFlowBoxChild__sym, GdkEventType_sym, GtkSearchBar__sym, GtkListBox__sym, GtkListBoxRow__sym,
+ GtkHeaderBar__sym, GtkRevealerTransitionType_sym, GtkRevealer__sym, GtkStackTransitionType_sym, GtkStack__sym,
+ GtkStackSwitcher__sym, GtkPlacesSidebar__sym, GtkPlacesOpenFlags_sym, GtkBaselinePosition_sym, GdkFullscreenMode_sym,
+ GtkInputHints_sym, GtkInputPurpose_sym, GtkLevelBarMode_sym, GtkLevelBar__sym, GtkMenuButton__sym,
+ GtkColorChooser__sym, GtkApplicationWindow__sym, GtkApplication__sym, GMenuModel__sym, guint___sym,
+ GdkModifierIntent_sym, GtkFontChooser__sym, GdkScrollDirection_sym, GtkOverlay__sym, GtkWidgetPath__sym,
+ GtkStateFlags_sym, GdkScreen___sym, GtkToolShell__sym, GtkWindowGroup__sym, GtkInvisible__sym,
+ GtkOrientable__sym, GtkCellArea__sym, GtkBorder__sym, GtkSwitch__sym, GtkScrollablePolicy_sym,
+ GtkScrollable__sym, GtkGrid__sym, GdkRGBA__sym, GtkComboBoxText__sym, GtkAlign_sym,
+ GtkSizeRequestMode_sym, cairo_region_overlap_t_sym, cairo_rectangle_int_t__sym, double__sym, cairo_rectangle_t__sym,
+ cairo_device_t__sym, cairo_bool_t_sym, cairo_text_cluster_flags_t__sym, cairo_text_cluster_t___sym, cairo_glyph_t___sym,
+ cairo_text_cluster_flags_t_sym, cairo_text_cluster_t__sym, cairo_region_t__sym, GtkMessageDialog__sym, GdkDevice__sym,
+ GtkAccessible__sym, GdkModifierType__sym, GtkToolPaletteDragTargets_sym, GtkToolItemGroup__sym, GtkToolPalette__sym,
+ GtkSpinner__sym, GtkEntryBuffer__sym, GtkMessageType_sym, GtkInfoBar__sym, GIcon__sym,
+ GtkEntryIconPosition_sym, GFile__sym, GtkScaleButton__sym, GtkCalendarDetailFunc_sym, GtkTooltip__sym,
+ cairo_rectangle_list_t__sym, void__sym, cairo_filter_t_sym, cairo_extend_t_sym, cairo_format_t_sym,
+ cairo_path_t__sym, cairo_destroy_func_t_sym, cairo_user_data_key_t__sym, cairo_text_extents_t__sym, cairo_font_extents_t__sym,
+ cairo_font_face_t__sym, cairo_glyph_t__sym, cairo_scaled_font_t__sym, cairo_font_weight_t_sym, cairo_font_slant_t_sym,
+ cairo_hint_metrics_t_sym, cairo_hint_style_t_sym, cairo_subpixel_order_t_sym, cairo_status_t_sym, bool_sym,
+ cairo_matrix_t__sym, cairo_line_join_t_sym, cairo_line_cap_t_sym, cairo_fill_rule_t_sym, cairo_antialias_t_sym,
+ cairo_operator_t_sym, cairo_pattern_t__sym, cairo_content_t_sym, GtkPageSet_sym, GtkPageRange__sym,
+ GtkPrintPages_sym, GtkPrintQuality_sym, GtkPrintDuplex_sym, GtkPaperSize__sym, GtkPageOrientation_sym,
+ GtkPrintSettingsFunc_sym, GtkPageSetupDoneFunc_sym, GtkPrintStatus_sym, GtkPrintOperationAction_sym, GtkPrintOperationResult_sym,
+ GtkUnit_sym, GtkPrintSettings__sym, GtkPrintOperation__sym, GtkPageSetup__sym, GtkPrintContext__sym,
+ cairo_surface_t__sym, GtkTreeViewGridLines_sym, GtkRecentData__sym, GtkTextBufferDeserializeFunc_sym, GtkTextBufferSerializeFunc_sym,
+ time_t_sym, GtkRecentChooserMenu__sym, GtkRecentManager__sym, GtkRecentFilter__sym, GtkRecentSortFunc_sym,
+ GtkRecentSortType_sym, GtkRecentChooser__sym, GtkLinkButton__sym, GtkAssistantPageType_sym, GtkAssistantPageFunc_sym,
+ GtkAssistant__sym, GDestroyNotify_sym, GtkTreeViewSearchPositionFunc_sym, GtkSensitivityType_sym, GtkClipboardRichTextReceivedFunc_sym,
+ GtkMenuBar__sym, GtkPackDirection_sym, GtkIconViewDropPosition_sym, GValue__sym, GLogFunc_sym,
+ PangoMatrix__sym, PangoRenderPart_sym, PangoRenderer__sym, GtkClipboardImageReceivedFunc_sym, GtkMenuToolButton__sym,
+ GtkFileChooserButton__sym, PangoScriptIter__sym, PangoScript_sym, PangoAttrFilterFunc_sym, PangoEllipsizeMode_sym,
+ GtkIconViewForeachFunc_sym, GtkAboutDialog__sym, GtkTreeViewRowSeparatorFunc_sym, GtkCellView__sym, GtkAccelMap__sym,
+ GtkClipboardTargetsReceivedFunc_sym, GtkOrientation_sym, GtkToolButton__sym, GtkIconLookupFlags_sym, GtkIconInfo__sym,
+ GtkIconTheme__sym, GtkFileChooser__sym, GtkCellLayoutDataFunc_sym, GtkCellLayout__sym, GtkFileFilterFunc_sym,
+ GtkFileFilterFlags_sym, GtkFileFilter__sym, GSourceFunc_sym, GtkToggleToolButton__sym, GtkSeparatorToolItem__sym,
+ GtkRadioToolButton__sym, GtkEntryCompletionMatchFunc_sym, GtkFontButton__sym, GtkExpander__sym, GtkComboBox__sym,
+ GtkTreeModelFilter__sym, GtkFileChooserAction_sym, GtkToolItem__sym, GtkCalendarDisplayOptions_sym, GdkScreen__sym,
+ PangoLayoutRun__sym, PangoLayoutIter__sym, PangoLayoutLine__sym, int__sym, PangoAlignment_sym,
+ PangoWrapMode_sym, PangoItem__sym, PangoGlyphString__sym, PangoFontMap__sym, PangoGlyph_sym,
+ PangoFontFace__sym, PangoFontFace___sym, PangoFontFamily__sym, PangoFontMask_sym, PangoFontDescription___sym,
+ PangoCoverageLevel_sym, PangoCoverage__sym, PangoFontMetrics__sym, PangoFontset__sym, PangoFont__sym,
+ PangoFontFamily___sym, PangoLogAttr__sym, PangoAnalysis__sym, PangoAttrList___sym, PangoAttrIterator__sym,
+ PangoRectangle__sym, PangoUnderline_sym, PangoStretch_sym, PangoVariant_sym, PangoWeight_sym,
+ PangoStyle_sym, guint16_sym, PangoAttribute__sym, PangoAttrType_sym, PangoColor__sym,
+ GdkGravity_sym, GtkWindowPosition_sym, GtkWindowType_sym, GtkWindow__sym, GtkTextDirection_sym,
+ AtkObject__sym, GtkDirectionType_sym, GtkViewport__sym, GtkTreeViewSearchEqualFunc_sym, GtkTreeViewDropPosition_sym,
+ GtkTreeViewMappingFunc_sym, GtkTreeViewColumnDropFunc_sym, GtkTreeViewColumnSizing_sym, GtkTreeCellDataFunc_sym, GtkTreeStore__sym,
+ GtkTreeIterCompareFunc_sym, GtkSortType_sym, GtkTreeSortable__sym, GtkTreeSelectionForeachFunc_sym, GtkTreeModel___sym,
+ GtkTreeSelectionFunc_sym, GtkSelectionMode_sym, GtkTreeModelSort__sym, GtkTreeModelForeachFunc_sym, GtkTreeModelFlags_sym,
+ GtkTreeRowReference__sym, GtkTreeDragDest__sym, GtkTreeDragSource__sym, GtkToolbarStyle_sym, GtkToolbar__sym,
+ GtkToggleButton__sym, PangoTabArray__sym, GtkWrapMode_sym, GtkTextWindowType_sym, GtkTextView__sym,
+ GtkTextTagTableForeach_sym, GtkTextAttributes__sym, GtkTextSearchFlags_sym, GtkTextCharPredicate_sym, GtkTextMark__sym,
+ GtkTextChildAnchor__sym, GtkTextIter__sym, GtkTextTagTable__sym, GtkTextBuffer__sym, GtkStatusbar__sym,
+ GtkSpinType_sym, GtkSpinButtonUpdatePolicy_sym, GtkSpinButton__sym, GtkSizeGroupMode_sym, GtkSizeGroup__sym,
+ GtkSettings__sym, GtkCornerType_sym, GtkPolicyType_sym, GtkScrolledWindow__sym, GtkScale__sym,
+ GtkRange__sym, GtkRadioMenuItem__sym, GtkRadioButton__sym, GtkProgressBar__sym, GtkPaned__sym,
+ GtkPositionType_sym, GtkNotebook__sym, GtkMenuShell__sym, gint__sym, GtkMenuItem__sym,
+ GtkMenu__sym, PangoLanguage__sym, GtkListStore__sym, GtkLayout__sym, GtkJustification_sym,
+ GtkLabel__sym, guint16__sym, GtkIMContextSimple__sym, GdkEventKey__sym, PangoAttrList__sym,
+ GtkIMContext__sym, GtkImageType_sym, GtkImage__sym, GtkShadowType_sym, GtkFrame__sym,
+ GtkFixed__sym, PangoLayout__sym, GtkEntry__sym, GtkEditable__sym, GtkTargetList__sym,
+ GtkDestDefaults_sym, etc_sym, GtkDialog__sym, GtkCallback_sym, GtkContainer__sym,
+ GtkClipboardTextReceivedFunc_sym, GtkClipboardReceivedFunc_sym, GtkClipboardClearFunc_sym, GtkClipboardGetFunc_sym, GtkTargetEntry__sym,
+ GtkCheckMenuItem__sym, GtkCellRendererToggle__sym, GtkCellRendererText__sym, GtkCellRendererState_sym, GtkCellEditable__sym,
+ GtkCalendar__sym, GtkReliefStyle_sym, GtkButton__sym, GtkPackType_sym, GtkBox__sym,
+ GtkBin__sym, GtkBindingSet__sym, GtkButtonBox__sym, GtkButtonBoxStyle_sym, GtkAspectFrame__sym,
+ GtkAdjustment__sym, GtkAccelMapForeach_sym, GtkAccelLabel__sym, GtkAccelGroupEntry__sym, lambda3_sym,
+ GSList__sym, GObject__sym, GtkAccelFlags_sym, GtkAccelGroup__sym, GTimeVal__sym,
+ GdkPixbufAnimationIter__sym, GdkPixbufAnimation__sym, GdkInterpType_sym, double_sym, gfloat_sym,
+ guchar_sym, char___sym, GdkPixbufDestroyNotify_sym, GError__sym, int_sym,
+ GdkColorspace_sym, GdkWindowTypeHint_sym, GdkWindowHints_sym, GdkGeometry__sym, GdkWindowEdge_sym,
+ GdkWMFunction_sym, GdkWMDecoration_sym, GdkEventMask_sym, GdkWindowState_sym, GdkFilterFunc_sym,
+ GdkWindowType_sym, GdkPropMode_sym, guchar__sym, PangoContext__sym, PangoDirection_sym,
+ GdkKeymapKey__sym, GdkKeymap__sym, GdkRectangle__sym, char__sym, gchar___sym,
+ GdkEventFunc_sym, gdouble_sym, GList__sym, guint32_sym, GdkDragAction_sym,
+ GdkDragContext__sym, GdkCursorType_sym, GdkDisplay__sym, GdkCursor__sym, GSignalMatchType_sym,
+ GConnectFlags_sym, GtkDestroyNotify_sym, GSignalEmissionHook_sym, gulong_sym, GSignalInvocationHint__sym,
+ GQuark_sym, guint__sym, GSignalQuery__sym, GType__sym, GSignalCMarshaller_sym,
+ gpointer_sym, GSignalAccumulator_sym, GSignalFlags_sym, GType_sym, GClosureNotify_sym,
+ GCallback_sym, GNormalizeMode_sym, glong_sym, gssize_sym, gunichar__sym,
+ void_sym, GtkDrawingArea__sym, GdkSeat__sym, GtkRecentInfo__sym, gsize_sym,
+ guint8__sym, GdkAtom_sym, GLogLevelFlags_sym, GdkPixbuf__sym, GtkIconView__sym,
+ GtkEntryCompletion__sym, GtkFileFilterInfo__sym, GtkTreeSelection__sym, GtkCellRenderer__sym, GtkTreeViewColumn__sym,
+ GtkTreeView__sym, gunichar_sym, gint_sym, GdkAtom__sym, GtkSelectionData__sym,
+ GtkClipboard__sym, GtkTreeIter__sym, GtkTreePath__sym, GtkTreeModel__sym, gboolean_sym,
+ GdkModifierType_sym, guint_sym, gchar__sym, GtkTextTag__sym, GdkXEvent__sym,
+ GtkWidget__sym, lambda_data_sym, GClosure__sym, GtkAccelKey__sym, GdkEventMotion__sym,
+ gdouble__sym, GdkEventAny__sym, GdkEvent__sym, GdkWindow__sym, cairo_t__sym,
+ cairo_font_options_t__sym, PangoFontDescription__sym, idler_sym, GtkCellRendererPixbuf__sym, GtkSeparator__sym,
GtkSeparatorMenuItem__sym, GdkEventExpose__sym, GdkEventNoExpose__sym, GdkEventVisibility__sym, GdkEventButton__sym,
- GdkEventScroll__sym, GdkEventCrossing__sym, GdkEventFocus__sym, GdkEventConfigure__sym, GdkEventProperty__sym,
- GdkEventSelection__sym, GdkEventProximity__sym, GdkEventSetting__sym, GdkEventWindowState__sym, GdkEventDND__sym,
- GtkFileChooserDialog__sym, GtkFileChooserWidget__sym, GtkColorButton__sym, GtkAccelMap_sym, GtkCellRendererCombo__sym,
- GtkCellRendererProgress__sym, GtkCellRendererAccel__sym, GtkCellRendererSpin__sym, GtkRecentChooserDialog__sym, GtkRecentChooserWidget__sym,
- GtkCellRendererSpinner__sym, gboolean__sym, GtkFontChooserDialog__sym, GtkFontChooserWidget__sym, GtkColorChooserDialog__sym,
- GtkColorChooserWidget__sym, GtkColorWidget__sym, GtkGestureLongPress__sym;
+ GdkEventCrossing__sym, GdkEventFocus__sym, GdkEventConfigure__sym, GdkEventProperty__sym, GdkEventSelection__sym,
+ GdkEventProximity__sym, GdkEventSetting__sym, GdkEventWindowState__sym, GdkEventDND__sym, GtkFileChooserDialog__sym,
+ GtkFileChooserWidget__sym, GtkColorButton__sym, GtkAccelMap_sym, GtkCellRendererCombo__sym, GtkCellRendererProgress__sym,
+ GtkCellRendererAccel__sym, GtkCellRendererSpin__sym, GtkRecentChooserDialog__sym, GtkRecentChooserWidget__sym, GtkCellRendererSpinner__sym,
+ gboolean__sym, GtkFontChooserDialog__sym, GtkFontChooserWidget__sym, GtkColorChooserDialog__sym, GtkColorChooserWidget__sym,
+ GtkColorWidget__sym, GtkGestureLongPress__sym;
#define lg_is_list(Arg) s7_is_list(sc, Arg)
static s7_scheme *cbsc = NULL;
@@ -564,6 +566,18 @@ static gboolean lg_func4(GtkPrintOperation *op, GtkPrintContext *context, gint p
s7_cadr((s7_pointer)data))) != lg_false);
}
+#if (!GTK_CHECK_VERSION(3, 90, 0))
+static s7_pointer lg_gtk_widget_set_events(s7_scheme *sc, s7_pointer args)
+{
+ #define H_gtk_widget_set_events "void gtk_widget_set_events(GtkWidget* widget, gint events)"
+ s7_pointer widget, events;
+ widget = s7_car(args);
+ events = s7_cadr(args);
+ gtk_widget_set_events((GtkWidget*)s7_c_pointer(widget), (gint)s7_integer(events));
+ return(lg_false);
+}
+#endif
+
static s7_pointer lg_g_unichar_validate(s7_scheme *sc, s7_pointer args)
{
#define H_g_unichar_validate "gboolean g_unichar_validate(gunichar ch)"
@@ -5726,12 +5740,6 @@ gint* [y])"
return(s7_list(sc, 2, s7_make_integer(sc, ref_x), s7_make_integer(sc, ref_y)));
}
-static s7_pointer lg_gtk_event_box_new(s7_scheme *sc, s7_pointer args)
-{
- #define H_gtk_event_box_new "GtkWidget* gtk_event_box_new( void)"
- return(s7_make_type_with_c_pointer(sc, GtkWidget__sym, gtk_event_box_new()));
-}
-
static s7_pointer lg_gtk_fixed_new(s7_scheme *sc, s7_pointer args)
{
#define H_gtk_fixed_new "GtkWidget* gtk_fixed_new( void)"
@@ -15034,20 +15042,6 @@ static s7_pointer lg_gtk_widget_queue_resize(s7_scheme *sc, s7_pointer args)
return(lg_false);
}
-static s7_pointer lg_gtk_widget_size_allocate(s7_scheme *sc, s7_pointer args)
-{
- #define H_gtk_widget_size_allocate "void gtk_widget_size_allocate(GtkWidget* widget, GtkAllocation* allocation)"
- s7_pointer _p;
- s7_pointer widget, allocation;
- _p = args;
- widget = s7_car(_p); _p = s7_cdr(_p);
- if (!s7_is_c_pointer_of_type(widget, GtkWidget__sym)) s7_wrong_type_arg_error(sc, "gtk_widget_size_allocate", 1, widget, "GtkWidget*");
- allocation = s7_car(_p); _p = s7_cdr(_p);
- if (!s7_is_c_pointer_of_type(allocation, GtkAllocation__sym)) s7_wrong_type_arg_error(sc, "gtk_widget_size_allocate", 2, allocation, "GtkAllocation*");
- gtk_widget_size_allocate(s7_c_pointer(widget), s7_c_pointer(allocation));
- return(lg_false);
-}
-
static s7_pointer lg_gtk_widget_add_accelerator(s7_scheme *sc, s7_pointer args)
{
#define H_gtk_widget_add_accelerator "void gtk_widget_add_accelerator(GtkWidget* widget, gchar* accel_signal, \
@@ -19300,54 +19294,6 @@ static s7_pointer lg_gtk_entry_get_completion(s7_scheme *sc, s7_pointer args)
return(s7_make_type_with_c_pointer(sc, GtkEntryCompletion__sym, gtk_entry_get_completion(s7_c_pointer(entry))));
}
-static s7_pointer lg_gtk_event_box_get_visible_window(s7_scheme *sc, s7_pointer args)
-{
- #define H_gtk_event_box_get_visible_window "gboolean gtk_event_box_get_visible_window(GtkEventBox* event_box)"
- s7_pointer event_box;
- event_box = s7_car(args);
- if (!s7_is_c_pointer_of_type(event_box, GtkEventBox__sym)) s7_wrong_type_arg_error(sc, "gtk_event_box_get_visible_window", 1, event_box, "GtkEventBox*");
- return(s7_make_boolean(sc, gtk_event_box_get_visible_window(s7_c_pointer(event_box))));
-}
-
-static s7_pointer lg_gtk_event_box_set_visible_window(s7_scheme *sc, s7_pointer args)
-{
- #define H_gtk_event_box_set_visible_window "void gtk_event_box_set_visible_window(GtkEventBox* event_box, \
-gboolean visible_window)"
- s7_pointer _p;
- s7_pointer event_box, visible_window;
- _p = args;
- event_box = s7_car(_p); _p = s7_cdr(_p);
- if (!s7_is_c_pointer_of_type(event_box, GtkEventBox__sym)) s7_wrong_type_arg_error(sc, "gtk_event_box_set_visible_window", 1, event_box, "GtkEventBox*");
- visible_window = s7_car(_p); _p = s7_cdr(_p);
- if (!s7_is_boolean(visible_window)) s7_wrong_type_arg_error(sc, "gtk_event_box_set_visible_window", 2, visible_window, "gboolean");
- gtk_event_box_set_visible_window(s7_c_pointer(event_box), lg_boolean(visible_window));
- return(lg_false);
-}
-
-static s7_pointer lg_gtk_event_box_get_above_child(s7_scheme *sc, s7_pointer args)
-{
- #define H_gtk_event_box_get_above_child "gboolean gtk_event_box_get_above_child(GtkEventBox* event_box)"
- s7_pointer event_box;
- event_box = s7_car(args);
- if (!s7_is_c_pointer_of_type(event_box, GtkEventBox__sym)) s7_wrong_type_arg_error(sc, "gtk_event_box_get_above_child", 1, event_box, "GtkEventBox*");
- return(s7_make_boolean(sc, gtk_event_box_get_above_child(s7_c_pointer(event_box))));
-}
-
-static s7_pointer lg_gtk_event_box_set_above_child(s7_scheme *sc, s7_pointer args)
-{
- #define H_gtk_event_box_set_above_child "void gtk_event_box_set_above_child(GtkEventBox* event_box, \
-gboolean above_child)"
- s7_pointer _p;
- s7_pointer event_box, above_child;
- _p = args;
- event_box = s7_car(_p); _p = s7_cdr(_p);
- if (!s7_is_c_pointer_of_type(event_box, GtkEventBox__sym)) s7_wrong_type_arg_error(sc, "gtk_event_box_set_above_child", 1, event_box, "GtkEventBox*");
- above_child = s7_car(_p); _p = s7_cdr(_p);
- if (!s7_is_boolean(above_child)) s7_wrong_type_arg_error(sc, "gtk_event_box_set_above_child", 2, above_child, "gboolean");
- gtk_event_box_set_above_child(s7_c_pointer(event_box), lg_boolean(above_child));
- return(lg_false);
-}
-
static s7_pointer lg_gtk_menu_attach(s7_scheme *sc, s7_pointer args)
{
#define H_gtk_menu_attach "void gtk_menu_attach(GtkMenu* menu, GtkWidget* child, guint left_attach, \
@@ -29444,25 +29390,6 @@ static s7_pointer lg_gtk_tree_view_is_rubber_banding_active(s7_scheme *sc, s7_po
return(s7_make_boolean(sc, gtk_tree_view_is_rubber_banding_active(s7_c_pointer(tree_view))));
}
-static s7_pointer lg_gtk_icon_view_convert_widget_to_bin_window_coords(s7_scheme *sc, s7_pointer args)
-{
- #define H_gtk_icon_view_convert_widget_to_bin_window_coords "void gtk_icon_view_convert_widget_to_bin_window_coords(GtkIconView* icon_view, \
-gint wx, gint wy, gint* [bx], gint* [by])"
- s7_pointer _p;
- s7_pointer icon_view, wx, wy;
- gint ref_bx;
- gint ref_by;
- _p = args;
- icon_view = s7_car(_p); _p = s7_cdr(_p);
- if (!s7_is_c_pointer_of_type(icon_view, GtkIconView__sym)) s7_wrong_type_arg_error(sc, "gtk_icon_view_convert_widget_to_bin_window_coords", 1, icon_view, "GtkIconView*");
- wx = s7_car(_p); _p = s7_cdr(_p);
- if (!s7_is_integer(wx)) s7_wrong_type_arg_error(sc, "gtk_icon_view_convert_widget_to_bin_window_coords", 2, wx, "gint");
- wy = s7_car(_p); _p = s7_cdr(_p);
- if (!s7_is_integer(wy)) s7_wrong_type_arg_error(sc, "gtk_icon_view_convert_widget_to_bin_window_coords", 3, wy, "gint");
- gtk_icon_view_convert_widget_to_bin_window_coords(s7_c_pointer(icon_view), s7_integer(wx), s7_integer(wy), &ref_bx, &ref_by);
- return(s7_list(sc, 2, s7_make_integer(sc, ref_bx), s7_make_integer(sc, ref_by)));
-}
-
static s7_pointer lg_gtk_icon_view_set_tooltip_item(s7_scheme *sc, s7_pointer args)
{
#define H_gtk_icon_view_set_tooltip_item "void gtk_icon_view_set_tooltip_item(GtkIconView* icon_view, \
@@ -29850,15 +29777,6 @@ static s7_pointer lg_gtk_entry_get_text_length(s7_scheme *sc, s7_pointer args)
return(s7_make_integer(sc, gtk_entry_get_text_length(s7_c_pointer(entry))));
}
-static s7_pointer lg_gtk_layout_get_bin_window(s7_scheme *sc, s7_pointer args)
-{
- #define H_gtk_layout_get_bin_window "GdkWindow* gtk_layout_get_bin_window(GtkLayout* layout)"
- s7_pointer layout;
- layout = s7_car(args);
- if (!s7_is_c_pointer_of_type(layout, GtkLayout__sym)) s7_wrong_type_arg_error(sc, "gtk_layout_get_bin_window", 1, layout, "GtkLayout*");
- return(s7_make_type_with_c_pointer(sc, GdkWindow__sym, gtk_layout_get_bin_window(s7_c_pointer(layout))));
-}
-
static s7_pointer lg_gtk_menu_get_accel_path(s7_scheme *sc, s7_pointer args)
{
#define H_gtk_menu_get_accel_path "gchar* gtk_menu_get_accel_path(GtkMenu* menu)"
@@ -32234,15 +32152,6 @@ gint* [slider_end])"
return(s7_list(sc, 2, s7_make_integer(sc, ref_slider_start), s7_make_integer(sc, ref_slider_end)));
}
-static s7_pointer lg_gtk_paned_get_handle_window(s7_scheme *sc, s7_pointer args)
-{
- #define H_gtk_paned_get_handle_window "GdkWindow* gtk_paned_get_handle_window(GtkPaned* paned)"
- s7_pointer paned;
- paned = s7_car(args);
- if (!s7_is_c_pointer_of_type(paned, GtkPaned__sym)) s7_wrong_type_arg_error(sc, "gtk_paned_get_handle_window", 1, paned, "GtkPaned*");
- return(s7_make_type_with_c_pointer(sc, GdkWindow__sym, gtk_paned_get_handle_window(s7_c_pointer(paned))));
-}
-
static s7_pointer lg_gtk_widget_set_realized(s7_scheme *sc, s7_pointer args)
{
#define H_gtk_widget_set_realized "void gtk_widget_set_realized(GtkWidget* widget, gboolean realized)"
@@ -37237,23 +37146,6 @@ static s7_pointer lg_gtk_grid_get_baseline_row(s7_scheme *sc, s7_pointer args)
return(s7_make_integer(sc, gtk_grid_get_baseline_row(s7_c_pointer(grid))));
}
-static s7_pointer lg_gtk_widget_size_allocate_with_baseline(s7_scheme *sc, s7_pointer args)
-{
- #define H_gtk_widget_size_allocate_with_baseline "void gtk_widget_size_allocate_with_baseline(GtkWidget* widget, \
-GtkAllocation* allocation, gint baseline)"
- s7_pointer _p;
- s7_pointer widget, allocation, baseline;
- _p = args;
- widget = s7_car(_p); _p = s7_cdr(_p);
- if (!s7_is_c_pointer_of_type(widget, GtkWidget__sym)) s7_wrong_type_arg_error(sc, "gtk_widget_size_allocate_with_baseline", 1, widget, "GtkWidget*");
- allocation = s7_car(_p); _p = s7_cdr(_p);
- if (!s7_is_c_pointer_of_type(allocation, GtkAllocation__sym)) s7_wrong_type_arg_error(sc, "gtk_widget_size_allocate_with_baseline", 2, allocation, "GtkAllocation*");
- baseline = s7_car(_p); _p = s7_cdr(_p);
- if (!s7_is_integer(baseline)) s7_wrong_type_arg_error(sc, "gtk_widget_size_allocate_with_baseline", 3, baseline, "gint");
- gtk_widget_size_allocate_with_baseline(s7_c_pointer(widget), s7_c_pointer(allocation), s7_integer(baseline));
- return(lg_false);
-}
-
static s7_pointer lg_gtk_widget_get_allocated_baseline(s7_scheme *sc, s7_pointer args)
{
#define H_gtk_widget_get_allocated_baseline "int gtk_widget_get_allocated_baseline(GtkWidget* widget)"
@@ -39459,20 +39351,6 @@ static s7_pointer lg_gdk_window_show_window_menu(s7_scheme *sc, s7_pointer args)
return(s7_make_boolean(sc, gdk_window_show_window_menu(s7_c_pointer(window), s7_c_pointer(event))));
}
-static s7_pointer lg_gtk_widget_set_clip(s7_scheme *sc, s7_pointer args)
-{
- #define H_gtk_widget_set_clip "void gtk_widget_set_clip(GtkWidget* widget, GtkAllocation* clip)"
- s7_pointer _p;
- s7_pointer widget, clip;
- _p = args;
- widget = s7_car(_p); _p = s7_cdr(_p);
- if (!s7_is_c_pointer_of_type(widget, GtkWidget__sym)) s7_wrong_type_arg_error(sc, "gtk_widget_set_clip", 1, widget, "GtkWidget*");
- clip = s7_car(_p); _p = s7_cdr(_p);
- if (!s7_is_c_pointer_of_type(clip, GtkAllocation__sym)) s7_wrong_type_arg_error(sc, "gtk_widget_set_clip", 2, clip, "GtkAllocation*");
- gtk_widget_set_clip(s7_c_pointer(widget), s7_c_pointer(clip));
- return(lg_false);
-}
-
static s7_pointer lg_gtk_widget_get_clip(s7_scheme *sc, s7_pointer args)
{
#define H_gtk_widget_get_clip "void gtk_widget_get_clip(GtkWidget* widget, GtkAllocation* clip)"
@@ -43430,6 +43308,179 @@ static s7_pointer lg_gtk_get_event_target(s7_scheme *sc, s7_pointer args)
return(s7_make_type_with_c_pointer(sc, GtkWidget__sym, gtk_get_event_target(s7_c_pointer(event))));
}
+static s7_pointer lg_gtk_accel_label_set_label(s7_scheme *sc, s7_pointer args)
+{
+ #define H_gtk_accel_label_set_label "void gtk_accel_label_set_label(GtkAccelLabel* accel_label, char* text)"
+ s7_pointer _p;
+ s7_pointer accel_label, text;
+ _p = args;
+ accel_label = s7_car(_p); _p = s7_cdr(_p);
+ if (!s7_is_c_pointer_of_type(accel_label, GtkAccelLabel__sym)) s7_wrong_type_arg_error(sc, "gtk_accel_label_set_label", 1, accel_label, "GtkAccelLabel*");
+ text = s7_car(_p); _p = s7_cdr(_p);
+ if (!s7_is_string(text)) s7_wrong_type_arg_error(sc, "gtk_accel_label_set_label", 2, text, "char*");
+ gtk_accel_label_set_label(s7_c_pointer(accel_label), (const char*)(char*)s7_string(text));
+ return(lg_false);
+}
+
+static s7_pointer lg_gtk_accel_label_get_label(s7_scheme *sc, s7_pointer args)
+{
+ #define H_gtk_accel_label_get_label "char* gtk_accel_label_get_label(GtkAccelLabel* accel_label)"
+ s7_pointer accel_label;
+ accel_label = s7_car(args);
+ if (!s7_is_c_pointer_of_type(accel_label, GtkAccelLabel__sym)) s7_wrong_type_arg_error(sc, "gtk_accel_label_get_label", 1, accel_label, "GtkAccelLabel*");
+ return(s7_make_string(sc, (char*)gtk_accel_label_get_label(s7_c_pointer(accel_label))));
+}
+
+static s7_pointer lg_gtk_accel_label_set_use_underline(s7_scheme *sc, s7_pointer args)
+{
+ #define H_gtk_accel_label_set_use_underline "void gtk_accel_label_set_use_underline(GtkAccelLabel* accel_label, \
+gboolean setting)"
+ s7_pointer _p;
+ s7_pointer accel_label, setting;
+ _p = args;
+ accel_label = s7_car(_p); _p = s7_cdr(_p);
+ if (!s7_is_c_pointer_of_type(accel_label, GtkAccelLabel__sym)) s7_wrong_type_arg_error(sc, "gtk_accel_label_set_use_underline", 1, accel_label, "GtkAccelLabel*");
+ setting = s7_car(_p); _p = s7_cdr(_p);
+ if (!s7_is_boolean(setting)) s7_wrong_type_arg_error(sc, "gtk_accel_label_set_use_underline", 2, setting, "gboolean");
+ gtk_accel_label_set_use_underline(s7_c_pointer(accel_label), lg_boolean(setting));
+ return(lg_false);
+}
+
+static s7_pointer lg_gtk_accel_label_get_use_underline(s7_scheme *sc, s7_pointer args)
+{
+ #define H_gtk_accel_label_get_use_underline "gboolean gtk_accel_label_get_use_underline(GtkAccelLabel* accel_label)"
+ s7_pointer accel_label;
+ accel_label = s7_car(args);
+ if (!s7_is_c_pointer_of_type(accel_label, GtkAccelLabel__sym)) s7_wrong_type_arg_error(sc, "gtk_accel_label_get_use_underline", 1, accel_label, "GtkAccelLabel*");
+ return(s7_make_boolean(sc, gtk_accel_label_get_use_underline(s7_c_pointer(accel_label))));
+}
+
+static s7_pointer lg_gtk_scrollbar_set_adjustment(s7_scheme *sc, s7_pointer args)
+{
+ #define H_gtk_scrollbar_set_adjustment "void gtk_scrollbar_set_adjustment(GtkScrollbar* self, GtkAdjustment* adjustment)"
+ s7_pointer _p;
+ s7_pointer self, adjustment;
+ _p = args;
+ self = s7_car(_p); _p = s7_cdr(_p);
+ if (!s7_is_c_pointer_of_type(self, GtkScrollbar__sym)) s7_wrong_type_arg_error(sc, "gtk_scrollbar_set_adjustment", 1, self, "GtkScrollbar*");
+ adjustment = s7_car(_p); _p = s7_cdr(_p);
+ if (!s7_is_c_pointer_of_type(adjustment, GtkAdjustment__sym)) s7_wrong_type_arg_error(sc, "gtk_scrollbar_set_adjustment", 2, adjustment, "GtkAdjustment*");
+ gtk_scrollbar_set_adjustment(s7_c_pointer(self), s7_c_pointer(adjustment));
+ return(lg_false);
+}
+
+static s7_pointer lg_gtk_scrollbar_get_adjustment(s7_scheme *sc, s7_pointer args)
+{
+ #define H_gtk_scrollbar_get_adjustment "GtkAdjustment* gtk_scrollbar_get_adjustment(GtkScrollbar* self)"
+ s7_pointer self;
+ self = s7_car(args);
+ if (!s7_is_c_pointer_of_type(self, GtkScrollbar__sym)) s7_wrong_type_arg_error(sc, "gtk_scrollbar_get_adjustment", 1, self, "GtkScrollbar*");
+ return(s7_make_type_with_c_pointer(sc, GtkAdjustment__sym, gtk_scrollbar_get_adjustment(s7_c_pointer(self))));
+}
+
+static s7_pointer lg_gtk_scrollbar_get_wheel_delta(s7_scheme *sc, s7_pointer args)
+{
+ #define H_gtk_scrollbar_get_wheel_delta "double gtk_scrollbar_get_wheel_delta(GtkScrollbar* self, GdkEventScroll* event)"
+ s7_pointer _p;
+ s7_pointer self, event;
+ _p = args;
+ self = s7_car(_p); _p = s7_cdr(_p);
+ if (!s7_is_c_pointer_of_type(self, GtkScrollbar__sym)) s7_wrong_type_arg_error(sc, "gtk_scrollbar_get_wheel_delta", 1, self, "GtkScrollbar*");
+ event = s7_car(_p); _p = s7_cdr(_p);
+ if (!s7_is_c_pointer_of_type(event, GdkEventScroll__sym)) s7_wrong_type_arg_error(sc, "gtk_scrollbar_get_wheel_delta", 2, event, "GdkEventScroll*");
+ return(s7_make_real(sc, gtk_scrollbar_get_wheel_delta(s7_c_pointer(self), s7_c_pointer(event))));
+}
+
+static s7_pointer lg_gtk_spin_button_get_text(s7_scheme *sc, s7_pointer args)
+{
+ #define H_gtk_spin_button_get_text "char* gtk_spin_button_get_text(GtkSpinButton* spin_button)"
+ s7_pointer spin_button;
+ spin_button = s7_car(args);
+ if (!s7_is_c_pointer_of_type(spin_button, GtkSpinButton__sym)) s7_wrong_type_arg_error(sc, "gtk_spin_button_get_text", 1, spin_button, "GtkSpinButton*");
+ return(s7_make_string(sc, (char*)gtk_spin_button_get_text(s7_c_pointer(spin_button))));
+}
+
+static s7_pointer lg_gtk_spin_button_set_text(s7_scheme *sc, s7_pointer args)
+{
+ #define H_gtk_spin_button_set_text "void gtk_spin_button_set_text(GtkSpinButton* spin_button, char* text)"
+ s7_pointer _p;
+ s7_pointer spin_button, text;
+ _p = args;
+ spin_button = s7_car(_p); _p = s7_cdr(_p);
+ if (!s7_is_c_pointer_of_type(spin_button, GtkSpinButton__sym)) s7_wrong_type_arg_error(sc, "gtk_spin_button_set_text", 1, spin_button, "GtkSpinButton*");
+ text = s7_car(_p); _p = s7_cdr(_p);
+ if (!s7_is_string(text)) s7_wrong_type_arg_error(sc, "gtk_spin_button_set_text", 2, text, "char*");
+ gtk_spin_button_set_text(s7_c_pointer(spin_button), (const char*)(char*)s7_string(text));
+ return(lg_false);
+}
+
+static s7_pointer lg_gtk_spin_button_get_max_width_chars(s7_scheme *sc, s7_pointer args)
+{
+ #define H_gtk_spin_button_get_max_width_chars "int gtk_spin_button_get_max_width_chars(GtkSpinButton* spin_button)"
+ s7_pointer spin_button;
+ spin_button = s7_car(args);
+ if (!s7_is_c_pointer_of_type(spin_button, GtkSpinButton__sym)) s7_wrong_type_arg_error(sc, "gtk_spin_button_get_max_width_chars", 1, spin_button, "GtkSpinButton*");
+ return(s7_make_integer(sc, gtk_spin_button_get_max_width_chars(s7_c_pointer(spin_button))));
+}
+
+static s7_pointer lg_gtk_spin_button_set_max_width_chars(s7_scheme *sc, s7_pointer args)
+{
+ #define H_gtk_spin_button_set_max_width_chars "void gtk_spin_button_set_max_width_chars(GtkSpinButton* spin_button, \
+int max_width_chars)"
+ s7_pointer _p;
+ s7_pointer spin_button, max_width_chars;
+ _p = args;
+ spin_button = s7_car(_p); _p = s7_cdr(_p);
+ if (!s7_is_c_pointer_of_type(spin_button, GtkSpinButton__sym)) s7_wrong_type_arg_error(sc, "gtk_spin_button_set_max_width_chars", 1, spin_button, "GtkSpinButton*");
+ max_width_chars = s7_car(_p); _p = s7_cdr(_p);
+ if (!s7_is_integer(max_width_chars)) s7_wrong_type_arg_error(sc, "gtk_spin_button_set_max_width_chars", 2, max_width_chars, "int");
+ gtk_spin_button_set_max_width_chars(s7_c_pointer(spin_button), s7_integer(max_width_chars));
+ return(lg_false);
+}
+
+static s7_pointer lg_gtk_spin_button_get_width_chars(s7_scheme *sc, s7_pointer args)
+{
+ #define H_gtk_spin_button_get_width_chars "int gtk_spin_button_get_width_chars(GtkSpinButton* spin_button)"
+ s7_pointer spin_button;
+ spin_button = s7_car(args);
+ if (!s7_is_c_pointer_of_type(spin_button, GtkSpinButton__sym)) s7_wrong_type_arg_error(sc, "gtk_spin_button_get_width_chars", 1, spin_button, "GtkSpinButton*");
+ return(s7_make_integer(sc, gtk_spin_button_get_width_chars(s7_c_pointer(spin_button))));
+}
+
+static s7_pointer lg_gtk_spin_button_set_width_chars(s7_scheme *sc, s7_pointer args)
+{
+ #define H_gtk_spin_button_set_width_chars "void gtk_spin_button_set_width_chars(GtkSpinButton* spin_button, \
+int width_chars;)"
+ s7_pointer _p;
+ s7_pointer spin_button, width_chars;;
+ _p = args;
+ spin_button = s7_car(_p); _p = s7_cdr(_p);
+ if (!s7_is_c_pointer_of_type(spin_button, GtkSpinButton__sym)) s7_wrong_type_arg_error(sc, "gtk_spin_button_set_width_chars", 1, spin_button, "GtkSpinButton*");
+ width_chars; = s7_car(_p); _p = s7_cdr(_p);
+ if (!s7_is_integer(width_chars;)) s7_wrong_type_arg_error(sc, "gtk_spin_button_set_width_chars", 2, width_chars;, "int");
+ gtk_spin_button_set_width_chars(s7_c_pointer(spin_button), s7_integer(width_chars;));
+ return(lg_false);
+}
+
+static s7_pointer lg_gtk_widget_size_allocate(s7_scheme *sc, s7_pointer args)
+{
+ #define H_gtk_widget_size_allocate "void gtk_widget_size_allocate(GtkWidget* widget, GtkAllocation* allocation, \
+int baseline, GtkAllocation* out_clip)"
+ s7_pointer _p;
+ s7_pointer widget, allocation, baseline, out_clip;
+ _p = args;
+ widget = s7_car(_p); _p = s7_cdr(_p);
+ if (!s7_is_c_pointer_of_type(widget, GtkWidget__sym)) s7_wrong_type_arg_error(sc, "gtk_widget_size_allocate", 1, widget, "GtkWidget*");
+ allocation = s7_car(_p); _p = s7_cdr(_p);
+ if (!s7_is_c_pointer_of_type(allocation, GtkAllocation__sym)) s7_wrong_type_arg_error(sc, "gtk_widget_size_allocate", 2, allocation, "GtkAllocation*");
+ baseline = s7_car(_p); _p = s7_cdr(_p);
+ if (!s7_is_integer(baseline)) s7_wrong_type_arg_error(sc, "gtk_widget_size_allocate", 3, baseline, "int");
+ out_clip = s7_car(_p); _p = s7_cdr(_p);
+ if (!s7_is_c_pointer_of_type(out_clip, GtkAllocation__sym)) s7_wrong_type_arg_error(sc, "gtk_widget_size_allocate", 4, out_clip, "GtkAllocation*");
+ gtk_widget_size_allocate(s7_c_pointer(widget), s7_c_pointer(allocation), s7_integer(baseline), s7_c_pointer(out_clip));
+ return(lg_false);
+}
+
#endif
static s7_pointer lg_cairo_create(s7_scheme *sc, s7_pointer args)
@@ -46901,7 +46952,6 @@ static s7_pointer lg_GTK_DIALOG(s7_scheme *sc, s7_pointer args) {return(s7_make_
static s7_pointer lg_GTK_DRAWING_AREA(s7_scheme *sc, s7_pointer args) {return(s7_make_c_pointer_with_type(sc, s7_c_pointer(s7_car(args)), GtkDrawingArea__sym, lg_false));}
static s7_pointer lg_GTK_EDITABLE(s7_scheme *sc, s7_pointer args) {return(s7_make_c_pointer_with_type(sc, s7_c_pointer(s7_car(args)), GtkEditable__sym, lg_false));}
static s7_pointer lg_GTK_ENTRY(s7_scheme *sc, s7_pointer args) {return(s7_make_c_pointer_with_type(sc, s7_c_pointer(s7_car(args)), GtkEntry__sym, lg_false));}
-static s7_pointer lg_GTK_EVENT_BOX(s7_scheme *sc, s7_pointer args) {return(s7_make_c_pointer_with_type(sc, s7_c_pointer(s7_car(args)), GtkEventBox__sym, lg_false));}
static s7_pointer lg_GTK_FIXED(s7_scheme *sc, s7_pointer args) {return(s7_make_c_pointer_with_type(sc, s7_c_pointer(s7_car(args)), GtkFixed__sym, lg_false));}
static s7_pointer lg_GTK_FRAME(s7_scheme *sc, s7_pointer args) {return(s7_make_c_pointer_with_type(sc, s7_c_pointer(s7_car(args)), GtkFrame__sym, lg_false));}
static s7_pointer lg_GTK_IMAGE(s7_scheme *sc, s7_pointer args) {return(s7_make_c_pointer_with_type(sc, s7_c_pointer(s7_car(args)), GtkImage__sym, lg_false));}
@@ -47230,10 +47280,6 @@ static s7_pointer lg_GTK_IS_ENTRY(s7_scheme *sc, s7_pointer args)
{
return(((s7_is_c_pointer(s7_car(args))) && (GTK_IS_ENTRY((GTypeInstance *)s7_c_pointer(s7_car(args))))) ? lg_true : lg_false);
}
-static s7_pointer lg_GTK_IS_EVENT_BOX(s7_scheme *sc, s7_pointer args)
-{
- return(((s7_is_c_pointer(s7_car(args))) && (GTK_IS_EVENT_BOX((GTypeInstance *)s7_c_pointer(s7_car(args))))) ? lg_true : lg_false);
-}
static s7_pointer lg_GTK_IS_FIXED(s7_scheme *sc, s7_pointer args)
{
return(((s7_is_c_pointer(s7_car(args))) && (GTK_IS_FIXED((GTypeInstance *)s7_c_pointer(s7_car(args))))) ? lg_true : lg_false);
@@ -48079,7 +48125,7 @@ static void define_structs(s7_scheme *sc)
static void define_functions(s7_scheme *sc)
{
s7_pointer s_boolean, s_integer, s_real, s_string, s_any, s_pair, s_float, s_gtk_enum_t, s_pair_false;
- s7_pointer pl_iur, pl_iugi, pl_iuisi, pl_iuuui, pl_iuuuui, pl_iuis, pl_iug, pl_pit, pl_piu, pl_ius, pl_iusi, pl_iu, pl_iuui, pl_pi, pl_iui, pl_iuisut, pl_t, pl_prrru, pl_tts, pl_tti, pl_dusr, pl_dusi, pl_dui, pl_du, pl_dus, pl_pr, pl_ssig, pl_ssi, pl_psgi, pl_suiig, pl_sug, pl_psiuub, pl_psgbiiiit, pl_psrrrb, pl_sui, pl_suuub, pl_psu, pl_psb, pl_su, pl_sus, pl_ps, pl_psg, pl_psi, pl_psugt, pl_psiu, pl_psiiuusu, pl_psut, pl_pur, pl_puuui, pl_pusiig, pl_pusiigu, pl_pusiiugu, pl_puuiig, pl_puur, pl_purru, pl_puiiui, pl_pugi, pl_puuig, pl_puttiiiu, pl_pubi, pl_puiig, pl_puiigi, pl_puigu, pl_puuusuug, pl_pusi, pl_pusiu, pl_putu, pl_puri, pl_pusub, pl_pust, pl_pub, pl_puuiu, pl_pugiiu, pl_pusu, pl_pu, pl_puuubu, pl_puiiu, pl_pugu, pl_puutuuiu, pl_puutu, pl_pui, pl_pussu, pl_puibu, pl_pus, pl_pug, pl_put, pl_pusigu, pl_pusig, pl_puui, pl_puiu, pl_pusiuiu, pl_pusiuibu, pl_pusiiu, pl_puuiiu, pl_b, pl_btiib, pl_bti, pl_bt, pl_tb, pl_g, pl_tg, pl_i, pl_tiu, pl_itiiub, pl_itsub, pl_itstttg, pl_itgiiut, pl_ti, pl_it, pl_s, pl_tsu, pl_tsb, pl_st, pl_tsig, pl_ts, pl_tsi, pl_tsiu, pl_tsiiuui, pl_tsiuui, pl_p, pl_tusiuiui, pl_tuuiu, pl_tussu, pl_tuuuggu, pl_tuuggu, pl_tugiis, pl_tubu, pl_tuurru, pl_tuurrrrgr, pl_tuurrrrg, pl_tuuur, pl_tusg, pl_tuuuui, pl_tugiiu, pl_tuusb, pl_tugui, pl_tuuugi, pl_tuuuub, pl_tuttti, pl_tuuttti, pl_tuisi, pl_tugb, pl_tugs, pl_tugug, pl_turgs, pl_tubi, pl_tuttigsi, pl_tuiiiiui, pl_tuurb, pl_tuuiiiirrrrg, pl_tuuiiiirrrrgi, pl_tuiggu, pl_turrrb, pl_tuubbig, pl_pt, pl_tuuti, pl_tubbi, pl_tuti, pl_tutti, pl_tutui, pl_tutisi, pl_tuuri, pl_tuusit, pl_tuurbr, pl_tuugi, pl_tuit, pl_tusr, pl_tusri, pl_tusi, pl_turi, pl_tuui, pl_tuur, pl_tuig, pl_tur, pl_tub, pl_tui, pl_tu, pl_tus, pl_tusb, pl_tut, pl_tuuut, pl_tug, pl_tutb, pl_tust, pl_tuub, pl_tuus, pl_tuug, pl_tuibu, pl_tuut, pl_tuuig, pl_tuguig, pl_tuubr, pl_tuuub, pl_tuuiuui, pl_tugu, pl_tuuir, pl_tugr, pl_tugi, pl_tuuui, pl_tuib, pl_tusu, pl_tuusi, pl_tugt, pl_tuis, pl_tubiiiu, pl_tuiu, pl_tusiis, pl_tuiiu, pl_tuuug, pl_tusuig, pl_tuuubr, pl_big, pl_bi, pl_bsu, pl_bsigb, pl_bur, pl_buug, pl_buigu, pl_buuti, pl_butib, pl_buiuig, pl_buuusuug, pl_buuit, pl_buti, pl_butti, pl_busi, pl_buusib, pl_busib, pl_buuuub, pl_buuub, pl_buttu, pl_busgu, pl_buurbr, pl_buui, pl_buus, pl_buuui, pl_bug, pl_bu, pl_bus, pl_busu, pl_but, pl_bui, pl_buib, pl_buiu, pl_bub, pl_buub, pl_pb, pl_buig, pl_buuig, pl_igi, pl_gi, pl_iiit, pl_iit, pl_sg, pl_gs, pl_gussitu, pl_gurrsiu, pl_gus, pl_guut, pl_guuut, pl_guugbuut, pl_pgr, pl_pgu, pl_pgi, pl_gug, pl_pgbi, pl_gu, pl_pg, pl_gui, pl_isigutttiiu, pl_isi, pl_isgt, pl_sig, pl_si, pl_is, pl_bpt;
+ s7_pointer pl_iur, pl_iugi, pl_iuisi, pl_iuuui, pl_iuuuui, pl_iuis, pl_iug, pl_pit, pl_piu, pl_ius, pl_iusi, pl_iu, pl_iuui, pl_pi, pl_iui, pl_iuisut, pl_t, pl_prrru, pl_tts, pl_tti, pl_dusr, pl_dusi, pl_dui, pl_du, pl_dus, pl_pr, pl_ssig, pl_ssi, pl_psgi, pl_suiig, pl_sug, pl_psiuub, pl_psgbiiiit, pl_psrrrb, pl_sui, pl_suuub, pl_psu, pl_psb, pl_su, pl_sus, pl_ps, pl_psg, pl_psi, pl_psugt, pl_psiu, pl_psiiuusu, pl_psut, pl_pur, pl_puuui, pl_pusiig, pl_pusiigu, pl_pusiiugu, pl_puuiig, pl_puur, pl_purru, pl_puiiui, pl_pugi, pl_puuig, pl_puttiiiu, pl_pubi, pl_puiig, pl_puiigi, pl_puigu, pl_puuusuug, pl_pusi, pl_pusiu, pl_putu, pl_puri, pl_pusub, pl_pust, pl_pub, pl_puuiu, pl_pugiiu, pl_pusu, pl_pu, pl_puiiu, pl_puuubu, pl_pugu, pl_puutuuiu, pl_puutu, pl_pui, pl_pussu, pl_puibu, pl_pus, pl_pug, pl_put, pl_pusigu, pl_pusig, pl_puui, pl_puiu, pl_pusiuiu, pl_pusiuibu, pl_pusiiu, pl_puuiiu, pl_b, pl_btiib, pl_bti, pl_bt, pl_tb, pl_g, pl_i, pl_tg, pl_tiu, pl_itiiub, pl_itsub, pl_itstttg, pl_itgiiut, pl_ti, pl_it, pl_s, pl_tsu, pl_tsb, pl_st, pl_tsig, pl_ts, pl_tsi, pl_tsiu, pl_tsiiuui, pl_tsiuui, pl_p, pl_tusiuiui, pl_tuuiu, pl_tussu, pl_tuuuggu, pl_tuuggu, pl_tugiis, pl_tubu, pl_tuurru, pl_tuurrrrgr, pl_tuurrrrg, pl_tuuur, pl_tusg, pl_tuuuui, pl_tugiiu, pl_tuusb, pl_tugui, pl_tuuugi, pl_tuuuub, pl_tuttti, pl_tuuttti, pl_tuisi, pl_tugb, pl_tugs, pl_tugug, pl_turgs, pl_tubi, pl_tuttigsi, pl_tuiiiiui, pl_tuurb, pl_tuuiiiirrrrg, pl_tuuiiiirrrrgi, pl_tuiggu, pl_turrrb, pl_tuubbig, pl_pt, pl_tuuti, pl_tubbi, pl_tuti, pl_tutti, pl_tutui, pl_tutisi, pl_tuuri, pl_tuusit, pl_tuurbr, pl_tuugi, pl_tuit, pl_tusr, pl_tusri, pl_tusi, pl_turi, pl_tuui, pl_tuur, pl_tuig, pl_tur, pl_tub, pl_tui, pl_tu, pl_tus, pl_tusb, pl_tut, pl_tuuut, pl_tug, pl_tutb, pl_tust, pl_tuub, pl_tuus, pl_tuug, pl_tuibu, pl_tuut, pl_tuuig, pl_tuguig, pl_tuubr, pl_tuuub, pl_tuuiuui, pl_tugu, pl_tuuir, pl_tugr, pl_tugi, pl_tuuui, pl_tuib, pl_tusu, pl_tuusi, pl_tugt, pl_tuis, pl_tubiiiu, pl_tuiu, pl_tusiis, pl_tuiiu, pl_tuuug, pl_tusuig, pl_tuuubr, pl_big, pl_bi, pl_bsu, pl_bsigb, pl_bur, pl_buug, pl_buigu, pl_buuti, pl_butib, pl_buiuig, pl_buuusuug, pl_buuit, pl_buti, pl_butti, pl_busi, pl_buusib, pl_busib, pl_buuuub, pl_buuub, pl_buttu, pl_busgu, pl_buurbr, pl_buui, pl_buus, pl_buuui, pl_bug, pl_bu, pl_bus, pl_busu, pl_but, pl_bui, pl_buib, pl_buiu, pl_bub, pl_buub, pl_pb, pl_buig, pl_buuig, pl_igi, pl_gi, pl_iiit, pl_iit, pl_sg, pl_gs, pl_isigutttiiu, pl_isi, pl_isgt, pl_sig, pl_si, pl_is, pl_gussitu, pl_gurrsiu, pl_gus, pl_guut, pl_guuut, pl_guugbuut, pl_pgr, pl_pgu, pl_pgi, pl_gug, pl_pgbi, pl_gu, pl_pg, pl_gui, pl_bpt;
s_boolean = s7_make_symbol(sc, "boolean?");
s_integer = s7_make_symbol(sc, "integer?");
@@ -48166,8 +48212,8 @@ static void define_functions(s7_scheme *sc)
pl_pugiiu = s7_make_circular_signature(sc, 5, 6, s_pair, s_pair_false, s_gtk_enum_t, s_integer, s_integer, s_pair_false);
pl_pusu = s7_make_circular_signature(sc, 3, 4, s_pair, s_pair_false, s_string, s_pair_false);
pl_pu = s7_make_circular_signature(sc, 1, 2, s_pair, s_pair_false);
- pl_puuubu = s7_make_circular_signature(sc, 5, 6, s_pair, s_pair_false, s_pair_false, s_pair_false, s_boolean, s_pair_false);
pl_puiiu = s7_make_circular_signature(sc, 4, 5, s_pair, s_pair_false, s_integer, s_integer, s_pair_false);
+ pl_puuubu = s7_make_circular_signature(sc, 5, 6, s_pair, s_pair_false, s_pair_false, s_pair_false, s_boolean, s_pair_false);
pl_pugu = s7_make_circular_signature(sc, 3, 4, s_pair, s_pair_false, s_gtk_enum_t, s_pair_false);
pl_puutuuiu = s7_make_circular_signature(sc, 7, 8, s_pair, s_pair_false, s_pair_false, s_any, s_pair_false, s_pair_false, s_integer, s_pair_false);
pl_puutu = s7_make_circular_signature(sc, 4, 5, s_pair, s_pair_false, s_pair_false, s_any, s_pair_false);
@@ -48191,8 +48237,8 @@ static void define_functions(s7_scheme *sc)
pl_bt = s7_make_circular_signature(sc, 1, 2, s_boolean, s_any);
pl_tb = s7_make_circular_signature(sc, 1, 2, s_any, s_boolean);
pl_g = s7_make_circular_signature(sc, 0, 1, s_gtk_enum_t);
- pl_tg = s7_make_circular_signature(sc, 1, 2, s_any, s_gtk_enum_t);
pl_i = s7_make_circular_signature(sc, 0, 1, s_integer);
+ pl_tg = s7_make_circular_signature(sc, 1, 2, s_any, s_gtk_enum_t);
pl_tiu = s7_make_circular_signature(sc, 2, 3, s_any, s_integer, s_pair_false);
pl_itiiub = s7_make_circular_signature(sc, 5, 6, s_integer, s_any, s_integer, s_integer, s_pair_false, s_boolean);
pl_itsub = s7_make_circular_signature(sc, 4, 5, s_integer, s_any, s_string, s_pair_false, s_boolean);
@@ -48346,6 +48392,12 @@ static void define_functions(s7_scheme *sc)
pl_iit = s7_make_circular_signature(sc, 2, 3, s_integer, s_integer, s_any);
pl_sg = s7_make_circular_signature(sc, 1, 2, s_string, s_gtk_enum_t);
pl_gs = s7_make_circular_signature(sc, 1, 2, s_gtk_enum_t, s_string);
+ pl_isigutttiiu = s7_make_circular_signature(sc, 10, 11, s_integer, s_string, s_integer, s_gtk_enum_t, s_pair_false, s_any, s_any, s_any, s_integer, s_integer, s_pair_false);
+ pl_isi = s7_make_circular_signature(sc, 2, 3, s_integer, s_string, s_integer);
+ pl_isgt = s7_make_circular_signature(sc, 3, 4, s_integer, s_string, s_gtk_enum_t, s_any);
+ pl_sig = s7_make_circular_signature(sc, 2, 3, s_string, s_integer, s_gtk_enum_t);
+ pl_si = s7_make_circular_signature(sc, 1, 2, s_string, s_integer);
+ pl_is = s7_make_circular_signature(sc, 1, 2, s_integer, s_string);
pl_gussitu = s7_make_circular_signature(sc, 6, 7, s_gtk_enum_t, s_pair_false, s_string, s_string, s_integer, s_any, s_pair_false);
pl_gurrsiu = s7_make_circular_signature(sc, 6, 7, s_gtk_enum_t, s_pair_false, s_real, s_real, s_string, s_integer, s_pair_false);
pl_gus = s7_make_circular_signature(sc, 2, 3, s_gtk_enum_t, s_pair_false, s_string);
@@ -48360,12 +48412,6 @@ static void define_functions(s7_scheme *sc)
pl_gu = s7_make_circular_signature(sc, 1, 2, s_gtk_enum_t, s_pair_false);
pl_pg = s7_make_circular_signature(sc, 1, 2, s_pair, s_gtk_enum_t);
pl_gui = s7_make_circular_signature(sc, 2, 3, s_gtk_enum_t, s_pair_false, s_integer);
- pl_isigutttiiu = s7_make_circular_signature(sc, 10, 11, s_integer, s_string, s_integer, s_gtk_enum_t, s_pair_false, s_any, s_any, s_any, s_integer, s_integer, s_pair_false);
- pl_isi = s7_make_circular_signature(sc, 2, 3, s_integer, s_string, s_integer);
- pl_isgt = s7_make_circular_signature(sc, 3, 4, s_integer, s_string, s_gtk_enum_t, s_any);
- pl_sig = s7_make_circular_signature(sc, 2, 3, s_string, s_integer, s_gtk_enum_t);
- pl_si = s7_make_circular_signature(sc, 1, 2, s_string, s_integer);
- pl_is = s7_make_circular_signature(sc, 1, 2, s_integer, s_string);
pl_bpt = s7_make_signature(sc, 2, s_pair_false, s_any);
s7_define_typed_function(sc, "g_unichar_validate", lg_g_unichar_validate, 1, 0, 0, H_g_unichar_validate, pl_bi);
@@ -48755,7 +48801,6 @@ static void define_functions(s7_scheme *sc)
s7_define_typed_function(sc, "gtk_entry_get_text", lg_gtk_entry_get_text, 1, 0, 0, H_gtk_entry_get_text, pl_su);
s7_define_typed_function(sc, "gtk_entry_get_layout", lg_gtk_entry_get_layout, 1, 0, 0, H_gtk_entry_get_layout, pl_pu);
s7_define_typed_function(sc, "gtk_entry_get_layout_offsets", lg_gtk_entry_get_layout_offsets, 1, 2, 0, H_gtk_entry_get_layout_offsets, pl_pu);
- s7_define_typed_function(sc, "gtk_event_box_new", lg_gtk_event_box_new, 0, 0, 0, H_gtk_event_box_new, pl_p);
s7_define_typed_function(sc, "gtk_fixed_new", lg_gtk_fixed_new, 0, 0, 0, H_gtk_fixed_new, pl_p);
s7_define_typed_function(sc, "gtk_fixed_put", lg_gtk_fixed_put, 4, 0, 0, H_gtk_fixed_put, pl_tuui);
s7_define_typed_function(sc, "gtk_fixed_move", lg_gtk_fixed_move, 4, 0, 0, H_gtk_fixed_move, pl_tuui);
@@ -49449,7 +49494,6 @@ static void define_functions(s7_scheme *sc)
s7_define_typed_function(sc, "gtk_widget_queue_draw", lg_gtk_widget_queue_draw, 1, 0, 0, H_gtk_widget_queue_draw, pl_tu);
s7_define_typed_function(sc, "gtk_widget_queue_draw_area", lg_gtk_widget_queue_draw_area, 5, 0, 0, H_gtk_widget_queue_draw_area, pl_tui);
s7_define_typed_function(sc, "gtk_widget_queue_resize", lg_gtk_widget_queue_resize, 1, 0, 0, H_gtk_widget_queue_resize, pl_tu);
- s7_define_typed_function(sc, "gtk_widget_size_allocate", lg_gtk_widget_size_allocate, 2, 0, 0, H_gtk_widget_size_allocate, pl_tu);
s7_define_typed_function(sc, "gtk_widget_add_accelerator", lg_gtk_widget_add_accelerator, 6, 0, 0, H_gtk_widget_add_accelerator, pl_tusuig);
s7_define_typed_function(sc, "gtk_widget_remove_accelerator", lg_gtk_widget_remove_accelerator, 4, 0, 0, H_gtk_widget_remove_accelerator, pl_buuig);
s7_define_typed_function(sc, "gtk_widget_list_accel_closures", lg_gtk_widget_list_accel_closures, 1, 0, 0, H_gtk_widget_list_accel_closures, pl_pu);
@@ -49793,10 +49837,6 @@ static void define_functions(s7_scheme *sc)
s7_define_typed_function(sc, "gtk_check_menu_item_get_draw_as_radio", lg_gtk_check_menu_item_get_draw_as_radio, 1, 0, 0, H_gtk_check_menu_item_get_draw_as_radio, pl_bu);
s7_define_typed_function(sc, "gtk_entry_set_completion", lg_gtk_entry_set_completion, 2, 0, 0, H_gtk_entry_set_completion, pl_tu);
s7_define_typed_function(sc, "gtk_entry_get_completion", lg_gtk_entry_get_completion, 1, 0, 0, H_gtk_entry_get_completion, pl_pu);
- s7_define_typed_function(sc, "gtk_event_box_get_visible_window", lg_gtk_event_box_get_visible_window, 1, 0, 0, H_gtk_event_box_get_visible_window, pl_bu);
- s7_define_typed_function(sc, "gtk_event_box_set_visible_window", lg_gtk_event_box_set_visible_window, 2, 0, 0, H_gtk_event_box_set_visible_window, pl_tub);
- s7_define_typed_function(sc, "gtk_event_box_get_above_child", lg_gtk_event_box_get_above_child, 1, 0, 0, H_gtk_event_box_get_above_child, pl_bu);
- s7_define_typed_function(sc, "gtk_event_box_set_above_child", lg_gtk_event_box_set_above_child, 2, 0, 0, H_gtk_event_box_set_above_child, pl_tub);
s7_define_typed_function(sc, "gtk_menu_attach", lg_gtk_menu_attach, 6, 0, 0, H_gtk_menu_attach, pl_tuui);
s7_define_typed_function(sc, "gtk_text_buffer_select_range", lg_gtk_text_buffer_select_range, 3, 0, 0, H_gtk_text_buffer_select_range, pl_tu);
s7_define_typed_function(sc, "gtk_text_view_set_overwrite", lg_gtk_text_view_set_overwrite, 2, 0, 0, H_gtk_text_view_set_overwrite, pl_tub);
@@ -50581,7 +50621,6 @@ static void define_functions(s7_scheme *sc)
s7_define_typed_function(sc, "gtk_widget_set_tooltip_markup", lg_gtk_widget_set_tooltip_markup, 2, 0, 0, H_gtk_widget_set_tooltip_markup, pl_tus);
s7_define_typed_function(sc, "gtk_widget_get_tooltip_markup", lg_gtk_widget_get_tooltip_markup, 1, 0, 0, H_gtk_widget_get_tooltip_markup, pl_su);
s7_define_typed_function(sc, "gtk_tree_view_is_rubber_banding_active", lg_gtk_tree_view_is_rubber_banding_active, 1, 0, 0, H_gtk_tree_view_is_rubber_banding_active, pl_bu);
- s7_define_typed_function(sc, "gtk_icon_view_convert_widget_to_bin_window_coords", lg_gtk_icon_view_convert_widget_to_bin_window_coords, 3, 2, 0, H_gtk_icon_view_convert_widget_to_bin_window_coords, pl_puiiu);
s7_define_typed_function(sc, "gtk_icon_view_set_tooltip_item", lg_gtk_icon_view_set_tooltip_item, 3, 0, 0, H_gtk_icon_view_set_tooltip_item, pl_tu);
s7_define_typed_function(sc, "gtk_icon_view_set_tooltip_cell", lg_gtk_icon_view_set_tooltip_cell, 4, 0, 0, H_gtk_icon_view_set_tooltip_cell, pl_tu);
s7_define_typed_function(sc, "gtk_icon_view_get_tooltip_context", lg_gtk_icon_view_get_tooltip_context, 3, 4, 0, H_gtk_icon_view_get_tooltip_context, pl_puuubu);
@@ -50610,7 +50649,6 @@ static void define_functions(s7_scheme *sc)
s7_define_typed_function(sc, "gtk_entry_set_overwrite_mode", lg_gtk_entry_set_overwrite_mode, 2, 0, 0, H_gtk_entry_set_overwrite_mode, pl_tub);
s7_define_typed_function(sc, "gtk_entry_get_overwrite_mode", lg_gtk_entry_get_overwrite_mode, 1, 0, 0, H_gtk_entry_get_overwrite_mode, pl_bu);
s7_define_typed_function(sc, "gtk_entry_get_text_length", lg_gtk_entry_get_text_length, 1, 0, 0, H_gtk_entry_get_text_length, pl_iu);
- s7_define_typed_function(sc, "gtk_layout_get_bin_window", lg_gtk_layout_get_bin_window, 1, 0, 0, H_gtk_layout_get_bin_window, pl_pu);
s7_define_typed_function(sc, "gtk_menu_get_accel_path", lg_gtk_menu_get_accel_path, 1, 0, 0, H_gtk_menu_get_accel_path, pl_su);
s7_define_typed_function(sc, "gtk_menu_get_monitor", lg_gtk_menu_get_monitor, 1, 0, 0, H_gtk_menu_get_monitor, pl_iu);
s7_define_typed_function(sc, "gtk_menu_item_get_accel_path", lg_gtk_menu_item_get_accel_path, 1, 0, 0, H_gtk_menu_item_get_accel_path, pl_su);
@@ -50811,7 +50849,6 @@ static void define_functions(s7_scheme *sc)
s7_define_typed_function(sc, "gtk_range_get_slider_size_fixed", lg_gtk_range_get_slider_size_fixed, 1, 0, 0, H_gtk_range_get_slider_size_fixed, pl_bu);
s7_define_typed_function(sc, "gtk_range_get_range_rect", lg_gtk_range_get_range_rect, 2, 0, 0, H_gtk_range_get_range_rect, pl_tu);
s7_define_typed_function(sc, "gtk_range_get_slider_range", lg_gtk_range_get_slider_range, 1, 2, 0, H_gtk_range_get_slider_range, pl_pu);
- s7_define_typed_function(sc, "gtk_paned_get_handle_window", lg_gtk_paned_get_handle_window, 1, 0, 0, H_gtk_paned_get_handle_window, pl_pu);
s7_define_typed_function(sc, "gtk_widget_set_realized", lg_gtk_widget_set_realized, 2, 0, 0, H_gtk_widget_set_realized, pl_tub);
s7_define_typed_function(sc, "gtk_widget_get_realized", lg_gtk_widget_get_realized, 1, 0, 0, H_gtk_widget_get_realized, pl_bu);
s7_define_typed_function(sc, "gtk_widget_get_mapped", lg_gtk_widget_get_mapped, 1, 0, 0, H_gtk_widget_get_mapped, pl_bu);
@@ -51229,7 +51266,6 @@ static void define_functions(s7_scheme *sc)
s7_define_typed_function(sc, "gtk_grid_get_row_baseline_position", lg_gtk_grid_get_row_baseline_position, 2, 0, 0, H_gtk_grid_get_row_baseline_position, pl_gui);
s7_define_typed_function(sc, "gtk_grid_set_baseline_row", lg_gtk_grid_set_baseline_row, 2, 0, 0, H_gtk_grid_set_baseline_row, pl_tui);
s7_define_typed_function(sc, "gtk_grid_get_baseline_row", lg_gtk_grid_get_baseline_row, 1, 0, 0, H_gtk_grid_get_baseline_row, pl_iu);
- s7_define_typed_function(sc, "gtk_widget_size_allocate_with_baseline", lg_gtk_widget_size_allocate_with_baseline, 3, 0, 0, H_gtk_widget_size_allocate_with_baseline, pl_tuui);
s7_define_typed_function(sc, "gtk_widget_get_allocated_baseline", lg_gtk_widget_get_allocated_baseline, 1, 0, 0, H_gtk_widget_get_allocated_baseline, pl_iu);
s7_define_typed_function(sc, "gtk_widget_init_template", lg_gtk_widget_init_template, 1, 0, 0, H_gtk_widget_init_template, pl_tu);
s7_define_typed_function(sc, "gtk_window_set_titlebar", lg_gtk_window_set_titlebar, 2, 0, 0, H_gtk_window_set_titlebar, pl_tu);
@@ -51419,7 +51455,6 @@ static void define_functions(s7_scheme *sc)
s7_define_typed_function(sc, "gtk_switch_set_state", lg_gtk_switch_set_state, 2, 0, 0, H_gtk_switch_set_state, pl_tub);
s7_define_typed_function(sc, "gtk_switch_get_state", lg_gtk_switch_get_state, 1, 0, 0, H_gtk_switch_get_state, pl_bu);
s7_define_typed_function(sc, "gdk_window_show_window_menu", lg_gdk_window_show_window_menu, 2, 0, 0, H_gdk_window_show_window_menu, pl_bu);
- s7_define_typed_function(sc, "gtk_widget_set_clip", lg_gtk_widget_set_clip, 2, 0, 0, H_gtk_widget_set_clip, pl_tu);
s7_define_typed_function(sc, "gtk_widget_get_clip", lg_gtk_widget_get_clip, 2, 0, 0, H_gtk_widget_get_clip, pl_tu);
s7_define_typed_function(sc, "gtk_gesture_get_device", lg_gtk_gesture_get_device, 1, 0, 0, H_gtk_gesture_get_device, pl_pu);
s7_define_typed_function(sc, "gtk_gesture_set_state", lg_gtk_gesture_set_state, 2, 0, 0, H_gtk_gesture_set_state, pl_bui);
@@ -51744,6 +51779,20 @@ static void define_functions(s7_scheme *sc)
s7_define_typed_function(sc, "gdk_event_get_user_data", lg_gdk_event_get_user_data, 1, 0, 0, H_gdk_event_get_user_data, pl_pu);
s7_define_typed_function(sc, "gdk_rectangle_contains_point", lg_gdk_rectangle_contains_point, 3, 0, 0, H_gdk_rectangle_contains_point, pl_bui);
s7_define_typed_function(sc, "gtk_get_event_target", lg_gtk_get_event_target, 1, 0, 0, H_gtk_get_event_target, pl_pu);
+ s7_define_typed_function(sc, "gtk_accel_label_set_label", lg_gtk_accel_label_set_label, 2, 0, 0, H_gtk_accel_label_set_label, pl_tus);
+ s7_define_typed_function(sc, "gtk_accel_label_get_label", lg_gtk_accel_label_get_label, 1, 0, 0, H_gtk_accel_label_get_label, pl_su);
+ s7_define_typed_function(sc, "gtk_accel_label_set_use_underline", lg_gtk_accel_label_set_use_underline, 2, 0, 0, H_gtk_accel_label_set_use_underline, pl_tub);
+ s7_define_typed_function(sc, "gtk_accel_label_get_use_underline", lg_gtk_accel_label_get_use_underline, 1, 0, 0, H_gtk_accel_label_get_use_underline, pl_bu);
+ s7_define_typed_function(sc, "gtk_scrollbar_set_adjustment", lg_gtk_scrollbar_set_adjustment, 2, 0, 0, H_gtk_scrollbar_set_adjustment, pl_tu);
+ s7_define_typed_function(sc, "gtk_scrollbar_get_adjustment", lg_gtk_scrollbar_get_adjustment, 1, 0, 0, H_gtk_scrollbar_get_adjustment, pl_pu);
+ s7_define_typed_function(sc, "gtk_scrollbar_get_wheel_delta", lg_gtk_scrollbar_get_wheel_delta, 2, 0, 0, H_gtk_scrollbar_get_wheel_delta, pl_du);
+ s7_define_typed_function(sc, "gtk_spin_button_get_text", lg_gtk_spin_button_get_text, 1, 0, 0, H_gtk_spin_button_get_text, pl_su);
+ s7_define_typed_function(sc, "gtk_spin_button_set_text", lg_gtk_spin_button_set_text, 2, 0, 0, H_gtk_spin_button_set_text, pl_tus);
+ s7_define_typed_function(sc, "gtk_spin_button_get_max_width_chars", lg_gtk_spin_button_get_max_width_chars, 1, 0, 0, H_gtk_spin_button_get_max_width_chars, pl_iu);
+ s7_define_typed_function(sc, "gtk_spin_button_set_max_width_chars", lg_gtk_spin_button_set_max_width_chars, 2, 0, 0, H_gtk_spin_button_set_max_width_chars, pl_tui);
+ s7_define_typed_function(sc, "gtk_spin_button_get_width_chars", lg_gtk_spin_button_get_width_chars, 1, 0, 0, H_gtk_spin_button_get_width_chars, pl_iu);
+ s7_define_typed_function(sc, "gtk_spin_button_set_width_chars", lg_gtk_spin_button_set_width_chars, 2, 0, 0, H_gtk_spin_button_set_width_chars, pl_tui);
+ s7_define_typed_function(sc, "gtk_widget_size_allocate", lg_gtk_widget_size_allocate, 4, 0, 0, H_gtk_widget_size_allocate, pl_tuuiu);
#endif
s7_define_typed_function(sc, "cairo_create", lg_cairo_create, 1, 0, 0, H_cairo_create, pl_pu);
@@ -52042,7 +52091,6 @@ static void define_functions(s7_scheme *sc)
s7_define_typed_function(sc, "GTK_DRAWING_AREA", lg_GTK_DRAWING_AREA, 1, 0, 0, "(GTK_DRAWING_AREA obj) casts obj to GTK_DRAWING_AREA", pl_bpt);
s7_define_typed_function(sc, "GTK_EDITABLE", lg_GTK_EDITABLE, 1, 0, 0, "(GTK_EDITABLE obj) casts obj to GTK_EDITABLE", pl_bpt);
s7_define_typed_function(sc, "GTK_ENTRY", lg_GTK_ENTRY, 1, 0, 0, "(GTK_ENTRY obj) casts obj to GTK_ENTRY", pl_bpt);
- s7_define_typed_function(sc, "GTK_EVENT_BOX", lg_GTK_EVENT_BOX, 1, 0, 0, "(GTK_EVENT_BOX obj) casts obj to GTK_EVENT_BOX", pl_bpt);
s7_define_typed_function(sc, "GTK_FIXED", lg_GTK_FIXED, 1, 0, 0, "(GTK_FIXED obj) casts obj to GTK_FIXED", pl_bpt);
s7_define_typed_function(sc, "GTK_FRAME", lg_GTK_FRAME, 1, 0, 0, "(GTK_FRAME obj) casts obj to GTK_FRAME", pl_bpt);
s7_define_typed_function(sc, "GTK_IMAGE", lg_GTK_IMAGE, 1, 0, 0, "(GTK_IMAGE obj) casts obj to GTK_IMAGE", pl_bpt);
@@ -52264,6 +52312,7 @@ static void define_functions(s7_scheme *sc)
#else
s7_define_function(sc, "gtk_init", lg_gtk_init, 0, 2, 0, NULL);
s7_define_function(sc, "gtk_init_check", lg_gtk_init_check, 0, 2, 0, NULL);
+ s7_define_function(sc, "gtk_widget_set_events", lg_gtk_widget_set_events, 2, 0, 0, H_gtk_widget_set_events);
#endif
s7_define_typed_function(sc, "GDK_IS_DRAG_CONTEXT", lg_GDK_IS_DRAG_CONTEXT, 1, 0, 0, "(GDK_IS_DRAG_CONTEXT obj): #t if obj is a GdkDragContext*", pl_bt);
s7_define_typed_function(sc, "GDK_IS_DEVICE", lg_GDK_IS_DEVICE, 1, 0, 0, "(GDK_IS_DEVICE obj): #t if obj is a GdkDevice*", pl_bt);
@@ -52294,7 +52343,6 @@ static void define_functions(s7_scheme *sc)
s7_define_typed_function(sc, "GTK_IS_DRAWING_AREA", lg_GTK_IS_DRAWING_AREA, 1, 0, 0, "(GTK_IS_DRAWING_AREA obj): #t if obj is a GtkDrawingArea*", pl_bt);
s7_define_typed_function(sc, "GTK_IS_EDITABLE", lg_GTK_IS_EDITABLE, 1, 0, 0, "(GTK_IS_EDITABLE obj): #t if obj is a GtkEditable*", pl_bt);
s7_define_typed_function(sc, "GTK_IS_ENTRY", lg_GTK_IS_ENTRY, 1, 0, 0, "(GTK_IS_ENTRY obj): #t if obj is a GtkEntry*", pl_bt);
- s7_define_typed_function(sc, "GTK_IS_EVENT_BOX", lg_GTK_IS_EVENT_BOX, 1, 0, 0, "(GTK_IS_EVENT_BOX obj): #t if obj is a GtkEventBox*", pl_bt);
s7_define_typed_function(sc, "GTK_IS_FIXED", lg_GTK_IS_FIXED, 1, 0, 0, "(GTK_IS_FIXED obj): #t if obj is a GtkFixed*", pl_bt);
s7_define_typed_function(sc, "GTK_IS_FRAME", lg_GTK_IS_FRAME, 1, 0, 0, "(GTK_IS_FRAME obj): #t if obj is a GtkFrame*", pl_bt);
s7_define_typed_function(sc, "GTK_IS_IMAGE", lg_GTK_IS_IMAGE, 1, 0, 0, "(GTK_IS_IMAGE obj): #t if obj is a GtkImage*", pl_bt);
@@ -53932,6 +53980,8 @@ static void define_atoms(s7_scheme *sc)
static void define_symbols(s7_scheme *sc)
{
+ GdkEventScroll__sym = s7_make_symbol(sc, "GdkEventScroll_");
+ GtkScrollbar__sym = s7_make_symbol(sc, "GtkScrollbar_");
GtkCenterBox__sym = s7_make_symbol(sc, "GtkCenterBox_");
GtkCheckButton__sym = s7_make_symbol(sc, "GtkCheckButton_");
GdkDrawContext__sym = s7_make_symbol(sc, "GdkDrawContext_");
@@ -53962,6 +54012,7 @@ static void define_symbols(s7_scheme *sc)
GtkGestureDrag__sym = s7_make_symbol(sc, "GtkGestureDrag_");
GdkEventSequence__sym = s7_make_symbol(sc, "GdkEventSequence_");
GtkGesture__sym = s7_make_symbol(sc, "GtkGesture_");
+ GtkAllocation__sym = s7_make_symbol(sc, "GtkAllocation_");
GtkPopover__sym = s7_make_symbol(sc, "GtkPopover_");
GtkActionBar__sym = s7_make_symbol(sc, "GtkActionBar_");
GtkFlowBox__sym = s7_make_symbol(sc, "GtkFlowBox_");
@@ -54089,7 +54140,6 @@ static void define_symbols(s7_scheme *sc)
GtkComboBox__sym = s7_make_symbol(sc, "GtkComboBox_");
GtkTreeModelFilter__sym = s7_make_symbol(sc, "GtkTreeModelFilter_");
GtkToolItem__sym = s7_make_symbol(sc, "GtkToolItem_");
- GtkEventBox__sym = s7_make_symbol(sc, "GtkEventBox_");
GdkScreen__sym = s7_make_symbol(sc, "GdkScreen_");
PangoLayoutRun__sym = s7_make_symbol(sc, "PangoLayoutRun_");
PangoLayoutIter__sym = s7_make_symbol(sc, "PangoLayoutIter_");
@@ -54116,7 +54166,6 @@ static void define_symbols(s7_scheme *sc)
PangoColor__sym = s7_make_symbol(sc, "PangoColor_");
GtkWindow__sym = s7_make_symbol(sc, "GtkWindow_");
AtkObject__sym = s7_make_symbol(sc, "AtkObject_");
- GtkAllocation__sym = s7_make_symbol(sc, "GtkAllocation_");
GtkViewport__sym = s7_make_symbol(sc, "GtkViewport_");
GtkTreeViewSearchEqualFunc_sym = s7_make_symbol(sc, "GtkTreeViewSearchEqualFunc");
GtkTreeViewMappingFunc_sym = s7_make_symbol(sc, "GtkTreeViewMappingFunc");
@@ -55545,7 +55594,7 @@ void libgtk_s7_init(s7_scheme *sc)
s7_provide(sc, "gtk2");
#endif
#endif
- s7_define(sc, cur_env, s7_make_symbol(sc, "libgtk-version"), s7_make_string(sc, "01-Aug-17"));
+ s7_define(sc, cur_env, s7_make_symbol(sc, "libgtk-version"), s7_make_string(sc, "08-Sep-17"));
}
/* gcc -c libgtk_s7.c -o libgtk_s7.o -I. -fPIC `pkg-config --libs gtk+-3.0 --cflags` -lm -ldl */
/* gcc libgtk_s7.o -shared -o libgtk_s7.so */
diff --git a/lint.scm b/lint.scm
index 1590ffb..4ef5579 100644
--- a/lint.scm
+++ b/lint.scm
@@ -83,7 +83,6 @@
(lint-format-1 ,str ,caller ,@args)))
|#
-
(define var-name car)
(define var-member assq)
@@ -310,7 +309,7 @@
(*e* #f)
(other-identifiers (make-hash-table))
(quote-warnings 0)
- ;; these line numbers are trying to reduce redundant output
+ ;; these line numbers are trying to reduce redundant output, but they sometimes squelch useful feedback
(last-simplify-boolean-line-number -1)
(last-simplify-numeric-line-number -1)
(last-simplify-cxr-line-number -1)
@@ -420,7 +419,7 @@
(denote (local-line-number tree)
(let ((tree-line (and (pair? tree) (pair-line-number tree))))
- (if (and tree-line
+ (if (and (integer? tree-line)
(not (= tree-line line-number)))
(format #f " (line ~D)" tree-line)
"")))
@@ -444,7 +443,7 @@
(and (not (eq? val #<undefined>))
val)))
(denote var-match-list (dilambda (lambda (v) (let-ref (cdr v) 'match-list)) (lambda (v x) (let-set! (cdr v) 'match-list x))))
- (denote var-initial-value (lambda (v) (let-ref (cdr v) 'initial-value))) ; not (easily) settable
+ (denote (var-initial-value v) (let-ref (cdr v) 'initial-value)) ; not (easily) settable
(denote var-refenv
(dilambda (lambda (v)
@@ -475,21 +474,19 @@
(let-set! (cdr v) 'signature x))))) ; perhaps fallback on varlet here and in var-ftype above?
(denote (make-lint-var name initial-value definer)
- (let* ((old (hash-table-ref other-identifiers name))
- (history (if old
- (begin
- (hash-table-set! other-identifiers name #f)
- (if initial-value (cons initial-value old) old))
- (if initial-value (list initial-value) ()))))
+ (let ((old (or (hash-table-ref other-identifiers name) ())))
+ (if (pair? old) (hash-table-set! other-identifiers name #f))
(cons name (inlet 'scope ()
'env ()
'refenv ()
'setters ()
'initial-value initial-value
'definer definer
- 'history history
+ 'history (if initial-value
+ (cons initial-value old)
+ old)
'set 0
- 'ref (if old (length old) 0)))))
+ 'ref (length old)))))
;; -------- the usual list functions --------
@@ -686,10 +683,9 @@
(set! syms (cons a syms)))
(if (pair? a) (walk a))))
(cdr p)))
- (if (pair? (car p))
- (begin
- (walk (car p))
- (walk (cdr p)))))
+ (when (pair? (car p))
+ (walk (car p))
+ (walk (cdr p))))
(if (and (symbol? tree)
(not (memq tree syms)))
(set! syms (cons tree syms)))))
@@ -1173,12 +1169,11 @@
(env (var-env v))
(args (cons (var-name v) (args->proper-list (var-arglist v)))))
(let ((outvars (append (cadr (out-vars (var-name v) args body)) args)))
- (when (memq ftype '(define define* define-public))
- ;; in these cases, if v occurs in the body it's a recursive call
- ;; in lambda and lambda* it's a reference to some outer v
- (let ((fv (copy v)))
- (let-set! (cdr fv) 'side-effect #f)
- (set! env (cons fv env))))
+ ;; this should omit lambda and lambda* since reference to the name is a recursive call but
+ ;; then we get an inifinite loop remaking var-side-effect (a bug).
+ (let ((fv (copy v)))
+ (let-set! (cdr fv) 'side-effect #f)
+ (set! env (cons fv env)))
(lint-any? (lambda (f)
(side-effect-with-vars? f env outvars))
body))))))
@@ -1316,11 +1311,10 @@
(let ((iter (car args))
(res (cadr args)))
- (if (and (len>1? iter)
- (any-null? (cadr iter)))
- (begin
- (set! iter (cadr args))
- (set! res (car args))))
+ (when (and (len>1? iter)
+ (any-null? (cadr iter)))
+ (set! iter (cadr args))
+ (set! res (car args)))
(when (and (len=2? res)
(any-null? (cadr res))
@@ -1630,44 +1624,84 @@
(list 'lambda* new-arglist
new-body)))))))))))))))))
- (define (form->arity form)
- (and (pair? form)
- (let ((args (case (car form)
- ((lambda lambda*)
- (cadr form))
- ((define define* define-macro define-macro* define-bacro define-bacro* define-constant)
- (and (pair? (cadr form))
- (cdadr form)))
- ((let let* defmacro defmacro*)
- (caddr form))
- (else #f))))
- (and args
- (let ((has-rest (and (pair? args)
- (or (memq :rest args)
+ (define form->arity
+ (let ((max-arity 536870912))
+ (lambda (form)
+ ;; this ignores non-s7 keywords and the like (#!optional :: etc), treating them as parameter names
+ (and (pair? form)
+ (case (car form)
+ ((lambda)
+ (cond ((list? (cadr form))
+ (let ((len (length (cadr form))))
+ (if (negative? len)
+ (cons (abs len) max-arity)
+ (cons len len))))
+ ((symbol? (cadr form))
+ (cons 0 max-arity))
+ (else #f)))
+
+ ((define define-constant define-macro define-bacro)
+ (cond ((list? (cdadr form))
+ (let ((len (length (cdadr form))))
+ (if (negative? len)
+ (cons (abs len) 536870912)
+ (cons len len))))
+ ((symbol? (cdadr form))
+ (cons 0 max-arity))
+ (else #f)))
+
+ ((let) ; let = named let
+ (let ((len (length (caddr form))))
+ (cons len len)))
+
+ ((let*)
+ (cons 0 (length (caddr form))))
+
+ ((lambda*)
+ (let ((args (cadr form)))
+ (cond ((list? args)
+ (let ((len (length args))
+ (rest (or (memq :rest args)
(memq :allow-other-keys args))))
- (len (and (list? args)
- (do ((ln 0)
- (p args (cdr p)))
- ((not (pair? p))
- (if (null? p) ln (- ln)))
- (if (not (keyword? (car p)))
- (set! ln (+ ln 1))))))
- (mx (cdr (arity +))))
- (cond ((not len)
- (cons 0 mx))
- ((memq (car form) '(lambda* define-macro* define-bacro* define*))
- (cons 0 (if (and (>= len 0) (not has-rest)) len mx)))
- ((>= len 0)
- (cons len (if has-rest mx len)))
- (else (cons (abs len) mx))))))))
-
+ (cons 0 (if (or rest (negative? len))
+ max-arity
+ len))))
+ ((symbol? args)
+ (cons 0 max-arity))
+ (else #f))))
+
+ ((define* define-macro* define-bacro*)
+ (let ((args (cdadr form)))
+ (cond ((list? args)
+ (let ((len (length args))
+ (rest (or (memq :rest args)
+ (memq :allow-other-keys args))))
+ (cons 0 (if (or rest (negative? len))
+ max-arity
+ len))))
+ ((symbol? args)
+ (cons 0 max-arity))
+ (else #f))))
+
+ ((defmacro)
+ (cond ((list? (caddr form))
+ (let ((len (length (caddr form))))
+ (if (negative? len)
+ (cons (abs len) max-arity)
+ (cons len len))))
+ ((symbol? (caddr form))
+ (cons 0 max-arity))
+ (else #f)))
+
+ (else #f))))))
+
(define (report-shadower caller head vtype v expr env)
(when (symbol? v)
(if (var-member v env)
(lint-format "~A ~A ~A in ~S shadows an earlier declaration" caller head vtype v expr)
(if (defined? v (rootlet))
(lint-format "~A ~A ~A shadows built-in ~A" caller head vtype v v)))))
-
+
(define (make-fvar name ftype arglist initial-value env)
(unless (keyword? name)
(recursion->iteration name ftype arglist initial-value env))
@@ -1735,11 +1769,9 @@
(memq (var-ftype fd) '(define-macro define-macro* define-expansion
define-bacro define-bacro* defmacro defmacro* define-syntax))))))))
- (define (any-procedure? f env)
- (or (hash-table-ref built-in-functions f)
- (let ((v (var-member f env)))
- (and v
- (memq (var-ftype v) '(define define* lambda lambda*))))))
+ (define (any-procedure? f v env)
+ (or (and v (memq (var-ftype v) '(define define* lambda lambda*)))
+ (hash-table-ref built-in-functions f)))
(define ->simple-type
(let ((markers (list (cons :call/exit 'continuation?)
@@ -1749,10 +1781,9 @@
(lambda (c)
(case (type-of c)
((symbol?)
- (if (keyword? c)
+ (or (not (keyword? c))
(cond ((assq c markers) => cdr)
- (else 'keyword?))
- #t))
+ (else 'keyword?))))
((string?)
(if (byte-vector? c) 'byte-vector? 'string?))
((procedure?)
@@ -2048,13 +2079,12 @@
(not (var-member (car form) env)) ; e.g. exp declared locally as a list
(lint-every? (lambda (p) (just-constants? p env)) (cdr form)))))
-
(define (repeated-member? lst env)
(and (pair? lst)
- (or (and (not (and (pair? (car lst))
- (side-effect? (car lst) env)))
- (pair? (cdr lst))
- (member (car lst) (cdr lst)))
+ (or (and (pair? (cdr lst))
+ (member (car lst) (cdr lst))
+ (not (and (pair? (car lst))
+ (side-effect? (car lst) env))))
(repeated-member? (cdr lst) env))))
(define (update-scope v caller env)
@@ -2069,7 +2099,8 @@
(var-scope v))))))
(define check-for-bad-variable-name
- (let ((bad-var-names ()))
+ (let ((bad-var-names ())
+ (sname #f) (slen #f) (s0 #f))
(define (initialize-bad-var-names vars)
(set! bad-var-names ())
(for-each (lambda (n)
@@ -2089,70 +2120,69 @@
val))
(lambda (caller vname)
- (when (symbol? vname)
- (let* ((sname (symbol->string (if (keyword? vname) (keyword->symbol vname) vname)))
- (slen (length sname))
- (s0 (sname 0)))
-
- (if (> slen *report-ridiculous-variable-names*)
- (lint-format "the name ~A (~A chars!) is unreadable" caller vname slen))
-
- (if (or (cond ((assq s0 bad-var-names) =>
- (lambda (baddies)
- (or (assq vname (cdr baddies))
- (lint-any? (lambda (b)
- (and (eqv? (string-position (cadr b) sname) 0)
- (string->number (substring sname (caddr b)))))
- (cdr baddies)))))
- (else #f))
- (and (char=? s0 #\c)
- (> slen 8)
- (or (string=? "compute" (substring sname 0 7)) ; compute-* is as bad as get-*
- (string=? "calculate" (substring sname 0 9))))) ; perhaps one exception: computed-goto*
- (lint-format "surely there's a better name for this variable than ~A" caller vname)
-
- (if (eqv? (string-position "is-" sname) 0) ; is-x? -> x?
- (if (char=? (sname (- slen 1)) #\?)
- (lint-format "'~A is redundant: perhaps use '~A" caller vname (string->symbol (substring sname 3)))
- (lint-format "perhaps use '~A?, not '~A" caller (string->symbol (substring sname 3)) vname))
-
- (case s0
- ((#\@)
- (lint-format "the name ~A will be problematic in quasiquote" caller vname))
- ;; a check for other malformed numbers got no hits
-
- ((#\+)
- (if (memq vname '(+i +2i +0.i +1.0i +2.0i +2.i +3.141592653589793i))
- (lint-format "~A is not a number in s7" caller vname)))
-
- ((#\-)
- (if (memq vname '(-i -0.i -1.0i -2.0i -2i -3.141592653589793i -8.i -8i))
- (lint-format "~A is not a number in s7" caller vname)))
-
- ((#\|)
- (if (and *report-||-rewrites*
- (> slen 2)
- (eqv? (char-position #\| (substring sname 1)) (- slen 2))) ; starting at 1, so ends -2
- (lint-format "| is not a special character in s7, so ~A is not the symbol ~A" caller
- vname (substring sname 1 (- slen 1)))))))))))))
-
+ (set! sname (symbol->string vname)) ;(if (keyword? vname) (keyword->symbol vname) vname)))
+ (set! slen (length sname))
+ (set! s0 (sname 0))
+
+ (cond ((assq s0 bad-var-names) =>
+ (lambda (baddies)
+ (if (or (assq vname (cdr baddies))
+ (lint-any? (lambda (b)
+ (and (eqv? (string-position (cadr b) sname) 0)
+ (string->number (substring sname (caddr b)))))
+ (cdr baddies)))
+ (lint-format "surely there's a better name for this variable than ~A" caller vname)))))
+
+ (if (> slen *report-ridiculous-variable-names*)
+ (lint-format "the name ~A (~A chars!) is unreadable" caller vname slen)
+
+ (case s0
+ ((#\i)
+ (if (eqv? (string-position "is-" sname) 0) ; is-x? -> x?
+ (if (char=? (sname (- slen 1)) #\?)
+ (lint-format "'~A is redundant: perhaps use '~A" caller vname (string->symbol (substring sname 3)))
+ (lint-format "perhaps use '~A?, not '~A" caller (string->symbol (substring sname 3)) vname))))
+
+ ((#\c)
+ (if (and (> slen 8)
+ (or (string=? "compute" (substring sname 0 7)) ; compute-* is as bad as get-*
+ (string=? "calculate" (substring sname 0 9)))) ; perhaps one exception: computed-goto*
+ (lint-format "surely there's a better name for this variable than ~A" caller vname)))
+
+ ((#\@)
+ (lint-format "the name ~A will be problematic in quasiquote" caller vname))
+ ;; a check for other malformed numbers got no hits
+
+ ((#\+)
+ (if (memq vname '(+i +2i +0.i +1.0i +2.0i +2.i +3.141592653589793i))
+ (lint-format "~A is not a number in s7" caller vname)))
+
+ ((#\-)
+ (if (memq vname '(-i -0.i -1.0i -2.0i -2i -3.141592653589793i -8.i -8i))
+ (lint-format "~A is not a number in s7" caller vname)))
+
+ ((#\|)
+ (if (and *report-||-rewrites*
+ (> slen 2)
+ (eqv? (char-position #\| (substring sname 1)) (- slen 2))) ; starting at 1, so ends -2
+ (lint-format "| is not a special character in s7, so ~A is not the symbol ~A" caller
+ vname (substring sname 1 (- slen 1))))))))))
(define (set-ref name caller form env)
;; if name is in env, set its "I've been referenced" flag
- (when (symbol? name)
- (let ((data (var-member name env)))
- (if data
- (begin
- (set! (var-ref data) (+ (var-ref data) 1))
- (update-scope data caller env)
- (if (and form (not (memq form (var-history data))))
- (begin
- (set! (var-history data) (cons form (var-history data)))
- (set! (var-refenv data) env))))
- (if (not (defined? name (rootlet)))
- (let ((old (hash-table-ref other-identifiers name)))
- (check-for-bad-variable-name caller name)
- (hash-table-set! other-identifiers name (if old (cons form old) (list form))))))))
+ (let ((data (var-member name env)))
+ (if data
+ (begin
+ (set! (var-ref data) (+ (var-ref data) 1))
+ (update-scope data caller env)
+ (when (and form (not (memq form (var-history data))))
+ (set! (var-history data) (cons form (var-history data)))
+ (set! (var-refenv data) env)))
+ (if (and (symbol? name)
+ (not (defined? name (rootlet))))
+ (let ((old (hash-table-ref other-identifiers name)))
+ (check-for-bad-variable-name caller name)
+ (hash-table-set! other-identifiers name (cons form (or old ())))))))
env)
@@ -2163,10 +2193,9 @@
(update-scope data caller env)
(if (not (memq caller (var-setters data)))
(set! (var-setters data) (cons caller (var-setters data))))
- (if (not (memq form (var-history data)))
- (begin
- (set! (var-history data) (cons form (var-history data)))
- (set! (var-refenv data) env)))
+ (unless (memq form (var-history data))
+ (set! (var-history data) (cons form (var-history data)))
+ (set! (var-refenv data) env))
(set! (var-signature data) #f)
(set! (var-ftype data) #f))))
@@ -2179,14 +2208,12 @@
(if (pair? (cdr lst))
(proper-list (cdr lst))
(case (cdr lst) ((())) (else => list))))))
-
- (define (keywords lst)
- (do ((count 0)
- (p lst (cdr p)))
- ((null? p) count)
- (if (keyword? (car p))
- (set! count (+ count 1)))))
-
+
+ (define (keywords lst count)
+ (if (pair? lst)
+ (keywords (cdr lst) (if (keyword? (car lst)) (+ count 1) count))
+ count))
+
(define (eqv-selector clause)
(if (not (pair? clause))
(memq clause '(else #t))
@@ -2224,9 +2251,9 @@
(define (eqf selector env)
(cond ((symbol? selector)
- (if (and (not (var-member selector env))
- (or (hash-table-ref built-in-functions selector)
- (hash-table-ref syntaces selector)))
+ (if (and (or (hash-table-ref built-in-functions selector)
+ (hash-table-ref syntaces selector))
+ (not (var-member selector env)))
'(eq? eq?)
'(#t #t)))
@@ -2281,35 +2308,37 @@
(string-append (substring str 0 (min 60 (- len 1) (+ focus-len pos 20))) " ...")
(string-append "... " (substring str (- pos 20) (min (- len 1) (+ focus-len pos 20))) " ...")))))))
- (define (check-star-parameters f args env)
- (if (lint-any? (lambda (k) (memq k '(:key :optional))) args)
- (let ((kw (if (memq :key args) :key :optional)))
- (format outport "~NC~A: ~A is no longer accepted: ~A~%" lint-left-margin #\space f kw
- (focus-str (object->string args) (symbol->string kw)))))
-
- (if (member 'pi args (lambda (a b) (or (eq? b 'pi) (and (pair? b) (eq? (car b) 'pi)))))
- (format outport "~NC~A: parameter can't be a constant: ~A~%" lint-left-margin #\space f
- (focus-str (object->string args) "pi")))
-
- (let ((r (memq :rest args)))
- (when (pair? r)
- (if (not (pair? (cdr r)))
- (format outport "~NC~A: :rest parameter needs a name: ~A~%" lint-left-margin #\space f args)
- (if (pair? (cadr r))
- (format outport "~NC~A: :rest parameter can't specify a default value: ~A~%" lint-left-margin #\space f args)))))
-
- (let ((a (memq :allow-other-keys args)))
- (when (pair? a)
- (if (pair? (cdr a))
- (format outport "~NC~A: :allow-other-keys should be at the end of the parameter list: ~A~%" lint-left-margin #\space f
- (focus-str (object->string args) ":allow-other-keys")))
- (if (len=1? args)
- (format outport "~NC~A: :allow-other-keys can't be the only parameter: ~A~%" lint-left-margin #\space f args))))
-
- (for-each (lambda (p)
- (if (len>1? p)
- (lint-walk f (cadr p) env)))
- args))
+ (define check-star-parameters
+ (let ((pi-arg (lambda (a b) (or (eq? b 'pi) (and (pair? b) (eq? (car b) 'pi))))))
+ (lambda (f args env)
+ (if (lint-any? (lambda (k) (memq k '(:key :optional))) args)
+ (let ((kw (if (memq :key args) :key :optional)))
+ (format outport "~NC~A: ~A is no longer accepted: ~A~%" lint-left-margin #\space f kw
+ (focus-str (object->string args) (symbol->string kw)))))
+
+ (if (member 'pi args pi-arg)
+ (format outport "~NC~A: parameter can't be a constant: ~A~%" lint-left-margin #\space f
+ (focus-str (object->string args) "pi")))
+
+ (let ((r (memq :rest args)))
+ (when (pair? r)
+ (if (not (pair? (cdr r)))
+ (format outport "~NC~A: :rest parameter needs a name: ~A~%" lint-left-margin #\space f args)
+ (if (pair? (cadr r))
+ (format outport "~NC~A: :rest parameter can't specify a default value: ~A~%" lint-left-margin #\space f args)))))
+
+ (let ((a (memq :allow-other-keys args)))
+ (when (pair? a)
+ (if (pair? (cdr a))
+ (format outport "~NC~A: :allow-other-keys should be at the end of the parameter list: ~A~%" lint-left-margin #\space f
+ (focus-str (object->string args) ":allow-other-keys")))
+ (if (len=1? args)
+ (format outport "~NC~A: :allow-other-keys can't be the only parameter: ~A~%" lint-left-margin #\space f args))))
+
+ (for-each (lambda (p)
+ (if (len>1? p)
+ (lint-walk f (cadr p) env)))
+ args))))
(define (checked-eval form)
(and (proper-list? form) ;(not (infinite? (length form))) but when would a dotted list work?
@@ -2336,15 +2365,15 @@
(define last-and-incomplete-arg2 #f)
(define (and-incomplete form head arg1 arg2 env) ; head: 'and | 'or (not ...) | 'if | 'if2 -- symbol arg1 in any case
- (unless (memq (car arg2) '(and or not list cons vector)) ; these don't tell us anything about arg1's type
+ (unless (or (memq (car arg2) '(and or not list cons vector)) ; these don't tell us anything about arg1's type
+ (eq? arg2 last-and-incomplete-arg2))
(let ((v (var-member arg1 env))) ; try to avoid the member->cdr trope
- (unless (or (eq? arg2 last-and-incomplete-arg2)
- (and v
- (pair? (var-history v))
- (member #f (var-history v)
- (lambda (a b)
- (and (pair? b)
- (memq (car b) '(char-position string-position format string->number assoc assq assv memq memv member)))))))
+ (unless (and v
+ (pair? (var-history v))
+ (member #f (var-history v)
+ (lambda (a b)
+ (and (pair? b)
+ (memq (car b) '(char-position string-position format string->number assoc assq assv memq memv member))))))
(let* ((pos (do ((i 0 (+ i 1)) ; get arg number of arg1 in arg2
(p arg2 (cdr p))) ; 0th=car -> (and x (x))
((or (null? p)
@@ -3096,10 +3125,9 @@
(if (null? start)
(set! start p))
(begin
- (if (pair? start)
- (begin
- (set! new-form (cons (list 'not (cons new-head (collect-nots start p))) new-form))
- (set! start ())))
+ (when (pair? start)
+ (set! new-form (cons (list 'not (cons new-head (collect-nots start p))) new-form))
+ (set! start ()))
(set! new-form (cons c new-form)))))))
() () env))))))
@@ -3411,9 +3439,10 @@
((or (eq? val #t) ; #t or any non-#f constant in or ends the expression
(code-constant? val))
- (set! new-form (if (null? new-form) ; (or x1 123) -> value of x1 first
- (list val)
- (cons val new-form)))
+ (set! new-form (cons val ; (or x1 123) -> value of x1 first
+ (if (null? new-form)
+ ()
+ new-form)))
;; reversed when returned
(set! exprs '(#t)))
@@ -4903,10 +4932,9 @@
(cons y (collect-if-not-number val))))))))
(let ((first-arg (car args))
(nargs val))
- (if (member first-arg nargs)
- (begin
- (set! nargs (remove first-arg nargs)) ; remove once
- (set! first-arg 0)))
+ (when (member first-arg nargs)
+ (set! nargs (remove first-arg nargs)) ; remove once
+ (set! first-arg 0))
(cond ((null? nargs) first-arg) ; (- x 0 0 0)?
((eqv? first-arg 0)
@@ -6034,7 +6062,7 @@
(define (mv-range producer env)
(if (symbol? producer)
(let ((v (var-member producer env)))
- (and v
+ (and (pair? v)
(pair? ((cdr v) 'nvalues))
((cdr v) 'nvalues)))
(and (pair? producer)
@@ -7441,6 +7469,9 @@
(cond ((all-caps-warning arg)
(lint-format "There's no need to shout: ~A" caller (truncated-list->string form)))
+ ((not port)
+ (lint-format "~A could be ~A" caller form (cadr form)))
+
((not (len>1? arg)))
((and (eq? (car arg) 'format) ; (display (format #f str x)) -> (format () str x)
@@ -7456,16 +7487,18 @@
((and (pair? port)
(eq? (car port) 'current-output-port))
(lint-format "(current-output-port) is the default port for display: ~A" caller form))))))
-
+
(hash-special 'display sp-display))
;; ---------------- flush-output-port, newline, close-output-port ----------------
(let ()
(define (sp-flush-output-port caller head form env)
- (if (and (pair? (cdr form))
- (pair? (cadr form))
- (eq? (caadr form) 'current-output-port))
- (lint-format "(current-output-port) is the default port for ~A: ~A" caller head form)))
+ (when (pair? (cdr form))
+ (if (and (pair? (cadr form))
+ (eq? (caadr form) 'current-output-port))
+ (lint-format "(current-output-port) is the default port for ~A: ~A" caller head form)
+ (unless (cadr form)
+ (lint-format "~A is a no-op, returning ~A" caller form (if (eq? head 'flush-output-port) #f #<unspecified>))))))
(hash-special 'flush-output-port sp-flush-output-port)
(hash-special 'close-output-port sp-flush-output-port)
(hash-special 'newline sp-flush-output-port))
@@ -7474,10 +7507,12 @@
(let ()
(define (sp-write-char caller head form env)
(when (pair? (cdr form))
- (if (and (pair? (cddr form))
- (pair? (caddr form))
- (eq? (caaddr form) 'current-output-port))
- (lint-format "(current-output-port) is the default port for ~A: ~A" caller head form))
+ (when (pair? (cddr form))
+ (if (and (pair? (caddr form))
+ (eq? (caaddr form) 'current-output-port))
+ (lint-format "(current-output-port) is the default port for ~A: ~A" caller head form)
+ (if (not (caddr form))
+ (lint-format "~A could be ~A" caller form (cadr form)))))
(case head
((write-byte)
(if (and (integer? (cadr form))
@@ -7512,9 +7547,9 @@
;; ---------------- char-alphabetic? char-lower-case? char-numeric? char-upper-case? char-whitespace? etc ----------------
(let ()
(define (sp-char-numeric caller head form env)
- (if (and (not (var-member (car form) env))
- (len=1? (cdr form))
- (char? (cadr form)))
+ (if (and (len=1? (cdr form))
+ (char? (cadr form))
+ (not (var-member (car form) env)))
(lint-format "perhaps ~A" caller (lists->string form (eval/error caller form)))))
(for-each (lambda (c)
(hash-special c sp-char-numeric))
@@ -8115,13 +8150,12 @@
items)
lst))))
- (if (and (> len1 2)
- (null? (list-ref new-args (- len1 1)))
- (pair? (list-ref new-args (- len1 2)))
- (memq (car (list-ref new-args (- len1 2))) '(list cons append map string->list vector->list make-list)))
- (begin
- (set-cdr! (list-tail new-args (- len1 2)) ())
- (set! len1 (- len1 1))))
+ (when (and (> len1 2)
+ (null? (list-ref new-args (- len1 1)))
+ (pair? (list-ref new-args (- len1 2)))
+ (memq (car (list-ref new-args (- len1 2))) '(list cons append map string->list vector->list make-list)))
+ (set-cdr! (list-tail new-args (- len1 2)) ())
+ (set! len1 (- len1 1)))
(if (positive? len1)
(let ((last (list-ref new-args (- len1 1))))
@@ -8890,6 +8924,12 @@
(pair? arg1)
(eq? (return-type (car arg1) env) 'boolean?))
(set! expr arg1)))
+
+ (let ((t1 (->lint-type arg1)) ; (eq? (floor pi) 'a) -> #f
+ (t2 (->lint-type arg2)))
+ ;; ->lint-type -> #t if unknown
+ (when (not (compatible? t1 t2))
+ (set! expr #f)))
(if (not (eq? expr 'unset)) ; (eq? x '()) -> (null? x)
(lint-format "perhaps ~A" caller (lists->string form expr)))))))
@@ -8977,7 +9017,14 @@
(else ; (eqv? x 'a)
(lint-format "~A could be eq?~A in ~S" caller head
(if specific-op (format #f " or ~A" specific-op) "")
- form))))))
+ form)))
+
+ (let ((t1 (->lint-type arg1)) ; (eqv? (floor pi) 'a) -> #f
+ (t2 (->lint-type arg2)))
+ ;(format *stderr* "rtn: ~A ~A~%" t1 t2)
+ (when (not (compatible? t1 t2))
+ (lint-format "perhaps ~A -> #f" caller form)))
+ )))
;; very few hits:
;; (equal? (reverse em) '((0 -2 0) (0 -1 0) (1 -2 0) (1 -1 0)))
;; (equal? post-date (cons 0 0))
@@ -8988,12 +9035,21 @@
(let ()
(define (sp-morally-equal caller head form env)
- (if (and (= (length form) 3)
- (code-constant? (cadr form))
- (code-constant? (caddr form)))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (apply morally-equal? (cdr form))))))
+ (if (< (length form) 3)
+ (lint-format "~A needs 2 arguments: ~A" caller head (truncated-list->string form))
+ (if (= (length form) 3)
+ (let ((arg1 (cadr form))
+ (arg2 (caddr form)))
+ (if (and (code-constant? arg1)
+ (code-constant? arg2)) ; (morally-equal? 1 1) -> #t
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (apply morally-equal? (cdr form)))))
+ (let ((t1 (->lint-type arg1)) ; (morallly-equal? (floor pi) 'a) -> #f
+ (t2 (->lint-type arg2)))
+ (when (not (compatible? t1 t2))
+ (lint-format "perhaps ~A -> #f" caller form)))))))
+
(hash-special 'morally-equal? sp-morally-equal))
@@ -9694,7 +9750,7 @@
(let ((body (cddadr form)))
(when (and (pair? body)
(len=2? (car body))
- (memq (caar body) '(write display)))
+ (memq (caar body) '(write display))) ; write-char write-string never happen
(if (null? (cdr body))
(lint-format "perhaps ~A" caller
(lists->string form (cons 'object->string
@@ -10147,18 +10203,20 @@
""))))
(if (and (pair? op)
(member checker op any-compatible?))
- (if (and *report-sloppy-assoc*
- (not (var-member :catch env)) ; (round (char-position #\a "asb"))
- (or (not (pair? arg))
- (not (memq (car arg) '(int-vector-ref float-vector-ref)))))
- (lint-format "in ~A,~%~NC~A's argument ~Ashould be ~A, but ~A might also be ~A" caller
- (truncated-list->string form)
- (+ lint-left-margin 4) #\space
- head
- (prettify-arg-number arg-number)
- (prettify-checker-unq checker)
- (truncated-list->string arg)
- (car (remove-if (lambda (o) (any-compatible? checker o)) op))))
+ (unless (or (not *report-sloppy-assoc*)
+ (and (pair? arg)
+ (memq (car arg) '(int-vector-ref float-vector-ref system)))
+ (var-member :catch env)) ; (round (char-position #\a "asb"))
+ (let ((other (remove-if (lambda (o) (any-compatible? checker o)) op)))
+ (when (pair? other)
+ (lint-format "in ~A,~%~NC~A's argument ~Ashould be ~A, but ~A might also be ~A" caller
+ (truncated-list->string form)
+ (+ lint-left-margin 4) #\space
+ head
+ (prettify-arg-number arg-number)
+ (prettify-checker-unq checker)
+ (truncated-list->string arg)
+ (car other)))))
(lint-format "in ~A,~%~NC~A's argument ~Ashould be ~A, but ~A is ~A" caller
(truncated-list->string form)
(+ lint-left-margin 4) #\space
@@ -10168,105 +10226,104 @@
(truncated-list->string arg)
(prettify-checker op))))))))
- (lambda (caller head form checkers env max-arity)
- (when *report-func-as-arg-arity-mismatch*
- (let ((v (var-member head env)))
- (when (and v
- (memq (var-ftype v) '(define define* lambda lambda*))
- (zero? (var-set v)) ; perhaps this needs to wait for report-usage?
- (pair? (var-arglist v)))
- (let ((source (var-initial-value v)))
- (when (len>2? source)
- (let ((vhead (cddr source))
- (head-arglist (var-arglist v))
- (arg-number 1))
-
- (when (pair? vhead)
- (for-each
- (lambda (arg)
- ;; only check func if head is var-member and has procedure-source (var-[initial-]value?)
- ;; and arg has known arity, and check only if arg(par) is car, not (for example) cadr of apply
+ (lambda (caller head v form checkers env max-arity)
+ (when (and *report-func-as-arg-arity-mismatch*
+ v
+ (memq (var-ftype v) '(define define* lambda lambda*))
+ (zero? (var-set v)) ; perhaps this needs to wait for report-usage?
+ (pair? (var-arglist v)))
+ (let ((source (var-initial-value v)))
+ (when (len>2? source)
+ (let ((vhead (cddr source))
+ (head-arglist (var-arglist v))
+ (arg-number 1))
+
+ (when (pair? vhead)
+ (for-each
+ (lambda (arg)
+ ;; only check func if head is var-member and has procedure-source (var-[initial-]value?)
+ ;; and arg has known arity, and check only if arg(par) is car, not (for example) cadr of apply
+
+ (let ((ari (if (symbol? arg)
+ (arg-arity arg env)
+ (and (len>1? arg)
+ (eq? (car arg) 'lambda)
+ (let ((len (length (cadr arg))))
+ (and (integer? len)
+ (cons (abs len)
+ (if (negative? len) 500000 len)))))))
+ (par (and (> (length head-arglist) (- arg-number 1))
+ (list-ref head-arglist (- arg-number 1)))))
+ (when (and (symbol? par)
+ (pair? ari)
+ (or (> (car ari) 0)
+ (< (cdr ari) 20)))
- (let ((ari (if (symbol? arg)
- (arg-arity arg env)
- (and (len>1? arg)
- (eq? (car arg) 'lambda)
- (let ((len (length (cadr arg))))
- (and (integer? len)
- (cons (abs len)
- (if (negative? len) 500000 len)))))))
- (par (and (> (length head-arglist) (- arg-number 1))
- (list-ref head-arglist (- arg-number 1)))))
- (when (and (symbol? par)
- (pair? ari)
- (or (> (car ari) 0)
- (< (cdr ari) 20)))
-
- ;; fwalk below needs to be smart about tree walking so that
- ;; it does not confuse (c) in (lambda (c)...) with a call on the function c.
- ;; check only if current parameter name is not shadowed
-
- (let fwalk ((sym par) (tree vhead))
- (when (pair? tree)
- (if (eq? (car tree) sym)
- (let ((args (- (length tree) 1)))
- (if (> (car ari) args)
- (lint-format "~A's parameter ~A is passed ~A and called ~A, but ~A needs ~A argument~P" caller
+ ;; fwalk below needs to be smart about tree walking so that
+ ;; it does not confuse (c) in (lambda (c)...) with a call on the function c.
+ ;; check only if current parameter name is not shadowed
+
+ (let fwalk ((sym par) (tree vhead))
+ (when (pair? tree)
+ (if (eq? (car tree) sym)
+ (let ((args (- (length tree) 1)))
+ (if (> (car ari) args)
+ (lint-format "~A's parameter ~A is passed ~A and called ~A, but ~A needs ~A argument~P" caller
+ head par
+ (truncated-list->string arg)
+ (truncated-list->string tree)
+ (truncated-list->string arg)
+ (car ari) (car ari))
+ (if (> args (cdr ari))
+ (lint-format "~A's parameter ~A is passed ~A and called ~A, but ~A takes only ~A argument~P" caller
head par
(truncated-list->string arg)
(truncated-list->string tree)
(truncated-list->string arg)
- (car ari) (car ari))
- (if (> args (cdr ari))
- (lint-format "~A's parameter ~A is passed ~A and called ~A, but ~A takes only ~A argument~P" caller
- head par
- (truncated-list->string arg)
- (truncated-list->string tree)
- (truncated-list->string arg)
- (cdr ari) (cdr ari)))))
- (case (car tree)
- ((let let*)
- (if (len>1? (cdr tree))
- (let ((vs ((if (symbol? (cadr tree)) caddr cadr) tree)))
- (if (not (lint-any? (lambda (a) (or (not (pair? a)) (eq? sym (car a)))) vs))
- (fwalk sym ((if (symbol? (cadr tree)) cdddr cddr) tree))))))
-
- ((do letrec letrec*)
- (if (and (len>1? (cdr tree))
- (not (lint-any? (lambda (a) (or (not (pair? a)) (eq? sym (car a)))) (cadr tree))))
- (fwalk sym (cddr tree))))
-
- ((lambda lambda*)
- (if (and (len>1? (cdr tree))
- (not (lint-any? (lambda (a) (eq? sym a)) (args->proper-list (cadr tree)))))
- (fwalk sym (cddr tree))))
-
- ((define define-constant)
- (if (and (not (eq? sym (cadr tree)))
- (pair? (cadr tree))
- (not (lint-any? (lambda (a) (eq? sym a)) (args->proper-list (cdadr tree)))))
- (fwalk sym (cddr tree))))
-
- ((define* define-macro define-macro* define-expansion define-bacro define-bacro*)
- (if (and (len>1? (cdr tree))
- (pair? (cadr tree))
- (not (lint-any? (lambda (a) (eq? sym a)) (args->proper-list (cdadr tree)))))
- (fwalk sym (cddr tree))))
-
- ((quote) #f)
-
- ((case)
- (if (len>1? (cdr tree))
- (for-each (lambda (c) (fwalk sym (cdr c))) (cddr tree))))
-
- (else
- (if (pair? (car tree))
- (fwalk sym (car tree)))
- (if (pair? (cdr tree))
- (for-each (lambda (p) (fwalk sym p)) (cdr tree))))))))))
-
- (set! arg-number (+ arg-number 1)))
- (cdr form)))))))))
+ (cdr ari) (cdr ari)))))
+ (case (car tree)
+ ((let let*)
+ (if (len>1? (cdr tree))
+ (let ((vs ((if (symbol? (cadr tree)) caddr cadr) tree)))
+ (if (not (lint-any? (lambda (a) (or (not (pair? a)) (eq? sym (car a)))) vs))
+ (fwalk sym ((if (symbol? (cadr tree)) cdddr cddr) tree))))))
+
+ ((do letrec letrec*)
+ (if (and (len>1? (cdr tree))
+ (not (lint-any? (lambda (a) (or (not (pair? a)) (eq? sym (car a)))) (cadr tree))))
+ (fwalk sym (cddr tree))))
+
+ ((lambda lambda*)
+ (if (and (len>1? (cdr tree))
+ (not (lint-any? (lambda (a) (eq? sym a)) (args->proper-list (cadr tree)))))
+ (fwalk sym (cddr tree))))
+
+ ((define define-constant)
+ (if (and (not (eq? sym (cadr tree)))
+ (pair? (cadr tree))
+ (not (lint-any? (lambda (a) (eq? sym a)) (args->proper-list (cdadr tree)))))
+ (fwalk sym (cddr tree))))
+
+ ((define* define-macro define-macro* define-expansion define-bacro define-bacro*)
+ (if (and (len>1? (cdr tree))
+ (pair? (cadr tree))
+ (not (lint-any? (lambda (a) (eq? sym a)) (args->proper-list (cdadr tree)))))
+ (fwalk sym (cddr tree))))
+
+ ((quote) #f)
+
+ ((case)
+ (if (len>1? (cdr tree))
+ (for-each (lambda (c) (fwalk sym (cdr c))) (cddr tree))))
+
+ (else
+ (if (pair? (car tree))
+ (fwalk sym (car tree)))
+ (if (pair? (cdr tree))
+ (for-each (lambda (p) (fwalk sym p)) (cdr tree))))))))))
+
+ (set! arg-number (+ arg-number 1)))
+ (cdr form)))))))
(when (pair? checkers)
(let ((arg-number 1)
@@ -10462,11 +10519,9 @@
(else
(let ((op (return-type (car arg) env)))
(let ((v (var-member (car arg) env)))
- (if (and v
- (not (memq form (var-history v))))
- (begin
- (set! (var-history v) (cons form (var-history v)))
- (set! (var-refenv v) env))))
+ (when (and v (not (memq form (var-history v))))
+ (set! (var-history v) (cons form (var-history v)))
+ (set! (var-refenv v) env)))
;; checker is arg-type, op is expression type (can also be a pair)
(if (and (not (memq op '(#f #t values)))
@@ -10513,8 +10568,8 @@
(lambda (return)
(for-each (lambda (p)
(when (and (pair? p)
- (not (var-member (car p) env))
- (hash-table-ref changers (car p)))
+ (hash-table-ref changers (car p))
+ (not (var-member (car p) env)))
(if (pair? jumps)
(return (report-trouble)))
@@ -10609,7 +10664,7 @@
(lambda (caller head form env)
(let ((data (var-member head env)))
(if (and (len>1? (cdr form))
- (any-procedure? head env))
+ (any-procedure? head data env))
(check-unordered-exprs caller form (cdr form) env))
(if data
@@ -10645,7 +10700,7 @@
caller head
req (if (> req 1) "s" "")
(truncated-list->string form))))
- (if (> (- call-args (keywords (cdr form))) opt) ; multiple-values can make this worse, (values)=nothing doesn't apply here
+ (if (> (- call-args (keywords (cdr form) 0)) opt) ; multiple-values can make this worse, (values)=nothing doesn't apply here
(lint-format "~A has too many arguments: ~A" caller head (truncated-list->string form)))))
(unless (let-ref fdata 'allow-other-keys)
@@ -10678,7 +10733,7 @@
(set! rest (cdr rest))))
(cdr form))))
- (check-args caller head form (if (pair? sig) (cdr sig) ()) env opt)
+ (check-args caller head data form (if (pair? sig) (cdr sig) ()) env opt)
;; for a complete var-history, we could run through the args here even if no type info
;; also if var passed to macro -- what to do?
@@ -10761,7 +10816,7 @@
(if (> min-arity 1) "s" "")
(truncated-list->string form))
(if (and (not (procedure-setter head-value))
- (> (- args (keywords (cdr form))) max-arity))
+ (> (- args (keywords (cdr form) 0)) max-arity))
(lint-format "~A has too many arguments: ~A" caller head (truncated-list->string form))))
(when (and (procedure? head-value)
@@ -10809,7 +10864,7 @@
;; also (min (random x) (random x)) is not pointless
(truncated-list->string form)
(if (eq? head '=)
- (format #f ", perhaps use (not (nan? ~A))" (car (repeated-member? (cdr form) env)))
+ (format #f ", perhaps use (not (nan? ~A))" (cadr form)) ; len=3 above, so only cadr is possible
""))
(if (and (hash-table-ref repeated-args-table-2 head)
(repeated-member? (cdr form) env))
@@ -10832,7 +10887,7 @@
;; now try to check arg types
(let ((arg-data (cond ((procedure-signature head-value) => cdr) (else #f))))
(if (pair? arg-data)
- (check-args caller head form arg-data env max-arity))
+ (check-args caller head data form arg-data env max-arity))
))))))))))))))
(define (indirect-set? vname func arg1)
@@ -11021,7 +11076,8 @@
head)
otype vname))
- (else (check-for-bad-variable-name caller vname)))))
+ ((symbol? vname)
+ (check-for-bad-variable-name caller vname)))))
;; -------- wrappable-var
(define (wrappable-var caller local-var otype outer-form env)
@@ -11167,9 +11223,9 @@
(equal? writer (caddr outer-form))) ; all this is sloppy -- maybe not worth this effort
(lint-format "perhaps ~A" vname
(lists->string outer-form
- (cons 'object->string
+ (cons 'object->string
(if (eq? (car writer) 'display)
- (cons (cadr writer) #f)
+ (list (cadr writer) #f)
(list (cadr writer))))))))))))))))))
;; -------- reducible-scope
@@ -11665,7 +11721,6 @@
(if (> (length unused) 1) "are" "is")))))))))
pars)))))
-
;; -------- report-usage --------
(lambda (caller head vars env)
@@ -11788,18 +11843,17 @@
(call-with-exit
(lambda (return)
(let tree-call ((tree body))
- (if (unquoted-pair? tree)
- (begin
- (if (eq? (car tree) sym)
- (return tree))
- (if (memq (car tree) '(let let* letrec letrec* do lambda lambda* define))
- (return #f)) ; possible shadowing -- not worth the infinite effort to corroborate
- (if (pair? (car tree))
- (tree-call (car tree)))
- (if (pair? (cdr tree))
- (do ((p (cdr tree) (cdr p)))
- ((not (pair? p)) #f)
- (tree-call (car p))))))))))
+ (when (unquoted-pair? tree)
+ (if (eq? (car tree) sym)
+ (return tree))
+ (if (memq (car tree) '(let let* letrec letrec* do lambda lambda* define))
+ (return #f)) ; possible shadowing -- not worth the infinite effort to corroborate
+ (if (pair? (car tree))
+ (tree-call (car tree)))
+ (if (pair? (cdr tree))
+ (do ((p (cdr tree) (cdr p)))
+ ((not (pair? p)) #f)
+ (tree-call (car p)))))))))
(define (check-returns caller f env) ; f is not the last form in the body
@@ -12804,10 +12858,9 @@
(lambda (done)
(for-each
(lambda (d)
- (if (not (equal? (write-port d) op))
- (begin
- (lint-format "unexpected port change: ~A -> ~A in ~A" caller op (write-port d) d) ; ??
- (done)))
+ (unless (equal? (write-port d) op)
+ (lint-format "unexpected port change: ~A -> ~A in ~A" caller op (write-port d) d) ; ??
+ (done))
(list-set! exprs dctr d)
(set! dctr (+ dctr 1))
(gather-format (display->format d))
@@ -12877,8 +12930,9 @@
(ctr 0 (+ ctr 1)))
((not (pair? fs)))
(let ((f (car fs)))
-
(when (len>1? f)
+
+ ;; successive combinable conds/cases/dos are tricky and rare
(when (and *report-shadowed-variables*
(eq? (car f) 'define))
(check-shadows caller head f env))
@@ -13114,28 +13168,33 @@
;; and not named-let (can this happen?) and only this expr in body)
;; currently called only in let-walker, but might make sense in let*-walker and letrec-walker.
;; in letrec-walker it got only 1 hit.
-
+
(when (and (pair? lint-function-body) ; (let ((v 3)) v)?
(eq? form (car lint-function-body))
(symbol? lint-function-name)
- (pair? form) ; this is (car lint-function-body)
+ (pair? form) ; this is (car lint-function-body)
(null? (cdr lint-function-body))
- (not (tree-set-memq definers (cdr form))))
+ ;(not (tree-set-memq definers (cdr form)))
+ )
(for-each
(lambda (local-var)
(let ((vname (var-name local-var))
(vvalue (var-initial-value local-var)))
(when (and (zero? (var-set local-var))
(not (eq? (var-definer local-var) 'parameter))
- (constant-expression? vvalue env)
- (lint-every? (lambda (p)
- (not (and (pair? p)
- (or (memq (car p) '(vector-set! float-vector-set! int-vector-set!
- string-set! list-set! hash-table-set! let-set!
- set-car! set-cdr!))
- (set!? p env))
- (eq? vname (cadr p)))))
- (var-history local-var)))
+ (or (constant-expression? vvalue env)
+ (and (pair? vvalue)
+ (memq (car vvalue) '(list vector float-vector int-vector byte-vector))
+ (not (lint-any? (lambda (x) (and (pair? x) (not (eq? (car x) 'quote)))) (cdr vvalue)))))
+ (not (lint-any? (lambda (p)
+ (and (pair? p)
+ (or (memq (car p) '(vector-set! float-vector-set! int-vector-set!
+ string-set! list-set! hash-table-set! let-set!
+ set-car! set-cdr!))
+ ;; maybe check for anything ending in ! here
+ (set!? p env))
+ (eq? vname (cadr p))))
+ (var-history local-var))))
(lint-format "~A can ~Abe moved to ~A's closure" lint-function-name
vname
(if (lint-any? (lambda (p)
@@ -13148,8 +13207,7 @@
(memq lint-function-name '(let let* letrec))))
lint-function-name
"the enclosing function")))))
- vars)
- (set! lint-function-name #f)))
+ vars)))
(define (report-doc-string definer function-name args body)
(lint-format "old-style doc string: ~S, in s7 use 'documentation:~%~NC~A" function-name
@@ -13196,10 +13254,9 @@
(symbol? (var-ftype v)))
(set! (var-retcons v) #t)))))
- (set! lint-function-body (and (not (eq? definer 'definstrument)) body))
- (set! lint-function-name (and (null? (cdr body)) function-name))
-
- (lint-walk-body function-name definer body env))
+ (let-temporarily ((lint-function-body (and (not (eq? definer 'definstrument)) body))
+ (lint-function-name (and (null? (cdr body)) function-name)))
+ (lint-walk-body function-name definer body env)))
(define (lint-walk-function definer function-name args body form env)
;; check out function arguments (adding them to the current env), then walk its body
@@ -13601,10 +13658,9 @@
(not (equal? (car q) (car f))))
(set! trailer-len k))))
- (if (= result-min-len header-len)
- (begin
- (set! header-len (- header-len 1))
- (set! trailer-len 0)))
+ (when (= result-min-len header-len)
+ (set! header-len (- header-len 1))
+ (set! trailer-len 0))
(if (<= result-min-len (+ header-len trailer-len))
(set! trailer-len (- result-min-len header-len 1)))
@@ -13683,10 +13739,10 @@
(or (symbol? (cadr form))
(and (pair? (cddr form))
(symbol? (caddr form))))
- (not (var-member (car form) env))
(not (hash-table-ref built-in-functions (car form)))
(let ((str (symbol->string (car form))))
- (char=? (string-ref str (- (length str) 1)) #\!))))
+ (char=? (string-ref str (- (length str) 1)) #\!))
+ (not (var-member (car form) env))))
(define (set-target name form env)
(and (pair? form)
@@ -13715,7 +13771,10 @@
(lint-format "~A is one of its many names, but pi is a predefined constant in s7" caller (caddr form)))
((constant? sym) ; (define most-positive-fixnum 432)
- (lint-format "~A is a constant in s7: ~A" caller sym form))
+ (if (memq sym '(pi most-positive-fixnum most-negative-fixnum nan.0 -nan.0 inf.0 -inf.0
+ *unbound-variable-hook* *missing-close-paren-hook* *read-error-hook*
+ *load-hook* *error-hook* *rootlet-redefinition-hook*))
+ (lint-format "~A is a constant in s7: ~A" caller sym form)))
((eq? sym 'quote)
(lint-format "either a stray quote, or a really bad idea: ~A" caller (truncated-list->string form)))
@@ -14717,12 +14776,12 @@
;; move-if-inward
(when (and (pair? true)
(pair? false)
+ (pair? true-rest)
(not (memq true-op '(quote list-values not)))
(not (any-macro? true-op env))
(or (not (hash-table-ref syntaces true-op))
- (memq true-op '(let let* set! and or begin)))
- (pair? true-rest))
-
+ (memq true-op '(let let* set! and or begin))))
+
(define (tree-subst-eq new old tree)
;; tree-subst above substitutes every occurence of 'old with 'new, so we check
;; in advance that 'old only occurs once in the tree (via tree-count). Here
@@ -14736,6 +14795,25 @@
(copy-tree tree))
(else (cons (tree-subst-eq new old (car tree))
(tree-subst-eq new old (cdr tree))))))
+
+ (when (and (case true-op ; (if old (list form) (cons form old)) -> (cons form (if old () old)) etc
+ ((list) (eq? false-op 'cons))
+ ((cons) (eq? false-op 'list))
+ (else #f))
+ (pair? true-rest)
+ (pair? false-rest)
+ (equal? (car true-rest) (car false-rest)))
+ (if (eq? true-op 'list)
+ (if (null? (cdr true-rest))
+ (begin
+ (set! true `(cons ,(car true-rest) ()))
+ (set! true-op 'cons)
+ (set! true-rest (list (car true-rest) ()))))
+ (if (null? (cdr false-rest))
+ (begin
+ (set! false `(cons ,(car false-rest) ()))
+ (set! false-op 'cons)
+ (set! false-rest (list (car false-rest) ()))))))
;; maybe move the unless before this
;; reversible ops here got no real hits (test case junk)
@@ -17140,7 +17218,6 @@
(exprs-repeated #f)
(else-foldable #f)
(has-else #f))
-
(let ((all-exprs ())
(ctr 0)
(len (length (cddr form))))
@@ -17210,7 +17287,8 @@
(set! all-keys (cons key all-keys)))
;; unintentional quote here, as in (case x ('a b)...) never happens and
;; is hard to distinguish from (case x ((quote a) b)...) which happens a lot
- (if (not (compatible? sel-type (->lint-type key)))
+
+ (if (not (compatible? sel-type (if (symbol? key) 'symbol? (->lint-type key))))
;; (case (string->symbol x) ((a) 1) ((2 3) 3))
(lint-format "case key ~S in ~S is pointless" caller key clause)))
keys))
@@ -18011,11 +18089,11 @@
h)))
(lambda (form)
(and (pair? form)
- (not (eq? (car form) 'quote))
(or (hash-table-ref udefiners (car form))
(and (pair? (car form))
(unsafe-definer? (car form))) ; unfortunate -- perhaps member below?
(case (car form)
+ ((quote) #f)
((map for-each any? every? call-with-exit call-with-output-string with-output-to-string =>) ; skip lambda in cadr
(and (len>1? (cdr form))
(or (unsafe-definer? (cddr form))
@@ -18044,7 +18122,8 @@
(unsafe-definer? (cdaddr form)))
(and (len>1? (cadddr form))
(unsafe-definer? (cdr (cadddr form)))))))
- (else (unsafe-definer? (cdr form)))))))))
+ (else
+ (unsafe-definer? (cdr form)))))))))
;; -------- walk-letx-body --------
(define (walk-letx-body caller form body vars env)
@@ -18611,109 +18690,111 @@
(lists->string form (tree-subst new-call call body)))))))))))))
;; -------- combine-lets --------
- (define (combine-lets caller form varlist env)
- (when (and (pair? (cadr form))
- (len=1? (cddr form))
- (pair? (caddr form)))
- (let ((inner (caddr form)) ; the inner let
- (outer-vars (cadr form)))
-
- (when (len>1? (cdr inner))
- (let ((inner-vars (cadr inner)))
- (when (and (eq? (car inner) 'let)
- (symbol? inner-vars))
- (let ((named-body (cdddr inner))
- (named-args (caddr inner)))
- (unless (lint-any? (lambda (v)
- (or (not (= (tree-count (car v) named-args 2) 1))
- (tree-memq (car v) named-body)))
- varlist)
- (let ((new-args (copy named-args)))
- (for-each (lambda (v)
- (set! new-args (tree-subst (cadr v) (car v) new-args)))
- varlist)
- ;; (let ((x 1) (y (f g 2))) (let loop ((a (+ x 1)) (b y)) (loop a b))) -> (let loop ((a (+ 1 1)) (b (f g 2))) (loop a b))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (cons 'let
- (cons inner-vars
- (cons new-args named-body)))))))))
+ (define combine-lets
+ (let ()
+ (define (letstar env . lets)
+ (let loop ((vars (list 'curlet)) (forms lets))
+ (and (pair? forms)
+ (or (and (pair? (car forms))
+ (or (tree-set-memq vars (car forms))
+ (lint-any? (lambda (a)
+ (or (not (pair? a))
+ (not (pair? (cdr a)))
+ (side-effect? (cadr a) env)))
+ (car forms))))
+ (loop (append (map car (car forms)) vars)
+ (cdr forms))))))
+
+ (lambda (caller form varlist env)
+ (when (and (pair? (cadr form))
+ (len=1? (cddr form))
+ (pair? (caddr form)))
+ (let ((inner (caddr form)) ; the inner let
+ (outer-vars (cadr form)))
- ;; maybe more code than this is worth -- combine lets
- (when (and (memq (car inner) '(let let*))
- (pair? inner-vars))
-
- (define (letstar . lets)
- (let loop ((vars (list 'curlet)) (forms lets))
- (and (pair? forms)
- (or (and (pair? (car forms))
- (or (tree-set-memq vars (car forms))
- (lint-any? (lambda (a)
- (or (not (pair? a))
- (not (pair? (cdr a)))
- (side-effect? (cadr a) env)))
- (car forms))))
- (loop (append (map car (car forms)) vars)
- (cdr forms))))))
-
- (cond ((and (null? (cdadr form)) ; let(1) + let* -> let*
- (eq? (car inner) 'let*)
- (not (symbol? inner-vars))) ; not named let*
- ;; (let ((a 1)) (let* ((b (+ a 1)) (c (* b 2))) (display (+ a b c)))) -> (let* ((a 1) (b (+ a 1)) (c (* b 2))) (display (+ a b c)))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (cons 'let*
- (cons (append outer-vars inner-vars)
- (one-call-and-dots (cddr inner)))))))
- ((and (len=1? (cddr inner))
- (len>1? (caddr inner))
- (eq? (caaddr inner) 'let)
- (pair? (cadr (caddr inner))))
- (let* ((inner1 (cdaddr inner))
- (inner1-vars (car inner1)))
- (if (and (len=1? (cdr inner1))
- (len>1? (cadr inner1))
- (eq? (caadr inner1) 'let)
- (pair? (cadadr inner1)))
- (let* ((inner2 (cdadr inner1))
- (inner2-vars (car inner2)))
- (if (not (letstar outer-vars
- inner-vars
- inner1-vars
- inner2-vars))
- ;; (let ((a 1)) (let ((b 2)) (let ((c 3)) (let ((d 4)) (+ a b c d))))) -> (let ((a 1) (b 2) (c 3) (d 4)) (+ a b c d))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (cons 'let
- (cons (append outer-vars inner-vars inner1-vars inner2-vars)
- (one-call-and-dots (cdr inner2))))))))
- (if (not (letstar outer-vars
- inner-vars
- inner1-vars))
- ;; (let ((b 2)) (let ((c 3)) (let ((d 4)) (+ a b c d)))) -> (let ((b 2) (c 3) (d 4)) (+ a b c d))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (cons 'let
- (cons (append outer-vars inner-vars inner1-vars)
- (one-call-and-dots (cdr inner1))))))))))
- ((not (letstar outer-vars
- inner-vars))
- ;; (let ((c 3)) (let ((d 4)) (+ a b c d))) -> (let ((c 3) (d 4)) (+ a b c d))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (cons 'let
- (cons (append outer-vars inner-vars)
- (one-call-and-dots (cddr inner)))))))
-
- ((and (null? (cdadr form)) ; 1 outer var
- (pair? inner-vars)
- (null? (cdadr inner))) ; 1 inner var, dependent on outer
- ;; (let ((x 0)) (let ((y (g 0))) (+ x y))) -> (let* ((x 0) (y (g 0))) (+ x y))
- (lint-format "perhaps ~A" caller
- (lists->string form
- (cons 'let*
- (cons (append outer-vars inner-vars)
- (one-call-and-dots (cddr inner))))))))))))))
+ (when (len>1? (cdr inner))
+ (let ((inner-vars (cadr inner)))
+ (when (and (eq? (car inner) 'let)
+ (symbol? inner-vars))
+ (let ((named-body (cdddr inner))
+ (named-args (caddr inner)))
+ (unless (lint-any? (lambda (v)
+ (or (not (= (tree-count (car v) named-args 2) 1))
+ (tree-memq (car v) named-body)))
+ varlist)
+ (let ((new-args (copy named-args)))
+ (for-each (lambda (v)
+ (set! new-args (tree-subst (cadr v) (car v) new-args)))
+ varlist)
+ ;; (let ((x 1) (y (f g 2))) (let loop ((a (+ x 1)) (b y)) (loop a b))) -> (let loop ((a (+ 1 1)) (b (f g 2))) (loop a b))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (cons 'let
+ (cons inner-vars
+ (cons new-args named-body)))))))))
+
+ ;; maybe more code than this is worth -- combine lets
+ (when (and (memq (car inner) '(let let*))
+ (pair? inner-vars))
+
+ (cond ((and (null? (cdadr form)) ; let(1) + let* -> let*
+ (eq? (car inner) 'let*)
+ (not (symbol? inner-vars))) ; not named let*
+ ;; (let ((a 1)) (let* ((b (+ a 1)) (c (* b 2))) (display (+ a b c)))) -> (let* ((a 1) (b (+ a 1)) (c (* b 2))) (display (+ a b c)))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (cons 'let*
+ (cons (append outer-vars inner-vars)
+ (one-call-and-dots (cddr inner)))))))
+ ((and (len=1? (cddr inner))
+ (len>1? (caddr inner))
+ (eq? (caaddr inner) 'let)
+ (pair? (cadr (caddr inner))))
+ (let* ((inner1 (cdaddr inner))
+ (inner1-vars (car inner1)))
+ (if (and (len=1? (cdr inner1))
+ (len>1? (cadr inner1))
+ (eq? (caadr inner1) 'let)
+ (pair? (cadadr inner1)))
+ (let* ((inner2 (cdadr inner1))
+ (inner2-vars (car inner2)))
+ (if (not (letstar env outer-vars
+ inner-vars
+ inner1-vars
+ inner2-vars))
+ ;; (let ((a 1)) (let ((b 2)) (let ((c 3)) (let ((d 4)) (+ a b c d))))) -> (let ((a 1) (b 2) (c 3) (d 4)) (+ a b c d))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (cons 'let
+ (cons (append outer-vars inner-vars inner1-vars inner2-vars)
+ (one-call-and-dots (cdr inner2))))))))
+ (if (not (letstar env outer-vars
+ inner-vars
+ inner1-vars))
+ ;; (let ((b 2)) (let ((c 3)) (let ((d 4)) (+ a b c d)))) -> (let ((b 2) (c 3) (d 4)) (+ a b c d))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (cons 'let
+ (cons (append outer-vars inner-vars inner1-vars)
+ (one-call-and-dots (cdr inner1))))))))))
+ ((not (letstar env outer-vars
+ inner-vars))
+ ;; (let ((c 3)) (let ((d 4)) (+ a b c d))) -> (let ((c 3) (d 4)) (+ a b c d))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (cons 'let
+ (cons (append outer-vars inner-vars)
+ (one-call-and-dots (cddr inner)))))))
+
+ ((and (null? (cdadr form)) ; 1 outer var
+ (pair? inner-vars)
+ (null? (cdadr inner))) ; 1 inner var, dependent on outer
+ ;; (let ((x 0)) (let ((y (g 0))) (+ x y))) -> (let* ((x 0) (y (g 0))) (+ x y))
+ (lint-format "perhaps ~A" caller
+ (lists->string form
+ (cons 'let*
+ (cons (append outer-vars inner-vars)
+ (one-call-and-dots (cddr inner))))))))))))))))
;; -------- tighten-let --------
(define (tighten-let caller form vars env)
@@ -18806,9 +18887,7 @@
(not (lint-any? (lambda (ov) ; watch out for shadowed vars
(tree-memq (car ov) expr))
varlist))))
- (set! mnv (if (= (v 2) cur-end)
- (cons v mnv)
- (list v)))
+ (set! mnv (cons v (if (= (v 2) cur-end) mnv ())))
(set! cur-end (v 2))))
last-refs)
@@ -18919,7 +18998,7 @@
(when (and (< (length varlist) 8)
(not (or (memq (caar body) '(lambda lambda* define define* define-macro))
(and (eq? (caar body) 'set!)
- (lint-any? (lambda (v) (and (eq? (car v) (cadar body)))) varlist))
+ (lint-any? (lambda (v) (eq? (car v) (cadar body))) varlist))
(any-macro? (caar body) env)
(lint-any? (lambda (p)
(and (unquoted-pair? p)
@@ -19059,17 +19138,17 @@
(when (and (null? next-args) ; (let ((x (+ y 1))) (abs x)) -> (abs (+ y 1))
(eq? vname first-arg)) ; not tree-subst or trailing (pair) args: the let might be forcing evaluation order
- (let ((v (var-member (car p) env)))
- (if (or (and v
- (memq (var-ftype v) '(define define* lambda lambda*))) ; was definer??
- (hash-table-ref built-in-functions (car p)))
- (lint-format "perhaps ~A" caller (lists->string form
- (wrap-new-form header (list (car p) vvalue) trailer)))
- (if (not (or (any-macro? vname env)
- (tree-unquoted-member vname (car p))))
- (lint-format "perhaps, assuming ~A is not a macro, ~A" caller (car p)
- (lists->string form
- (wrap-new-form header (list (car p) vvalue) trailer)))))))
+
+ (if (or (hash-table-ref built-in-functions (car p))
+ (let ((v (var-member (car p) env)))
+ (and v (memq (var-ftype v) '(define define* lambda lambda*))))) ; was definer??
+ (lint-format "perhaps ~A" caller (lists->string form
+ (wrap-new-form header (list (car p) vvalue) trailer)))
+ (if (not (or (any-macro? vname env)
+ (tree-unquoted-member vname (car p))))
+ (lint-format "perhaps, assuming ~A is not a macro, ~A" caller (car p)
+ (lists->string form
+ (wrap-new-form header (list (car p) vvalue) trailer))))))
(when (pair? next-args)
(when (and (eq? (car p) 'if)
(pair? (cdr next-args)))
@@ -20837,355 +20916,349 @@
func-name func-name vname))))))
(vector-set! old 2 (cons func (vector-ref old 2))))))))))
- (define (reduce-tree new-form env fvar orig-form)
- (let ((leaves (tree-leaves new-form)))
- (when (< *fragment-min-size* leaves *fragment-max-size*)
- (call-with-exit
- (lambda (quit)
- (let ((outer-vars (if fvar
- (do ((e (list (list (var-name fvar) (symbol "_F_") 0 ())))
- (i 1 (+ i 1))
- (args (args->proper-list (var-arglist fvar)) (cdr args)))
- ((not (pair? args)) e)
- (set! e (cons (list (car args) (symbol "_" (number->string i) "_") i ()) e)))
- (list (list () '_1_) (list () '_2_) (list () '_3_) (list () '_4_))))
- (local-ctr 0))
- (let ((line (pair-line-number orig-form))
- (reduced-form
- (let walker ((tree new-form) (vars outer-vars))
- (cond ((pair? tree)
- (case (car tree)
- ((quote)
- tree)
-
- ((let let*)
- ;; in let we need to sort locals by order of appearance in the body
- (if (<= (length tree) 2)
- (quit))
- (let ((locals ())
- (body ())
- (named-let (symbol? (cadr tree)))
- (lvars ()))
- (if named-let
- (begin
- (set! lvars (cons (list (cadr tree) (symbol "_NL" (number->string local-ctr) "_") -1) lvars))
- (set! local-ctr (+ local-ctr 1))
- (set! locals (caddr tree))
- (set! body (cdddr tree)))
- (begin
- (set! locals (cadr tree))
- (set! body (cddr tree))))
- (if (not (list? locals)) (quit))
-
- (let ((func (if (eq? (car tree) 'let)
- (lambda (local)
- (if (not (len>1? local)) (quit))
- (set! lvars (cons (list (car local) () 0 (walker (cadr local) vars)) lvars)))
- (lambda (local)
- (if (not (len>1? local)) (quit))
- (set! lvars (cons (list (car local)
- (symbol "_L" (number->string local-ctr) "_")
- local-ctr
- (walker (cadr local) (append lvars vars)))
- lvars))
- (set! local-ctr (+ local-ctr 1))))))
- (for-each func locals))
-
- ;; now walk the body, setting the reduced local name by order of encounter (in let, not let*)
- (let ((new-body (walker body (append lvars vars))))
- (unless (pair? new-body) (set! new-body (list new-body)))
- (when (and (eq? (car tree) 'let)
- ;; fill-in unused-var dummy names etc
- (pair? lvars))
- (for-each (lambda (v)
- (when (null? (cadr v))
- (list-set! v 1 (symbol "_L" (number->string local-ctr) "_"))
- (list-set! v 2 local-ctr)
- (set! local-ctr (+ local-ctr 1))))
- lvars))
- (set! lvars (sort! lvars (lambda (a b) (< (caddr a) (caddr b)))))
-
- (if named-let
- `(,(car tree) ,(cadr (assq (cadr tree) lvars))
- ,(map (lambda (v) (list (cadr v) (cadddr v))) (cdr lvars))
- ,@new-body)
- `(,(car tree)
- ,(map (lambda (v) (list (cadr v) (cadddr v))) lvars)
- ,@new-body)))))
-
- ((letrec letrec*)
- (if (not (pair? (cdr tree))) (quit))
- (let ((locals (cadr tree))
- (body (cddr tree))
- (lvars ()))
- (if (not (and (list? locals) (pair? body))) (quit))
- (for-each (lambda (local)
- (if (not (len>1? local))
- (quit))
- (set! lvars (cons (list (car local)
- (symbol "_L" (number->string local-ctr) "_")
- local-ctr ())
- lvars))
- (set! local-ctr (+ local-ctr 1)))
- locals)
- (for-each (lambda (local lv)
- (list-set! lv 3 (walker (cadr local) lvars)))
- locals lvars)
- (cons (car tree)
- (cons (map (lambda (v) (list (cadr v) (cadddr v))) lvars)
- (walker body (append lvars vars))))))
-
- ((do)
- (if (not (and (len>1? (cdr tree))
- (list? (cadr tree))
- (list? (cdddr tree))))
- (quit))
- (let ((locals (cadr tree))
- (end+result (caddr tree))
- (body (cdddr tree))
- (lvars ()))
- (if (not (and (list? end+result)
- (proper-list? body)))
- (quit))
- (for-each (lambda (local)
- (if (not (len>1? local))
- (quit))
- (set! lvars (cons (list (car local)
- () 0
- (walker (cadr local) vars)
- (if (pair? (cddr local))
- (caddr local)
- :unset))
- lvars)))
- locals)
- (let ((new-env (append lvars vars)))
- (let ((new-end (walker end+result new-env))
- (new-body (walker body new-env)))
- (unless (pair? new-body)
- (set! new-body (list new-body)))
- (when (pair? lvars)
- (for-each (lambda (lv)
- (if (not (eq? (lv 4) :unset))
- (list-set! lv 4 (walker (lv 4) new-env))))
- lvars)
- (for-each (lambda (v)
- (when (null? (cadr v))
- (list-set! v 1 (symbol "_L" (number->string local-ctr) "_"))
- (list-set! v 2 local-ctr)
- (set! local-ctr (+ local-ctr 1))))
- lvars)
- (set! lvars (sort! lvars (lambda (a b) (< (caddr a) (caddr b))))))
-
- `(do ,(map (lambda (v)
- (map v (if (eq? (v 4) :unset) '(1 3) '(1 3 4))))
- lvars)
- ,new-end
- ,@new-body)))))
-
- ((lambda)
- (if (not (proper-pair? (cdr tree)))
- (quit))
- (let* ((lvars (map (lambda (a)
- (let ((res (list a (symbol "_A" (number->string local-ctr) "_") local-ctr)))
- (set! local-ctr (+ local-ctr 1))
- res))
- (let ((args (args->proper-list (cadr tree))))
- (if (pair? args) args (quit)))))
- (new-body (let ((new-vars (append lvars vars)))
- (map (lambda (p) (walker p new-vars)) (cddr tree))))
- (new-args (if (symbol? (cadr tree))
- (cadar lvars)
- (if (proper-list? (cadr tree))
- (map cadr lvars)
- (let ((lst (map cadr lvars)))
- (append (copy lst (make-list (- (length lst) 1)))
- (last-ref lst)))))))
- (cons 'lambda (cons new-args new-body))))
-
- ((lambda*)
- (if (not (and (proper-pair? (cdr tree))
- (or (symbol? (cadr tree))
- (proper-list? (cadr tree)))))
- (quit))
- (let ((old-args (args->proper-list (cadr tree))))
- (if (or (not (pair? old-args))
- (lint-every? keyword? old-args)) ; (:allow-other-keys)
- (quit))
- (let* ((lvars (map (lambda (a)
- (if (memq a '(:rest :allow-other-keys))
- (values)
- (let ((res (list (if (pair? a) (car a) a)
- (symbol "_A" (number->string local-ctr) "_") local-ctr)))
- (set! local-ctr (+ local-ctr 1))
- res)))
- old-args))
- (new-body (let ((new-vars (append lvars vars)))
- (map (lambda (p) (walker p new-vars)) (cddr tree))))
- (new-args (if (symbol? (cadr tree))
- (cadar lvars)
- (map (lambda (a)
- (cond ((keyword? a) a)
- ((symbol? a) (cadr (assq a lvars)))
- ((len>1? a)
- (list (assq a lvars) (cadr a)))
- (else (quit))))
- (cadr tree)))))
- (cons 'lambda* (cons new-args new-body)))))
-
- ((case)
- (if (not (and (len>1? (cdr tree))
- (pair? (caddr tree))))
- (quit))
- (list 'case
- (walker (cadr tree) vars)
- (map (lambda (c)
- (if (not (len>1? c))
- (quit))
- (cons (car c)
- (map (lambda (p) (walker p vars)) (cdr c))))
- (cddr tree))))
-
- ((if)
- (if (not (and (len>1? (cdr tree))
- (list? (cdddr tree))))
- (quit))
- (let ((expr (walker (cadr tree) vars))
- (true (walker (caddr tree) vars)))
- (if (null? (cdddr tree))
- (if (and (len>1? expr)
- (eq? (car expr) 'not))
- (cons 'unless (cons (cadr expr) (unbegin true)))
- (cons 'when (cons expr (unbegin true))))
- (list 'if expr true (walker (cadddr tree) vars)))))
-
- ((when unless)
- (if (not (len>1? (cdr tree)))
- (quit))
- (cons (car tree)
- (cons (walker (cadr tree) vars)
- (map (lambda (p) (walker p vars)) (cddr tree)))))
-
- ((set!)
- (if (not (len>1? (cdr tree))) (quit))
- (if (symbol? (cadr tree))
- (let ((v (assq (cadr tree) vars)))
- (if (or (not v) ; if not a var, it's about to be an outer-var
- (and (not fvar)
- (memq (cadr v) '(_1_ _2_ _3_ _4_))))
- (quit))
- (when (null? (cadr v)) ; must be a previously unencountered local
- (list-set! v 1 (symbol "_L" (number->string local-ctr) "_"))
- (list-set! v 2 local-ctr)
- (set! local-ctr (+ local-ctr 1)))
- (list 'set! (cadr v) (walker (caddr tree) vars)))
- (list 'set! (walker (cadr tree) vars) (walker (caddr tree) vars))))
-
- ((define define*
- ;; these propagate backwards and we're not returning the new env in this loop,
- ;; lvars can be null, so splicing a new local into vars is a mess,
- ;; but if the defined name is not reduced, it can occur later as itself (not via car),
- ;; so without lots of effort (a dummy var if null lvars, etc), we can only handle
- ;; functions within a function (fvar not #f).
- ;; but adding that possibility got no hits
-
- list-values apply-values append quasiquote unquote
-
- define-constant define-macro define-macro* define-expansion
- define-syntax let-syntax letrec-syntax match syntax-rules
- require import module cond-expand reader-cond while case-lambda
- call-with-values let-values define-values let*-values multiple-value-bind)
- (quit))
+ (define (reduce-tree new-form leaves env fvar orig-form)
+ (call-with-exit
+ (lambda (quit)
+ (let ((outer-vars (if fvar
+ (do ((e (list (list (var-name fvar) (symbol "_F_") 0 ())))
+ (i 1 (+ i 1))
+ (args (args->proper-list (var-arglist fvar)) (cdr args)))
+ ((not (pair? args)) e)
+ (set! e (cons (list (car args) (symbol "_" (number->string i) "_") i ()) e)))
+ (list (list () '_1_) (list () '_2_) (list () '_3_) (list () '_4_))))
+ (local-ctr 0))
+ (let ((line (pair-line-number orig-form))
+ (reduced-form
+ (let walker ((tree new-form) (vars outer-vars))
+ (cond ((pair? tree)
+ (case (car tree)
+ ((quote)
+ tree)
+
+ ((let let*)
+ ;; in let we need to sort locals by order of appearance in the body
+ (if (<= (length tree) 2)
+ (quit))
+ (let ((locals ())
+ (body ())
+ (named-let (symbol? (cadr tree)))
+ (lvars ()))
+ (if named-let
+ (begin
+ (set! lvars (cons (list (cadr tree) (symbol "_NL" (number->string local-ctr) "_") -1) lvars))
+ (set! local-ctr (+ local-ctr 1))
+ (set! locals (caddr tree))
+ (set! body (cdddr tree)))
+ (begin
+ (set! locals (cadr tree))
+ (set! body (cddr tree))))
+ (if (not (list? locals)) (quit))
+
+ (let ((func (if (eq? (car tree) 'let)
+ (lambda (local)
+ (if (not (len>1? local)) (quit))
+ (set! lvars (cons (list (car local) () 0 (walker (cadr local) vars)) lvars)))
+ (lambda (local)
+ (if (not (len>1? local)) (quit))
+ (set! lvars (cons (list (car local)
+ (symbol "_L" (number->string local-ctr) "_")
+ local-ctr
+ (walker (cadr local) (append lvars vars)))
+ lvars))
+ (set! local-ctr (+ local-ctr 1))))))
+ (for-each func locals))
+
+ ;; now walk the body, setting the reduced local name by order of encounter (in let, not let*)
+ (let ((new-body (walker body (append lvars vars))))
+ (unless (pair? new-body) (set! new-body (list new-body)))
+ (when (and (eq? (car tree) 'let)
+ ;; fill-in unused-var dummy names etc
+ (pair? lvars))
+ (for-each (lambda (v)
+ (when (null? (cadr v))
+ (list-set! v 1 (symbol "_L" (number->string local-ctr) "_"))
+ (list-set! v 2 local-ctr)
+ (set! local-ctr (+ local-ctr 1))))
+ lvars))
+ (set! lvars (sort! lvars (lambda (a b) (< (caddr a) (caddr b)))))
- (else ; still (pair? tree) but (car tree) not hit above
- (cons (cond ((pair? (car tree))
- (walker (car tree) vars))
- ((assq (car tree) vars) =>
- (lambda (v)
- ;; this might be the first appearance of (car v)
+ (if named-let
+ `(,(car tree) ,(cadr (assq (cadr tree) lvars))
+ ,(map (lambda (v) (list (cadr v) (cadddr v))) (cdr lvars))
+ ,@new-body)
+ `(,(car tree)
+ ,(map (lambda (v) (list (cadr v) (cadddr v))) lvars)
+ ,@new-body)))))
+
+ ((if)
+ (if (not (and (len>1? (cdr tree))
+ (list? (cdddr tree))))
+ (quit))
+ (let ((expr (walker (cadr tree) vars))
+ (true (walker (caddr tree) vars)))
+ (if (null? (cdddr tree))
+ (if (and (len>1? expr)
+ (eq? (car expr) 'not))
+ (cons 'unless (cons (cadr expr) (unbegin true)))
+ (cons 'when (cons expr (unbegin true))))
+ (list 'if expr true (walker (cadddr tree) vars)))))
+
+ ((when unless)
+ (if (not (len>1? (cdr tree)))
+ (quit))
+ (cons (car tree)
+ (cons (walker (cadr tree) vars)
+ (map (lambda (p) (walker p vars)) (cddr tree)))))
+
+ ((set!)
+ (if (not (len>1? (cdr tree))) (quit))
+ (if (symbol? (cadr tree))
+ (let ((v (assq (cadr tree) vars)))
+ (if (or (not v) ; if not a var, it's about to be an outer-var
+ (and (not fvar)
+ (memq (cadr v) '(_1_ _2_ _3_ _4_))))
+ (quit))
+ (when (null? (cadr v)) ; must be a previously unencountered local
+ (list-set! v 1 (symbol "_L" (number->string local-ctr) "_"))
+ (list-set! v 2 local-ctr)
+ (set! local-ctr (+ local-ctr 1)))
+ (list 'set! (cadr v) (walker (caddr tree) vars)))
+ (list 'set! (walker (cadr tree) vars) (walker (caddr tree) vars))))
+
+ ((do)
+ (if (not (and (len>1? (cdr tree))
+ (list? (cadr tree))
+ (list? (cdddr tree))))
+ (quit))
+ (let ((locals (cadr tree))
+ (end+result (caddr tree))
+ (body (cdddr tree))
+ (lvars ()))
+ (if (not (and (list? end+result)
+ (proper-list? body)))
+ (quit))
+ (for-each (lambda (local)
+ (if (not (len>1? local))
+ (quit))
+ (set! lvars (cons (list (car local)
+ () 0
+ (walker (cadr local) vars)
+ (if (pair? (cddr local))
+ (caddr local)
+ :unset))
+ lvars)))
+ locals)
+ (let ((new-env (append lvars vars)))
+ (let ((new-end (walker end+result new-env))
+ (new-body (walker body new-env)))
+ (unless (pair? new-body)
+ (set! new-body (list new-body)))
+ (when (pair? lvars)
+ (for-each (lambda (lv)
+ (if (not (eq? (lv 4) :unset))
+ (list-set! lv 4 (walker (lv 4) new-env))))
+ lvars)
+ (for-each (lambda (v)
(when (null? (cadr v))
(list-set! v 1 (symbol "_L" (number->string local-ctr) "_"))
(list-set! v 2 local-ctr)
- (set! local-ctr (+ local-ctr 1)))
- (cadr v)))
- (else (car tree)))
- (if (pair? (cdr tree))
- (map (lambda (p)
- (walker p vars))
- (cdr tree))
- (cdr tree))))))
-
- ;; (pair? tree) far far above
-
- ((or (not (symbol? tree))
- (keyword? tree))
- tree)
-
- ((assq tree vars) => ; replace in-tree symbol with its reduction (this includes any outer-var once set below)
- (lambda (v)
- ;; v is a list: local-name possible-reduced-name [counter value]
- (when (null? (cadr v))
- (list-set! v 1 (symbol "_L" (number->string local-ctr) "_"))
- (list-set! v 2 local-ctr)
- (set! local-ctr (+ local-ctr 1)))
- (cadr v)))
-
- (else
- (if fvar (quit))
- (let set-outer ((ovars outer-vars))
- (if (null? ovars)
- (quit)
- (if (null? (caar ovars))
- (begin
- (set-car! (car ovars) tree)
- (cadar ovars))
- (set-outer (cdr ovars))))))))))
-
- (unless line
- (set! line (let search ((tree orig-form))
- (and (pair? tree)
- (or (pair-line-number tree)
- (search (car tree))
- (search (cdr tree))))))
- (if (not line) (set! line 0)))
-
- (set! leaves (tree-leaves reduced-form)) ; if->when, for example, so tree length might change
- (if (and (<= *fragment-min-size* leaves)
- (< leaves *fragment-max-size*))
- (hash-fragment reduced-form leaves env fvar orig-form line outer-vars))
- (when fvar (quit))
-
- (unless (and (pair? lint-function-body)
- (equal? new-form (car lint-function-body)))
- (let ((fvars (let ((fcase (and (< leaves *fragment-max-size*)
- (vector-ref fragments leaves)
- (hash-table-ref (vector-ref fragments leaves) (list reduced-form)))))
- (and (vector? fcase)
- (vector-ref fcase 2)))))
- (when (pair? fvars)
- (call-with-exit
- (lambda (ok)
- (for-each (lambda (fv)
- (when (var-member (var-name fv) env)
- (format outport "~NCperhaps ~A -> (~A~{ ~A~})~%" lint-left-margin #\space
- (truncated-list->string new-form)
- (var-name fv)
- (map (lambda (a) (case (car a) ((()) (values)) (else))) outer-vars))
- (ok)))
- fvars)
- (format outport "~NCif '~A were in scope, perhaps ~A -> (~A~{ ~A~})~%" lint-left-margin #\space
- (var-name (car fvars))
- (truncated-list->string new-form)
- (var-name (car fvars))
- (map (lambda (a) (case (car a) ((()) (values)) (else))) outer-vars))))))))))))))
+ (set! local-ctr (+ local-ctr 1))))
+ lvars)
+ (set! lvars (sort! lvars (lambda (a b) (< (caddr a) (caddr b))))))
+
+ `(do ,(map (lambda (v)
+ (map v (if (eq? (v 4) :unset) '(1 3) '(1 3 4))))
+ lvars)
+ ,new-end
+ ,@new-body)))))
+
+ ((lambda)
+ (if (not (proper-pair? (cdr tree)))
+ (quit))
+ (let* ((lvars (map (lambda (a)
+ (let ((res (list a (symbol "_A" (number->string local-ctr) "_") local-ctr)))
+ (set! local-ctr (+ local-ctr 1))
+ res))
+ (let ((args (args->proper-list (cadr tree))))
+ (if (pair? args) args (quit)))))
+ (new-body (let ((new-vars (append lvars vars)))
+ (map (lambda (p) (walker p new-vars)) (cddr tree))))
+ (new-args (if (symbol? (cadr tree))
+ (cadar lvars)
+ (if (proper-list? (cadr tree))
+ (map cadr lvars)
+ (let ((lst (map cadr lvars)))
+ (append (copy lst (make-list (- (length lst) 1)))
+ (last-ref lst)))))))
+ (cons 'lambda (cons new-args new-body))))
+
+ ((case)
+ (if (not (and (len>1? (cdr tree))
+ (pair? (caddr tree))))
+ (quit))
+ (list 'case
+ (walker (cadr tree) vars)
+ (map (lambda (c)
+ (if (not (len>1? c))
+ (quit))
+ (cons (car c)
+ (map (lambda (p) (walker p vars)) (cdr c))))
+ (cddr tree))))
+
+ ((letrec letrec*)
+ (if (not (pair? (cdr tree))) (quit))
+ (let ((locals (cadr tree))
+ (body (cddr tree))
+ (lvars ()))
+ (if (not (and (list? locals) (pair? body))) (quit))
+ (for-each (lambda (local)
+ (if (not (len>1? local))
+ (quit))
+ (set! lvars (cons (list (car local)
+ (symbol "_L" (number->string local-ctr) "_")
+ local-ctr ())
+ lvars))
+ (set! local-ctr (+ local-ctr 1)))
+ locals)
+ (for-each (lambda (local lv)
+ (list-set! lv 3 (walker (cadr local) lvars)))
+ locals lvars)
+ (cons (car tree)
+ (cons (map (lambda (v) (list (cadr v) (cadddr v))) lvars)
+ (walker body (append lvars vars))))))
+
+ ((lambda*)
+ (if (not (and (proper-pair? (cdr tree))
+ (or (symbol? (cadr tree))
+ (proper-list? (cadr tree)))))
+ (quit))
+ (let ((old-args (args->proper-list (cadr tree))))
+ (if (or (not (pair? old-args))
+ (lint-every? keyword? old-args)) ; (:allow-other-keys)
+ (quit))
+ (let* ((lvars (map (lambda (a)
+ (if (memq a '(:rest :allow-other-keys))
+ (values)
+ (let ((res (list (if (pair? a) (car a) a)
+ (symbol "_A" (number->string local-ctr) "_") local-ctr)))
+ (set! local-ctr (+ local-ctr 1))
+ res)))
+ old-args))
+ (new-body (let ((new-vars (append lvars vars)))
+ (map (lambda (p) (walker p new-vars)) (cddr tree))))
+ (new-args (if (symbol? (cadr tree))
+ (cadar lvars)
+ (map (lambda (a)
+ (cond ((keyword? a) a)
+ ((symbol? a) (cadr (assq a lvars)))
+ ((len>1? a)
+ (list (assq a lvars) (cadr a)))
+ (else (quit))))
+ (cadr tree)))))
+ (cons 'lambda* (cons new-args new-body)))))
+
+ ((define define*
+ ;; these propagate backwards and we're not returning the new env in this loop,
+ ;; lvars can be null, so splicing a new local into vars is a mess,
+ ;; but if the defined name is not reduced, it can occur later as itself (not via car),
+ ;; so without lots of effort (a dummy var if null lvars, etc), we can only handle
+ ;; functions within a function (fvar not #f).
+ ;; but adding that possibility got no hits
+
+ list-values apply-values append quasiquote unquote
+
+ define-constant define-macro define-macro* define-expansion
+ define-syntax let-syntax letrec-syntax match syntax-rules
+ require import module cond-expand reader-cond while case-lambda
+ call-with-values let-values define-values let*-values multiple-value-bind)
+ (quit))
+
+ (else ; still (pair? tree) but (car tree) not hit above
+ (cons (cond ((pair? (car tree))
+ (walker (car tree) vars))
+ ((assq (car tree) vars) =>
+ (lambda (v)
+ ;; this might be the first appearance of (car v)
+ (when (null? (cadr v))
+ (list-set! v 1 (symbol "_L" (number->string local-ctr) "_"))
+ (list-set! v 2 local-ctr)
+ (set! local-ctr (+ local-ctr 1)))
+ (cadr v)))
+ (else (car tree)))
+ (if (pair? (cdr tree))
+ (map (lambda (p)
+ (walker p vars))
+ (cdr tree))
+ (cdr tree))))))
+
+ ;; (pair? tree) far far above
+
+ ((or (not (symbol? tree))
+ (keyword? tree))
+ tree)
+
+ ((assq tree vars) => ; replace in-tree symbol with its reduction (this includes any outer-var once set below)
+ (lambda (v)
+ ;; v is a list: local-name possible-reduced-name [counter value]
+ (when (null? (cadr v))
+ (list-set! v 1 (symbol "_L" (number->string local-ctr) "_"))
+ (list-set! v 2 local-ctr)
+ (set! local-ctr (+ local-ctr 1)))
+ (cadr v)))
+
+ (else
+ (if fvar (quit))
+ (let set-outer ((ovars outer-vars))
+ (if (null? ovars)
+ (quit)
+ (if (null? (caar ovars))
+ (begin
+ (set-car! (car ovars) tree)
+ (cadar ovars))
+ (set-outer (cdr ovars))))))))))
+
+ (unless line
+ (set! line (let search ((tree orig-form))
+ (and (pair? tree)
+ (or (pair-line-number tree)
+ (search (car tree))
+ (search (cdr tree))))))
+ (if (not line) (set! line 0)))
+
+ (set! leaves (tree-leaves reduced-form)) ; if->when, for example, so tree length might change
+ (if (and (<= *fragment-min-size* leaves)
+ (< leaves *fragment-max-size*))
+ (hash-fragment reduced-form leaves env fvar orig-form line outer-vars))
+ (when fvar (quit))
+
+ (unless (and (pair? lint-function-body)
+ (equal? new-form (car lint-function-body)))
+ (let ((fvars (let ((fcase (and (< leaves *fragment-max-size*)
+ (vector-ref fragments leaves)
+ (hash-table-ref (vector-ref fragments leaves) (list reduced-form)))))
+ (and (vector? fcase)
+ (vector-ref fcase 2)))))
+ (when (pair? fvars)
+ (call-with-exit
+ (lambda (ok)
+ (for-each (lambda (fv)
+ (when (var-member (var-name fv) env)
+ (format outport "~NCperhaps ~A -> (~A~{ ~A~})~%" lint-left-margin #\space
+ (truncated-list->string new-form)
+ (var-name fv)
+ (map (lambda (a) (case (car a) ((()) (values)) (else))) outer-vars))
+ (ok)))
+ fvars)
+ (format outport "~NCif '~A were in scope, perhaps ~A -> (~A~{ ~A~})~%" lint-left-margin #\space
+ (var-name (car fvars))
+ (truncated-list->string new-form)
+ (var-name (car fvars))
+ (map (lambda (a) (case (car a) ((()) (values)) (else))) outer-vars))))))))))))
(define (lint-fragment form env)
- (if (memq (car form) '(or and))
- ;; or/and are special because leading and trailing cases are separable (like leading cases for bodies)
- (do ((i (length form) (- i 1))
- (p (cdr form) (cdr p)))
- ((<= i 2))
- (reduce-tree (cons (car form) p) env #f (cons (car form) p)))
- (reduce-tree form env #f form)))
+ (let ((leaves (tree-leaves form)))
+ (when (< *fragment-min-size* leaves *fragment-max-size*)
+ (reduce-tree form leaves env #f form))))
(define (reduce-function-tree fvar env)
(let ((definition (cond ((var-initial-value fvar) => cddr))))
@@ -21194,7 +21267,9 @@
(pair? (cdr definition)))
(cdr definition)
definition)))
- (reduce-tree form env (and (not (keyword? (var-name fvar))) fvar) form)))))
+ (let ((leaves (tree-leaves form)))
+ (when (< *fragment-min-size* leaves *fragment-max-size*)
+ (reduce-tree form leaves env (and (not (keyword? (var-name fvar))) fvar) form)))))))
;; ----------------------------------------
@@ -21228,11 +21303,9 @@
(lambda (caller head form env)
(let ((v (var-member head env)))
- (if (and v
- (not (memq form (var-history v))))
- (begin
- (set! (var-history v) (cons form (var-history v)))
- (set! (var-refenv v) env)))
+ (when (and v (not (memq form (var-history v))))
+ (set! (var-history v) (cons form (var-history v)))
+ (set! (var-refenv v) env))
(check-call caller head form env)
;; look for one huge argument leaving lonely trailing arguments somewhere off the screen
@@ -21240,7 +21313,7 @@
(let ((branches (length form)))
(when (and (= branches 2)
- (any-procedure? head env)
+ (any-procedure? head v env)
(not (eq? head 'unquote)))
(let ((arg (cadr form)))
;; begin=(car arg) happens very rarely
@@ -21313,7 +21386,7 @@
(not (tree-memq 'values (car p)))
(let ((header (copy form (make-list i)))
(trailer (copy form (make-list (- branches i 1)) (+ i 1)))
- (disclaimer (if (or (any-procedure? head env)
+ (disclaimer (if (or (any-procedure? head v env)
(hash-table-ref no-side-effect-functions head))
""
(format #f ", assuming ~A is not a macro," head))))
@@ -21344,8 +21417,7 @@
(for-each (lambda (arg)
(when (symbol? arg)
(let ((v (var-member arg env)))
- (when (and v
- (not (memq form (var-history v))))
+ (when (and v (not (memq form (var-history v))))
(set! (var-history v) (cons form (var-history v)))
(set! (var-refenv v) env)))))
form)
@@ -21389,19 +21461,16 @@
(proper-tree? form))
;; head always is (car form) here
(let ((val (simplify-numerics form env)))
- (if (not (equal-ignoring-constants? form val))
- (begin
- (set! last-simplify-numeric-line-number line-number)
- ;; (+ 1 2) -> 3, and many others
- (lint-format "perhaps ~A" caller (lists->string form val))))))
+ (unless (equal-ignoring-constants? form val)
+ (set! last-simplify-numeric-line-number line-number)
+ ;; (+ 1 2) -> 3, and many others
+ (lint-format "perhaps ~A" caller (lists->string form val)))))
;; if a var is used before it is defined, the var history and ref/set
;; info needs to be saved until the definition, so other-identifiers collects it
(unless (defined? head (rootlet))
(hash-table-set! other-identifiers head
- (if (not (hash-table-ref other-identifiers head))
- (list form)
- (cons form (hash-table-ref other-identifiers head)))))))
+ (cons form (or (hash-table-ref other-identifiers head) ()))))))
;; (f ... (if A B C) (if A D E) ...) -> (f ... (if A (values B D) (values C E)) ...)
;; these happen up to almost any number of clauses
@@ -21552,9 +21621,7 @@
(set-ref sym caller form env))
((not (defined? sym (rootlet)))
(hash-table-set! other-identifiers sym
- (if (not (hash-table-ref other-identifiers sym))
- (list form)
- (cons form (hash-table-ref other-identifiers sym))))))))
+ (cons form (or (hash-table-ref other-identifiers sym) ())))))))
(cdr form))
(let ((old-current-form lint-current-form))
@@ -21761,7 +21828,12 @@
;; -------- lint-walk-pair --------
(lambda (caller form env)
(let ((head (car form)))
-
+#|
+ (if (and (pair? form)
+ (memq (car form) '(vector-set! float-vector-set! int-vector-set!))
+ (tree-set-memq '(vector-ref float-vector-ref int-vector-ref) form))
+ (format *stderr* "~S~%" form))
+|#
(set! line-number (or (pair-line-number form) line-number))
(if *report-repeated-code-fragments*
@@ -21876,8 +21948,8 @@
";~A~%")
file))
p))
- (lambda args
- (format outport "~NCcan't open ~S: ~A~%" lint-left-margin #\space file (apply format #f (cadr args)))
+ (lambda (type info)
+ (format outport "~NCcan't open ~S: ~A~%" lint-left-margin #\space file (apply format #f info))
#f))))))
(if (not (input-port? fp))
@@ -21980,7 +22052,7 @@
(string<? (object->string (car kv1))
(object->string (car kv2))))))))))))))))
vars) ; lint-file-1 should return the environment
-
+
(if (pair? form)
(set! line (max line (or (pair-line-number form) 0))))
@@ -22252,6 +22324,8 @@
(lambda args #f))))))))))
(lambda* (file (outp *output-port*) (report-input #t))
+ (if (and outp (not (output-port? outp)))
+ (error 'wrong-type-arg (format #f "~S should be an output port" outp)))
(set! outport outp)
(set! other-identifiers (make-hash-table))
(set! linted-files ())
@@ -22515,7 +22589,6 @@
#f))
|#
-;;; 63 910075
-;;;
-;;; combine do|case|cond: currently combine-successive-ifs for if|when|unless 12874 (see t605 for examples)
+;;; 63 911262
+
diff --git a/mockery.scm b/mockery.scm
index d3eacec..1453890 100644
--- a/mockery.scm
+++ b/mockery.scm
@@ -27,6 +27,7 @@
(make-method f (lambda (obj) (obj 'value))))
+
;;; --------------------------------------------------------------------------------
(define *mock-vector*
@@ -186,7 +187,7 @@
'copy (lambda* (source dest . args)
(if (mock-hash-table? source)
(if (and dest (not (let? dest)))
- (apply copy (obj 'mock-hash-table-table) dest args)
+ (apply copy (source 'mock-hash-table-table) dest args)
(let ((nobj (or dest (openlet (copy (coverlet source))))))
(openlet source)
(set! (nobj 'mock-hash-table-table) (copy (source 'mock-hash-table-table)))
diff --git a/peak-phases.scm b/peak-phases.scm
index 05638ed..bde2cc1 100644
--- a/peak-phases.scm
+++ b/peak-phases.scm
@@ -1470,30 +1470,30 @@
;;; 256 all -------------------------------------------------------------------------------- (16)
(vector 256 23.353 #r(0 0 1 1 0 1 1 1 1 1 1 0 1 0 0 1 0 0 1 1 1 1 1 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 1 1 1 0 1 0 1 0 1 0 1 0 0 1 0 0 1 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 1 0 1 0 1 1 1 0 1 1 1 1 1 0 0 1 0 1 0 1 0 0 0 0 1 1 0 1 1 0 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 1 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 1 1 1 0 0 1 1 0 0 0 0 1 1 1 0 0 0 1 0 0 1 1 1 0 1 0 1 0 1 0 0 1 0 1 0 1 1 0 0 0 0 1 1 1 1 1 1 1 1 0 1 0 0 0 1 0 0 0 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 1 1 0 0 0 1 1 1 0 0 1 1 0 0 1 0 0 1 0 0 1 0 0 1 1 0 0 1 0 0 1)
- 16.004494 #(0.000000 0.923816 0.361639 -0.107454 -0.859742 -0.028657 -0.483980 0.304450 0.009620 0.028111 0.488083 0.145329 0.992522 -0.712585 0.835199 0.844863 -0.130023 0.541909 0.203354 -0.437282 -0.763012 0.240385 -0.474816 0.867235 -0.042272 -0.459829 0.739290 -0.226994 0.000326 0.548038 -0.057597 -0.036183 0.171858 -0.629562 -0.054153 -0.933713 -1.031920 0.790526 -0.041636 -0.413967 -0.216472 -0.508969 -0.005543 -0.455212 0.341069 0.517767 0.790358 -0.252446 -0.226255 -0.777399 0.732727 0.787972 0.367821 -0.617361 0.579757 0.338221 0.846564 -1.027653 0.259324 0.849386 0.331276 -0.126506 -0.126388 -0.903010 -0.617286 0.786967 -0.310247 0.156945 0.053599 0.868872 -0.145454 -0.229626 -0.267431 -0.545652 0.832464 -0.190728 0.528705 0.904620 0.174421 0.028586 -0.605220 0.721468 -0.996563 0.931650 -0.599780 -0.564533 0.182431 -0.204505 0.318571 0.733352 0.706688 -0.342127 -0.790260 -0.358786 0.315925 0.458784 0.831646 -0.430450 0.891531 -0.527239 -0.950154 -0.914766 0.232786 -0.531049 -0.361289 -0.654862 -0.172115 -0.782072 -0.708290 0.943431 -0.852316 -0.252543 -0.007994 0.913765 -0.616490 0.750657 -0.095885 0.449506 -0.691238 -0.883734 0.490213 0.243896 0.522669 0.972888 -0.771052 0.800503 0.729518 0.378651 0.170051 0.840751 -0.055721 0.611168 -0.857658 1.069398 -0.296402 -0.114941 0.012304 -0.915913 0.163671 0.653378 -0.005673 -0.505719 -0.069401 0.429234 0.399932 -0.572847 0.916709 -0.105681 0.623431 -0.135832 0.295771 0.205111 -0.476164 -0.158542 0.738313 0.642827 0.735903 -0.449294 -0.462374 0.777115 0.428654 0.673744 -0.340257 -0.689443 0.050240 -0.189272 0.914422 -0.878746 -0.068019 -0.143830 -0.819958 0.328664 -0.298336 0.392924 0.371409 0.289571 -0.889659 0.110277 0.754586 -0.489103 0.877567 -0.709198 0.733528 -0.023455 -0.771095 0.604769 0.274655 0.010504 -0.018009 -0.015237 0.115976 0.176482 -0.918708 -0.022918 0.031436 -0.713376 -0.890487 0.791812 -0.355370 -0.638230 0.507087 -0.746586 0.519222 0.225200 0.220685 -0.870714 0.455315 0.938855 -0.591543 -0.023644 -0.833799 -0.128752 0.459819 0.854274 -0.511312 0.083997 0.667854 -0.850579 0.624178 -0.182558 0.556230 -0.776685 -0.286810 -0.115990 -0.183540 0.598780 0.054693 0.795983 0.363080 0.192692 0.637320 -0.044998 0.315471 -0.070081 0.782006 0.497451 0.070613 0.847255 -0.191377 0.137860 -0.013771 0.217518 -0.015827 -0.167256 0.291737 0.773328 -0.642920 -0.865159 0.781886 0.657254 0.854299 0.024065 0.695663 0.894978 -0.001701 0.424563)
- 16.004138 #(0.000000 0.924688 0.362089 -0.109382 -0.857400 -0.027666 -0.483597 0.303703 0.009369 0.026084 0.487301 0.145538 0.992375 -0.713596 0.834901 0.845857 -0.131135 0.540880 0.202907 -0.439585 -0.762665 0.242561 -0.475639 0.867784 -0.040726 -0.461522 0.738430 -0.225241 -0.000123 0.549831 -0.057366 -0.036092 0.167920 -0.630075 -0.053340 -0.934464 -1.031733 0.789169 -0.041446 -0.413395 -0.214005 -0.510226 -0.006280 -0.453731 0.341121 0.517585 0.788920 -0.250815 -0.228232 -0.778281 0.732454 0.787024 0.365809 -0.617906 0.580304 0.338111 0.848622 -1.028080 0.259726 0.848976 0.331331 -0.126236 -0.125945 -0.901411 -0.617430 0.786835 -0.309380 0.155702 0.055098 0.868459 -0.144800 -0.229746 -0.266266 -0.547389 0.833748 -0.191366 0.529498 0.901813 0.175373 0.029185 -0.604488 0.721819 -0.997709 0.930161 -0.600763 -0.566888 0.181567 -0.207773 0.318595 0.732571 0.706321 -0.341245 -0.789781 -0.360662 0.313865 0.457991 0.831245 -0.430592 0.891544 -0.526683 -0.948178 -0.915890 0.232164 -0.531297 -0.361678 -0.653779 -0.170857 -0.781145 -0.705158 0.943037 -0.851661 -0.251794 -0.006856 0.913255 -0.615596 0.752146 -0.095992 0.446977 -0.690745 -0.883343 0.490963 0.243245 0.523041 0.972647 -0.771765 0.799699 0.730717 0.378320 0.170318 0.838466 -0.055430 0.611346 -0.855476 1.069073 -0.296657 -0.116264 0.010475 -0.917481 0.163531 0.654015 -0.003459 -0.507158 -0.068560 0.429668 0.400299 -0.574095 0.917084 -0.108337 0.624969 -0.138433 0.296368 0.204510 -0.476966 -0.159609 0.740602 0.642361 0.735627 -0.448857 -0.463591 0.777132 0.428587 0.673546 -0.340680 -0.690706 0.049109 -0.188268 0.915421 -0.878268 -0.066336 -0.144713 -0.818195 0.329276 -0.297274 0.391748 0.368179 0.290498 -0.889991 0.110037 0.753241 -0.489413 0.878493 -0.712662 0.730659 -0.025312 -0.771363 0.602415 0.274544 0.010140 -0.016950 -0.014686 0.117732 0.177066 -0.917962 -0.020014 0.032847 -0.712137 -0.892564 0.792401 -0.356763 -0.638883 0.506947 -0.748125 0.518022 0.226702 0.219873 -0.870753 0.456311 0.937372 -0.593056 -0.026080 -0.832275 -0.129742 0.460048 0.852618 -0.509471 0.083336 0.666559 -0.848858 0.624087 -0.183776 0.557165 -0.776788 -0.286160 -0.116088 -0.184525 0.600292 0.055028 0.797840 0.360468 0.190986 0.638246 -0.043778 0.314598 -0.069579 0.782102 0.494808 0.071358 0.849548 -0.189940 0.138086 -0.014070 0.218801 -0.018027 -0.165167 0.289397 0.774255 -0.641779 -0.863379 0.780232 0.656465 0.853904 0.025600 0.694962 0.895916 -0.005212 0.424160)
- 16.003630 #(0.000000 0.923847 0.361694 -0.107462 -0.859817 -0.028657 -0.484040 0.304447 0.009611 0.028067 0.488034 0.145389 0.992498 -0.712576 0.835208 0.844839 -0.129970 0.541905 0.203401 -0.437221 -0.763002 0.240431 -0.474760 0.867215 -0.042206 -0.459832 0.739200 -0.226980 0.000327 0.548166 -0.057671 -0.036223 0.171887 -0.629570 -0.054140 -0.933750 -1.032004 0.790508 -0.041629 -0.413948 -0.216505 -0.508965 -0.005557 -0.455191 0.341053 0.517716 0.790332 -0.252483 -0.226213 -0.777449 0.732773 0.787933 0.367904 -0.617387 0.579722 0.338191 0.846633 -1.027672 0.259344 0.849403 0.331302 -0.126522 -0.126424 -0.902918 -0.617263 0.786948 -0.310234 0.156943 0.053596 0.868846 -0.145455 -0.229611 -0.267427 -0.545610 0.832483 -0.190735 0.528596 0.904624 0.174451 0.028646 -0.605167 0.721495 -0.996645 0.931623 -0.599730 -0.564592 0.182433 -0.204470 0.318571 0.733334 0.706664 -0.342096 -0.790252 -0.358744 0.315888 0.458839 0.831655 -0.430398 0.891511 -0.527192 -0.950149 -0.914809 0.232824 -0.531017 -0.361252 -0.654895 -0.172123 -0.782098 -0.708324 0.943417 -0.852303 -0.252585 -0.007983 0.913775 -0.616513 0.750653 -0.095875 0.449523 -0.691246 -0.883753 0.490169 0.243885 0.522647 0.972850 -0.771088 0.800464 0.729569 0.378613 0.170034 0.840754 -0.055689 0.611131 -0.857565 1.069406 -0.296390 -0.114912 0.012325 -0.915935 0.163690 0.653378 -0.005655 -0.505707 -0.069416 0.429303 0.399958 -0.572779 0.916722 -0.105747 0.623398 -0.135860 0.295749 0.205019 -0.476127 -0.158541 0.738280 0.642883 0.735928 -0.449222 -0.462362 0.777133 0.428649 0.673692 -0.340201 -0.689491 0.050235 -0.189302 0.914447 -0.878751 -0.068007 -0.143885 -0.819972 0.328707 -0.298330 0.392914 0.371393 0.289497 -0.889663 0.110231 0.754611 -0.489075 0.877581 -0.709161 0.733578 -0.023534 -0.771121 0.604803 0.274625 0.010542 -0.018029 -0.015252 0.115994 0.176495 -0.918714 -0.022969 0.031390 -0.713351 -0.890487 0.791835 -0.355368 -0.638229 0.507069 -0.746578 0.519158 0.225155 0.220663 -0.870722 0.455250 0.938870 -0.591613 -0.023703 -0.833787 -0.128770 0.459890 0.854236 -0.511318 0.084035 0.667890 -0.850609 0.624169 -0.182523 0.556209 -0.776655 -0.286843 -0.116030 -0.183539 0.598802 0.054674 0.795963 0.363083 0.192724 0.637306 -0.044984 0.315434 -0.070083 0.781945 0.497481 0.070624 0.847242 -0.191341 0.137867 -0.013819 0.217503 -0.015829 -0.167290 0.291685 0.773372 -0.642887 -0.865192 0.781893 0.657214 0.854277 0.024075 0.695669 0.894936 -0.001759 0.424517)
+ 15.998862 #(0.000000 0.925788 0.360084 -0.108757 -0.863038 -0.029536 -0.483233 0.303531 0.009080 0.031016 0.486598 0.145086 0.992965 -0.712642 0.834993 0.846556 -0.131559 0.542781 0.203636 -0.433907 -0.763127 0.238103 -0.473437 0.867673 -0.040524 -0.462653 0.740416 -0.227337 -0.000446 0.548069 -0.055173 -0.034840 0.172746 -0.631029 -0.053819 -0.933401 -1.030140 0.789708 -0.041555 -0.413672 -0.219939 -0.508739 -0.002103 -0.453631 0.339043 0.519111 0.788813 -0.251829 -0.227253 -0.779460 0.734475 0.789654 0.366785 -0.617226 0.580458 0.338718 0.845634 -1.028370 0.259314 0.848685 0.329966 -0.124830 -0.130071 -0.899863 -0.617097 0.786076 -0.311414 0.157161 0.053867 0.868578 -0.143526 -0.226481 -0.267403 -0.543209 0.834028 -0.192426 0.531042 0.900606 0.172646 0.028435 -0.603939 0.717868 -0.997069 0.928765 -0.598600 -0.564405 0.183509 -0.203751 0.319598 0.732028 0.707291 -0.345385 -0.789206 -0.361953 0.317571 0.458116 0.830794 -0.431333 0.893855 -0.522719 -0.952210 -0.916389 0.233026 -0.531887 -0.365605 -0.655787 -0.172781 -0.785745 -0.707073 0.943479 -0.849581 -0.253181 -0.005996 0.913174 -0.613465 0.749547 -0.097617 0.449928 -0.692852 -0.884174 0.489417 0.243282 0.522901 0.974901 -0.768474 0.798779 0.726712 0.379956 0.170699 0.842196 -0.055317 0.610496 -0.858589 1.073130 -0.296732 -0.115610 0.015705 -0.916019 0.161067 0.652246 -0.008807 -0.504946 -0.067137 0.429791 0.399456 -0.573374 0.915967 -0.104180 0.624562 -0.135129 0.295577 0.203841 -0.479144 -0.158931 0.735128 0.642786 0.736003 -0.449052 -0.458565 0.777376 0.430063 0.670253 -0.340080 -0.689998 0.052888 -0.193463 0.914040 -0.878766 -0.069433 -0.145190 -0.823872 0.329781 -0.294939 0.392721 0.368910 0.287760 -0.889443 0.108384 0.753364 -0.488175 0.879464 -0.711181 0.729856 -0.024830 -0.771553 0.605895 0.271966 0.006960 -0.020552 -0.014102 0.113698 0.177650 -0.915753 -0.023090 0.032039 -0.714364 -0.890423 0.792170 -0.352205 -0.637379 0.505277 -0.746844 0.517723 0.225053 0.219109 -0.869515 0.454299 0.941028 -0.592582 -0.021235 -0.833910 -0.129551 0.460591 0.851676 -0.513369 0.083605 0.670103 -0.849482 0.625909 -0.180657 0.558481 -0.773357 -0.289139 -0.114779 -0.181586 0.601204 0.053292 0.794631 0.364047 0.190753 0.637953 -0.048498 0.312738 -0.071123 0.780676 0.495178 0.069623 0.847653 -0.191750 0.133417 -0.011606 0.216746 -0.015986 -0.170884 0.292624 0.777786 -0.641781 -0.865857 0.782243 0.652142 0.854559 0.022573 0.692716 0.892844 -0.002893 0.427529)
+ 15.998045 #(0.000000 0.925843 0.359927 -0.109456 -0.862909 -0.029760 -0.483178 0.303322 0.008839 0.031331 0.487207 0.145776 0.992620 -0.712537 0.834694 0.846516 -0.131526 0.542745 0.204179 -0.434281 -0.764019 0.238642 -0.473945 0.867637 -0.040518 -0.462613 0.740796 -0.227346 -0.000510 0.548263 -0.055126 -0.035328 0.172913 -0.630555 -0.053765 -0.934228 -1.030499 0.789566 -0.041629 -0.413206 -0.219963 -0.508748 -0.002346 -0.453668 0.339321 0.518992 0.788783 -0.252097 -0.227309 -0.779234 0.734437 0.789632 0.367121 -0.617353 0.580490 0.338787 0.845856 -1.028491 0.259279 0.848620 0.330354 -0.124298 -0.130367 -0.899583 -0.617338 0.785951 -0.310911 0.157489 0.054208 0.868424 -0.143229 -0.226823 -0.268159 -0.543685 0.833463 -0.192633 0.531308 0.900333 0.172713 0.028640 -0.603875 0.718056 -0.997655 0.929175 -0.598980 -0.564667 0.183531 -0.203895 0.320102 0.732591 0.707226 -0.345160 -0.789780 -0.361707 0.317240 0.458573 0.830963 -0.431387 0.893648 -0.522004 -0.952099 -0.916484 0.233141 -0.531851 -0.365457 -0.656043 -0.172850 -0.786026 -0.707130 0.943424 -0.849332 -0.253435 -0.006294 0.913374 -0.613273 0.749176 -0.097835 0.449722 -0.692931 -0.883979 0.489319 0.243598 0.522934 0.974927 -0.768586 0.798647 0.726701 0.380278 0.169986 0.841544 -0.055432 0.610332 -0.858570 1.073193 -0.296893 -0.115548 0.015451 -0.916122 0.161234 0.652637 -0.008899 -0.504936 -0.068010 0.429701 0.399113 -0.572860 0.915836 -0.104013 0.624083 -0.134521 0.295231 0.203913 -0.479253 -0.159271 0.735262 0.642890 0.735913 -0.448800 -0.458839 0.777766 0.430172 0.670182 -0.339763 -0.689663 0.053170 -0.193180 0.913474 -0.878349 -0.069615 -0.145079 -0.823686 0.329467 -0.294818 0.392709 0.368922 0.287602 -0.889881 0.108912 0.752905 -0.487900 0.879554 -0.711191 0.729365 -0.024538 -0.771364 0.605736 0.271558 0.006896 -0.020682 -0.014139 0.113688 0.177524 -0.915905 -0.023027 0.032629 -0.714217 -0.890796 0.792155 -0.352004 -0.637552 0.505345 -0.747004 0.517578 0.225260 0.219041 -0.869256 0.454165 0.940973 -0.592327 -0.021240 -0.833911 -0.129431 0.460579 0.851792 -0.513636 0.083659 0.670181 -0.849732 0.626023 -0.180867 0.558032 -0.773109 -0.289669 -0.114559 -0.181679 0.601160 0.053253 0.794969 0.364458 0.190857 0.637928 -0.048897 0.312357 -0.070712 0.781249 0.495441 0.070078 0.847306 -0.191928 0.133380 -0.011733 0.216743 -0.015967 -0.170601 0.292719 0.777689 -0.642360 -0.865868 0.781816 0.652197 0.854766 0.022383 0.692608 0.892301 -0.002742 0.427558)
+ 15.997488 #(0.000000 0.925209 0.360087 -0.109255 -0.863041 -0.029912 -0.483289 0.303463 0.008649 0.031617 0.487041 0.145598 0.992492 -0.713096 0.834493 0.846857 -0.131376 0.542717 0.203811 -0.433766 -0.763755 0.238727 -0.473870 0.868120 -0.040586 -0.462669 0.740771 -0.227132 -0.000692 0.548464 -0.055270 -0.035150 0.172840 -0.630429 -0.054024 -0.934698 -1.031001 0.790052 -0.042240 -0.412997 -0.220043 -0.508562 -0.002888 -0.453454 0.339759 0.518676 0.788804 -0.251741 -0.227551 -0.779613 0.734751 0.789576 0.367904 -0.617440 0.581096 0.338718 0.846175 -1.028326 0.259730 0.848625 0.330154 -0.124923 -0.130656 -0.899763 -0.617228 0.785884 -0.310990 0.157588 0.054106 0.868737 -0.143871 -0.227180 -0.267827 -0.544386 0.833457 -0.192646 0.531361 0.900376 0.172583 0.028556 -0.603550 0.718142 -0.997946 0.928971 -0.598759 -0.564692 0.183693 -0.203720 0.320101 0.732178 0.707159 -0.345178 -0.790224 -0.362108 0.317265 0.458201 0.831535 -0.431642 0.893792 -0.522325 -0.951966 -0.916656 0.233541 -0.532295 -0.365198 -0.656087 -0.172799 -0.786128 -0.707188 0.943130 -0.849431 -0.253384 -0.006071 0.913388 -0.612860 0.748864 -0.097659 0.450043 -0.692859 -0.884034 0.489241 0.243506 0.522701 0.974734 -0.768569 0.798343 0.726708 0.380364 0.170048 0.841302 -0.054785 0.610401 -0.858315 1.073514 -0.296883 -0.115618 0.015515 -0.916509 0.161588 0.652650 -0.008712 -0.505409 -0.067911 0.429313 0.399063 -0.573262 0.915841 -0.103864 0.624139 -0.134372 0.295426 0.204203 -0.479147 -0.159602 0.734669 0.642734 0.736135 -0.448600 -0.458950 0.777967 0.430117 0.669953 -0.339677 -0.689474 0.053281 -0.192783 0.913617 -0.878687 -0.069834 -0.145159 -0.823861 0.329716 -0.294470 0.392295 0.367988 0.287467 -0.889937 0.108498 0.753099 -0.487972 0.879263 -0.711295 0.729063 -0.025027 -0.771617 0.605944 0.271222 0.007411 -0.020393 -0.014302 0.113553 0.177385 -0.916189 -0.023264 0.032699 -0.714380 -0.890488 0.792318 -0.352445 -0.636838 0.505157 -0.746916 0.517505 0.224781 0.219031 -0.868947 0.454389 0.941008 -0.592372 -0.021442 -0.833651 -0.129261 0.460929 0.851936 -0.513944 0.084364 0.670315 -0.849612 0.625818 -0.181003 0.557575 -0.773073 -0.289191 -0.114786 -0.181584 0.600972 0.053488 0.794901 0.364604 0.191088 0.638262 -0.049402 0.312362 -0.070807 0.780925 0.495453 0.069458 0.847189 -0.191235 0.133528 -0.011930 0.216808 -0.015570 -0.171022 0.292597 0.777578 -0.642052 -0.866010 0.781770 0.651970 0.854285 0.022232 0.692772 0.892370 -0.002656 0.427419)
)
;;; 512 all -------------------------------------------------------------------------------- (22.627)
(vector 512 34.212551772691 #r(0 0 1 1 0 0 0 0 1 0 0 0 1 0 0 1 0 0 1 1 0 0 1 1 1 0 1 1 1 0 0 1 1 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 0 0 1 0 0 1 1 0 0 1 0 0 0 1 0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 0 1 0 0 0 1 0 1 1 1 1 1 0 1 1 0 1 1 1 1 0 0 0 0 0 0 1 1 1 0 0 1 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 1 0 1 1 0 0 1 1 1 0 0 1 0 1 1 0 0 1 0 1 0 0 1 1 1 0 1 0 0 1 0 0 1 0 0 0 1 0 1 1 0 0 0 1 1 1 0 0 0 0 1 1 1 0 1 0 0 1 1 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0 1 1 1 0 0 0 0 0 0 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 1 1 0 0 1 0 1 1 1 1 0 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 1 0 0 1 1 1 1 0 0 0 1 0 0 0 1 1 1 0 0 1 0 0 0 0 0 0 1 1 0 0 0 0 0 0 1 0 0 0 1 0 0 1 0 1 0 1 1 1 1 0 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 1 1 0 0 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 1 0 1 1 1 0 1 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 0 1 1 0 1 0 1 1 0 0 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 0 0 0 0 1 1 0 0 0 0 1 0 1 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 1 0 1 1 0 1 1 1 0 0 1 1 1 1 1 0 0 0 0 1 1 0 0 0 0 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1)
;; from (try-all :all 512 513 1.0491155462743 0.38189660798029) = 28.3830
- 23.415771 #(0.000000 0.420972 1.627139 1.354101 1.822609 1.126260 0.765932 1.226925 0.489851 0.133351 0.658718 1.855649 1.533156 0.051246 1.244255 0.942130 1.505634 0.634183 0.345555 0.894394 0.018950 1.772187 0.334727 1.441725 1.195838 1.730772 0.868778 0.680680 1.150477 0.344425 0.172959 0.590283 1.809967 1.685703 0.133094 1.329250 1.160232 1.734353 0.857988 0.640051 1.298084 0.355543 0.134424 0.792758 1.886329 1.647892 0.230211 1.379655 1.190981 1.702805 0.939432 0.795897 1.222066 0.500808 0.402899 0.825396 0.083917 -0.009679 0.493074 1.665893 1.562887 0.084725 1.197793 1.087009 1.624492 0.734519 0.632604 1.128384 0.327245 0.234189 0.787731 -0.004819 1.903376 0.545482 1.720595 1.569821 0.201180 1.342058 1.234856 1.768831 0.928963 0.845541 1.349338 0.587136 0.474177 1.008870 0.363393 0.155223 0.738603 0.072769 1.864626 0.443380 1.680295 1.616526 0.138144 1.333844 1.382520 1.841567 1.018809 1.098101 1.605617 0.784894 0.778874 1.364245 0.590050 0.490550 1.116143 0.369407 0.295902 0.853202 0.107947 0.068317 0.613221 1.826654 1.807727 0.371075 1.629025 1.587498 0.162697 1.500653 1.381877 1.951021 1.308982 1.157899 1.810715 1.098355 1.003711 1.656890 0.941769 0.886901 1.441208 0.777453 0.773841 1.296841 0.543725 0.615942 1.136175 0.431077 0.426269 0.927540 0.316302 0.324334 0.892744 0.164214 0.212792 0.830178 0.044289 0.042589 0.633813 0.000969 1.977937 0.583541 1.949451 1.966100 0.581308 1.826111 1.888961 0.450289 1.757808 1.814797 0.363397 1.811587 1.750630 0.375943 1.770221 1.630064 0.350652 1.574577 1.602901 0.341519 1.545497 1.688317 0.369148 1.689845 1.706237 0.327468 1.779665 1.612007 0.299262 1.744886 1.619519 0.359133 1.648346 1.678634 0.360387 1.668135 1.687260 0.347375 1.767030 1.758428 0.466550 1.800917 1.829812 0.605250 1.811868 1.909595 0.598558 1.922999 -0.027654 0.625937 0.087763 0.135560 0.797047 0.258814 0.263199 0.910225 0.283815 0.321213 0.993695 0.328825 0.376193 1.153774 0.532433 0.549527 1.365514 0.751632 0.739810 1.501215 0.875524 0.978132 1.655105 1.008558 1.112094 1.804824 1.236625 1.254985 -0.017817 1.405616 1.326990 0.093587 1.523731 1.633977 0.379838 1.675374 1.841782 0.610497 0.037534 0.209449 0.895228 0.310571 0.268628 1.028138 0.586364 0.611623 1.346884 0.738484 0.777326 1.620457 1.022095 1.291352 1.973319 1.285772 1.372711 0.120413 1.666847 1.732519 0.427302 1.873456 -0.120568 0.706805 0.212927 0.352427 1.133558 0.431370 0.583366 1.435618 0.907174 0.969499 1.733971 1.203253 1.321888 0.082557 1.615212 1.680389 0.523879 1.962220 0.053732 0.844649 0.272909 0.393299 1.252941 0.644223 0.719664 1.480861 1.030704 1.265734 0.047147 1.549762 1.608049 0.460856 1.870276 0.146004 0.867237 0.490927 0.510046 1.433483 0.746249 0.889451 1.681733 1.253682 1.471945 0.308717 1.774109 1.825193 0.636255 0.078274 0.378641 1.104822 0.843046 0.850566 1.768081 1.165185 1.223144 0.098293 1.585143 1.870402 0.763420 0.320293 0.349074 1.324887 0.604401 0.950328 1.776561 1.299158 1.515080 0.306026 1.948557 -0.032017 0.889992 0.321810 0.616996 1.364315 1.058122 1.210272 0.079647 1.609813 1.715656 0.732506 0.211699 0.465878 1.229742 0.712690 1.064777 1.875316 1.521786 1.506735 0.421975 -0.094779 0.260127 1.015647 0.688882 0.807993 1.695998 1.338444 1.483831 0.407174 1.893530 0.187998 1.166463 0.737897 0.931690 1.828367 1.366869 1.591217 0.513283 0.002888 0.236196 1.171683 0.814726 0.967542 1.855513 1.416050 1.649388 0.581253 0.203339 0.472687 1.382509 0.841481 1.164235 0.086792 1.757164 1.990615 0.873808 0.423601 0.668423 1.642567 1.279971 1.495332 0.447265 0.008141 0.363001 1.186719 0.785619 1.022890 -0.072894 1.604411 1.861784 0.701510 0.469201 0.626626 1.646558 1.159245 1.510579 0.571495 0.173708 0.396747 1.250996 0.849889 1.296361 0.233260 1.912936 0.013994 1.019998 0.658258 0.964505 0.009224 1.607370 1.913937 0.933096 0.382472 0.793360 1.750507 1.447606 1.724624 0.590859 0.197451 0.480188 1.472946 1.189761 1.473590 0.445293 0.076345 0.421948 1.449274 1.215007 1.441696 0.368990 0.034305 0.348862 1.338055 0.977946 1.354469 0.306368 -0.097466 0.277509 1.283023 0.983090 1.308471 0.314454 0.080043 0.297430 1.330621 0.959292 1.379645 0.420083 0.065740 0.469675 1.358281 1.080776 1.380908 0.388623 0.246089 0.418198 1.477919 1.070119 1.403491 0.555913 0.197244 0.569914 1.638518 1.152165 1.685219 0.671138 0.382287 0.734209 1.745424 1.589750 1.901323 0.869840 0.630448 0.983800 0.050064 1.709590 0.137256 1.183118 0.835723 1.211884 0.303631 0.032261 0.397028 1.431432 1.184321 1.557119 0.546926 0.341133 0.810331 1.836671 1.615299 1.984480 1.022869 0.770079 1.146312 0.268820 0.024024 0.443575 1.553100 1.313488 1.780883 0.818958 0.508729 1.001864 0.103635)
+ 23.405314 #(0.000000 0.420742 1.627318 1.353046 1.823145 1.127210 0.765871 1.225027 0.491047 0.134541 0.657692 1.859410 1.534317 0.049699 1.242637 0.943374 1.506678 0.637069 0.345423 0.892222 0.018089 1.771172 0.335617 1.444607 1.195539 1.728646 0.867418 0.684584 1.149309 0.343702 0.176483 0.589575 1.810118 1.688369 0.136247 1.328783 1.161144 1.736562 0.860520 0.640946 1.297506 0.357726 0.134948 0.790903 1.889381 1.651081 0.232513 1.379189 1.191290 1.702348 0.940591 0.794540 1.221245 0.503001 0.403376 0.825111 0.084450 -0.007378 0.494104 1.666474 1.562373 0.086615 1.195850 1.084957 1.623730 0.733431 0.634724 1.129335 0.324706 0.233466 0.783981 -0.005428 1.897204 0.547510 1.721935 1.566320 0.201188 1.341079 1.235608 1.766433 0.927625 0.845929 1.349497 0.587768 0.477050 1.008479 0.363206 0.156461 0.738687 0.073305 1.864952 0.444964 1.681960 1.616315 0.140636 1.337034 1.385871 1.841054 1.019889 1.100036 1.606048 0.788124 0.781971 1.365493 0.592730 0.491271 1.112671 0.367442 0.297676 0.850369 0.103157 0.069088 0.613215 1.825603 1.810093 0.372523 1.629670 1.586656 0.161452 1.497374 1.379809 1.950074 1.306058 1.157637 1.812739 1.098553 1.002089 1.660606 0.941448 0.888146 1.440821 0.777143 0.774795 1.297249 0.544989 0.611878 1.136377 0.431743 0.426047 0.928048 0.316693 0.323143 0.891046 0.162943 0.214512 0.831374 0.045111 0.041759 0.636969 0.003512 1.976097 0.583978 1.949345 1.965894 0.582545 1.828839 1.886450 0.452994 1.759803 1.817658 0.367408 1.812448 1.752901 0.376458 1.768044 1.629418 0.352335 1.570743 1.604292 0.344217 1.546462 1.690801 0.369637 1.693530 1.704589 0.330445 1.780226 1.610915 0.299015 1.743792 1.616818 0.359768 1.649862 1.678569 0.361045 1.665729 1.689924 0.348287 1.765647 1.758949 0.464903 1.802141 1.830982 0.605178 1.809846 1.912381 0.597960 1.923917 -0.025556 0.627120 0.086556 0.132689 0.798441 0.257409 0.262517 0.910423 0.282422 0.321872 0.994101 0.329321 0.375036 1.150973 0.532118 0.546279 1.368762 0.750862 0.740564 1.500080 0.872993 0.975397 1.655760 1.007715 1.113775 1.804496 1.233990 1.254137 -0.016370 1.406138 1.325056 0.092898 1.524923 1.634778 0.378169 1.673863 1.841044 0.609533 0.036584 0.205986 0.895711 0.311144 0.270024 1.027045 0.586138 0.610687 1.348070 0.739015 0.775773 1.620714 1.025414 1.294419 1.972182 1.282444 1.370438 0.117944 1.667759 1.732835 0.426320 1.873394 -0.121920 0.707494 0.210871 0.350311 1.136725 0.432156 0.581355 1.436954 0.906057 0.971535 1.736371 1.201992 1.320200 0.081953 1.617078 1.678719 0.526263 1.963031 0.056435 0.843549 0.272488 0.392909 1.252925 0.644792 0.713966 1.480261 1.028332 1.268781 0.047855 1.552154 1.607549 0.459664 1.869592 0.147715 0.865200 0.489321 0.511516 1.433387 0.747718 0.889861 1.680715 1.251179 1.471437 0.307325 1.774872 1.823046 0.635101 0.078547 0.376712 1.105325 0.843268 0.850506 1.767723 1.166453 1.222281 0.099172 1.582221 1.873637 0.763246 0.321215 0.350526 1.327243 0.606866 0.950435 1.775828 1.299644 1.518343 0.305273 1.949108 -0.031952 0.891027 0.323733 0.617543 1.362420 1.057080 1.213228 0.078672 1.610987 1.715224 0.731095 0.211793 0.467013 1.226751 0.712443 1.067386 1.875308 1.520028 1.502977 0.424426 -0.093340 0.261182 1.014722 0.689663 0.808099 1.697247 1.337526 1.483055 0.410284 1.895083 0.191935 1.166109 0.740296 0.933410 1.827659 1.366645 1.590135 0.510604 0.000547 0.234654 1.171503 0.813018 0.966937 1.857314 1.416593 1.648454 0.581904 0.202646 0.473989 1.381748 0.842592 1.164564 0.084168 1.754984 1.994208 0.873313 0.422599 0.667083 1.640416 1.277845 1.497116 0.450810 0.008516 0.359805 1.184466 0.786945 1.024066 -0.073486 1.605191 1.861846 0.701256 0.470286 0.626892 1.647182 1.157953 1.509397 0.571879 0.172297 0.399713 1.250744 0.850598 1.298686 0.237391 1.914510 0.011925 1.017216 0.659409 0.963037 0.007977 1.606033 1.913976 0.932366 0.380675 0.794769 1.750373 1.449793 1.726549 0.589862 0.196649 0.483399 1.472437 1.189448 1.471980 0.446554 0.075122 0.419863 1.449112 1.217149 1.441017 0.368516 0.034336 0.350673 1.340618 0.979825 1.355225 0.305417 -0.100273 0.279074 1.284339 0.987664 1.309141 0.316466 0.082547 0.298121 1.331784 0.957098 1.378995 0.418607 0.066111 0.467475 1.357153 1.080465 1.381211 0.386161 0.247078 0.418249 1.478519 1.069839 1.401225 0.556393 0.195249 0.569213 1.637483 1.152062 1.687403 0.673428 0.383558 0.734017 1.747107 1.590461 1.901742 0.869848 0.631936 0.984837 0.048267 1.714470 0.137708 1.183955 0.832497 1.211035 0.302866 0.034707 0.397678 1.430516 1.188174 1.553525 0.545876 0.342098 0.810137 1.839022 1.614946 1.982275 1.022490 0.769396 1.144412 0.270021 0.024505 0.444397 1.550066 1.314398 1.781512 0.816984 0.507047 1.000399 0.102276)
)
;;; 1024 all -------------------------------------------------------------------------------- (32)
(vector 1024 54.490282136658 #r(0 0 0 1 0 1 0 1 1 1 0 1 0 1 1 1 0 1 0 0 0 1 1 0 0 1 1 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 0 1 1 1 1 0 0 1 0 0 0 0 1 0 1 0 0 1 0 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 1 1 0 0 0 1 1 0 1 0 0 0 0 0 1 0 1 1 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 1 0 1 0 1 1 1 1 0 1 1 1 1 1 1 1 0 1 0 1 0 1 0 0 0 1 1 1 1 1 1 1 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 0 0 0 1 1 0 0 0 1 0 0 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 1 0 1 1 0 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 1 0 1 1 0 0 1 1 1 0 0 1 1 0 0 0 1 1 0 1 1 1 0 1 1 1 1 1 1 1 1 1 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 1 1 0 1 1 1 1 1 1 0 0 0 0 0 1 0 0 0 1 0 0 1 0 0 0 0 0 1 1 0 0 1 1 1 1 0 0 0 0 1 1 1 1 0 0 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 0 1 0 1 1 1 1 0 1 0 1 0 1 0 0 1 1 1 0 0 0 0 1 1 0 0 1 0 0 1 0 0 1 1 0 0 0 0 1 1 0 0 0 1 1 1 1 0 1 1 0 0 1 1 1 1 1 1 0 1 1 0 0 0 0 0 1 1 0 1 0 1 0 0 0 1 0 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 0 1 1 0 0 0 0 1 1 1 0 1 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 0 1 0 0 1 0 0 0 1 0 1 1 0 1 1 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 1 1 0 0 0 0 1 0 1 1 0 1 0 1 1 0 0 0 0 0 0 1 1 0 0 0 0 0 1 1 0 0 0 1 0 0 1 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 1 0 1 0 1 0 1 1 0 0 0 1 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 0 0 0 1 0 1 1 1 1 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 1 1 0 0 0 1 0 1 1 1 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 0 1 0 0 0 1 1 0 0 1 1 0 1 0 1 0 1 1 1 0 1 1 0 0 1 1 0 1 0 0 0 1 0 0 1 1 0 0 0 1 1 1 0 0 1 0 1 0 0 0 0 1 0 0 1 1 0 1 0 1 1 1 1 0 1 0 0 1 1 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 1 1 1 1 0 0 1 0 1 1 0 1 0 0 0 1 1 1 0 1 0 1 0 1 0 0 1 1 1 0 1 0 0 1 1 1 0 1 1 1 1 0 0 1 1 1 0 0 1 0 0 0 1 1 1 0 1 0 1 1 0 0 1 0 1 0 1 1 1 1 1 0 0 0 1 1 1 0 0 0 0 1 1 1 0 1 1 0 1 0 0 1 1 0 0 0 1 1 0 1 1 0 0 0 0 1 1 1 0 0 0 1 1 0 1 1 1 0 0 0 0 1 0 0 0 1 0 1 1 1 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 0 0 1 0 0 1 1 1 0 0 1 1 0 1 1 0 0 1 0 0 1 1 0 0 0 1 0 1 1 0 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 0 0 0 1 1 0 1 0 0 1 1 1 0 0 0 0 0 0 1 0 1 0 0 1 0 1 1 0 1 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0 0 1 0 1 1 0 1 1 1 1 0 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 1 0 0 0 1 0 1 0 1 1 1 1 0)
;; from (try-all :all 1024 1025 0.0030465754082342 1.0966230312279) = 39.6408 -- starting point for next
- 33.340007 #(0.000000 0.252269 0.590828 0.994887 1.359048 1.684721 0.070907 0.453530 0.796038 1.189302 1.577908 1.940576 0.306581 0.749523 1.053967 1.461358 1.818593 0.238534 0.533583 0.938628 1.342005 1.756655 0.086928 0.555636 0.907200 1.311910 1.643548 0.097011 0.474305 0.870710 1.280393 1.740808 0.203215 0.591686 1.017425 1.386448 1.858864 0.251137 0.617732 1.088895 1.504421 1.957386 0.360246 0.832606 1.263770 1.707814 0.108365 0.583073 1.043103 1.433282 1.903478 0.328336 0.784264 1.270729 1.720181 0.125593 0.585027 1.047740 1.448506 1.933572 0.421468 0.903408 1.335030 1.850492 0.329729 0.858342 1.270650 1.749237 0.251328 0.683221 1.217944 1.718425 0.174340 0.635471 1.165141 1.642852 0.139152 0.620485 1.087487 1.605562 0.097647 0.579288 1.121704 1.650257 0.153564 0.714584 1.193636 1.701640 0.281663 0.781138 1.316342 1.817766 0.291134 0.849276 1.369003 1.911519 0.440699 0.975960 1.488826 0.045864 0.603906 1.167532 1.701920 0.261869 0.808426 1.333965 1.850481 0.429421 0.989431 1.556608 0.118328 0.632837 1.255433 1.824929 0.392971 0.969539 1.501379 0.124987 0.731940 1.271495 1.842455 0.405279 1.046487 1.579816 0.181520 0.808607 1.386996 0.003149 0.564629 1.189594 1.801263 0.390629 0.990431 1.614889 0.210388 0.780982 1.381269 0.002784 0.603793 1.234714 1.862957 0.533885 1.130508 1.745877 0.421420 1.018908 1.622124 0.267271 0.904765 1.531462 0.167717 0.864598 1.486275 0.136538 0.777102 1.391173 0.035750 0.665736 1.357747 -0.028815 0.675066 1.344746 0.013621 0.728672 1.360861 0.014282 0.669625 1.352910 -0.002905 0.650591 1.359740 0.014528 0.678157 1.413571 0.082010 0.791370 1.490294 0.156745 0.841897 1.537067 0.216174 0.944263 1.655383 0.335541 1.056073 1.750407 0.481090 1.229828 1.955901 0.647017 1.334982 0.013096 0.753096 1.493488 0.235071 0.989592 1.679687 0.444571 1.145720 1.878198 0.548671 1.300854 0.095103 0.836488 1.600503 0.328534 1.032816 1.819975 0.557109 1.341511 0.080725 0.788811 1.561199 0.370076 1.109912 1.899485 0.647338 1.410009 0.165243 0.928376 1.745535 0.478727 1.325981 0.052931 0.852469 1.627999 0.429483 1.254064 0.032335 0.795741 1.564126 0.348410 1.150200 0.001820 0.797946 1.564815 0.396072 1.187711 -0.014956 0.838149 1.632563 0.456999 1.271698 0.058685 0.915152 1.735195 0.558649 1.391374 0.204142 1.057193 1.895610 0.709067 1.572992 0.418080 1.215210 0.029279 0.897296 1.791314 0.624777 1.494417 0.318085 1.173817 0.047917 0.911985 1.792834 0.665067 1.473924 0.330581 1.194235 0.074467 0.981260 1.814712 0.673439 1.557491 0.439810 1.309718 0.222488 1.115578 0.007239 0.846351 1.747727 0.664079 1.573411 0.454231 1.360493 0.277992 1.147972 0.044760 0.928949 1.818264 0.737763 1.706580 0.640435 1.520842 0.410166 1.340467 0.315589 1.223574 0.142561 1.081772 -0.018666 0.936014 1.855865 0.821129 1.719805 0.673297 1.627617 0.547512 1.477344 0.472770 1.439684 0.367720 1.320421 0.260885 1.238593 0.181404 1.138221 0.130048 1.073178 0.042071 0.988120 -0.004514 0.932671 1.888952 0.928446 1.893601 0.824317 1.833600 0.884473 1.823398 0.748957 1.790801 0.780961 1.798257 0.757647 1.770781 0.797482 1.785481 0.741730 1.770474 0.794163 1.785589 0.804798 1.808651 0.838722 1.868473 0.877932 1.880911 0.918231 -0.014253 0.956604 0.030035 1.058149 0.072729 1.092658 0.112226 1.146721 0.178297 1.266810 0.273869 1.348472 0.376143 1.419893 0.468973 1.601752 0.589799 1.641091 0.774589 1.783918 0.819593 1.892672 0.972202 0.057976 1.104276 0.187165 1.264627 0.324238 1.424586 0.523836 1.598567 0.674090 1.710471 0.856792 1.948985 1.035222 0.174501 1.252778 0.336429 1.455775 0.496914 1.599007 0.740011 1.842844 0.979025 0.068802 1.192073 0.312229 1.357986 0.528716 1.674107 0.803971 1.907933 1.043283 0.152665 1.297317 0.431787 1.600612 0.711420 1.828071 1.009519 0.151515 1.248902 0.411205 1.575668 0.779076 1.901574 1.064056 0.219728 1.354374 0.497491 1.678337 0.831523 0.008628 1.166472 0.313872 1.495293 0.655442 1.855274 1.021811 0.220984 1.436884 0.582010 1.751513 0.964333 0.118612 1.298395 0.558553 1.731785 0.918721 0.111603 1.346175 0.553931 1.746095 0.934546 0.121479 1.392563 0.614916 1.780041 1.018274 0.224983 1.465968 0.685503 1.907317 1.124026 0.360855 1.641567 0.874696 0.062191 1.290422 0.553651 1.778275 1.007949 0.272518 1.511215 0.762412 0.029044 1.273777 0.484653 1.727630 1.017026 0.263777 1.520403 0.797751 0.043030 1.305475 0.613503 1.881943 1.151373 0.430416 1.679656 1.005985 0.303225 1.551000 0.829279 0.168526 1.451352 0.700222 -0.029547 1.272285 0.599893 1.861684 1.197829 0.516750 1.767686 1.101025 0.388135 1.703473 1.065271 0.323477 1.604197 0.960130 0.281789 1.581409 0.933246 0.273577 1.573406 0.913462 0.290612 1.570381 0.931821 0.267802 1.579541 0.966804 0.292938 1.619856 0.993340 0.309470 1.657166 1.000050 0.429762 1.755838 1.058027 0.416953 1.800672 1.183880 0.581858 1.922587 1.270163 0.657427 0.052208 1.404254 0.744124 0.171435 1.554378 0.969529 0.316283 1.683259 1.098306 0.473515 1.825000 1.290695 0.671100 0.060471 1.462270 0.895317 0.275425 1.707012 1.097391 0.541000 1.935864 1.347378 0.744565 0.166661 1.586179 1.012344 0.440924 1.848288 1.291090 0.702026 0.108396 1.615165 1.026409 0.486835 1.882944 1.345344 0.740036 0.271378 1.682166 1.142431 0.583086 0.025848 1.499539 0.922278 0.407328 1.883486 1.377596 0.805432 0.262056 1.730217 1.189156 0.698109 0.175581 1.605225 1.117070 0.625259 0.096284 1.558728 1.046545 0.565363 0.006896 1.532998 0.977232 0.493874 0.019923 1.521982 1.044725 0.504392 0.032980 1.535315 1.040156 0.584838 0.067366 1.579334 1.096886 0.648588 0.166277 1.660696 1.196777 0.745800 0.244448 1.792685 1.306736 0.852386 0.403378 1.914699 1.507026 0.985958 0.530153 0.096414 1.629670 1.232632 0.752292 0.321154 1.869873 1.434329 1.006314 0.587221 0.126427 1.633322 1.250405 0.781526 0.394867 1.983608 1.520336 1.180732 0.723309 0.287019 1.857147 1.412415 1.029040 0.623603 0.193448 1.815361 1.405135 0.996541 0.627145 0.198255 1.824503 1.366660 1.005067 0.636464 0.268203 1.866235 1.459138 1.105165 0.667080 0.366091 1.949219 1.537137 1.165333 0.814673 0.422816 0.111016 1.750975 1.348291 1.019137 0.606129 0.251319 1.902811 1.525082 1.169236 0.827850 0.505272 0.183608 1.829362 1.501991 1.149161 0.821853 0.430362 0.160486 1.805123 1.439374 1.131145 0.781555 0.447532 0.125873 1.862472 1.510116 1.222183 0.897453 0.553805 0.255014 1.923724 1.643455 1.338025 1.035941 0.711845 0.404046 0.112579 1.812346 1.574519 1.218776 0.940653 0.625152 0.408253 0.061333 1.811142 1.480483 1.240166 0.958281 0.681899 0.431645 0.152108 1.857113 1.603531 1.374452 1.070754 0.862840 0.554212 0.357560 0.051735 1.783132 1.501842 1.324038 1.022839 0.808375 0.564292 0.269808 0.099947 1.780168 1.580476 1.360809 1.095592 0.904490 0.694788 0.422065 0.181952 0.007255 1.740293 1.541763 1.378118 1.130775 0.922257 0.714793 0.502430 0.302269 0.063718 1.849896 1.739107 1.451550 1.281882 1.101827 0.898773 0.698850 0.504087 0.285002 0.139429 -0.009542 1.748450 1.587717 1.418469 1.261180 1.014459 0.927762 0.709263 0.555124 0.406294 0.215730 0.086721 1.967080 1.762864 1.620390 1.423142 1.307319 1.089239 0.966567 0.817947 0.676255 0.549794 0.433950 0.271882 0.165900 -0.016930 1.871907 1.711612 1.635342 1.472897 1.432211 1.199146 1.125404 0.997980 0.869030 0.723533 0.649389 0.501165 0.379779 0.303965 0.167299 0.043634 1.954030 1.878032 1.787485 1.658925 1.629449 1.505132 1.446404 1.398647 1.281307 1.172894 1.087686 1.017708 0.871345 0.831376 0.733586 0.746175 0.641963 0.526676 0.513717 0.447134 0.406051 0.223368 0.270628 0.175327 0.125934 0.011712 -0.000851 -0.004141 1.949804 1.858782 1.795380 1.773772 1.765390 1.725738 1.644068 1.608178 1.601848 1.590570 1.510185 1.534885 1.457274 1.449675 1.423890 1.447991 1.450821 1.384697 1.403240 1.413473 1.397653 1.365481 1.389579 1.350423 1.317991 1.341171 1.369367 1.376766 1.385962 1.388396 1.381704 1.416508 1.475869 1.430329 1.443510 1.472963 1.450539 1.470046 1.510735 1.536932 1.570484 1.569326 1.662659 1.691506 1.719949 1.813440 1.816308 1.911226 1.887360 1.961530 -1.792537 0.053661 0.115257 0.166481 0.233911 0.310188 0.325068 0.431757 0.460230 0.497292 0.617591 0.669160 0.713580 0.784354 0.875202 0.944862 1.026641 1.045786 1.173338 1.308607 1.409905 1.450957 1.609941 1.669019 1.764640 1.859890 1.980033 0.037526 0.166611 0.250009 0.350054 0.469000 0.588648 0.736584 0.804951 0.959125 1.068863 1.219010 1.314442 1.444976 1.599024 1.675532 1.812178 1.964033 0.114219 0.204096 0.320624 0.448877 0.632063 0.767395 0.893517 1.060402 1.163237 1.370645 1.482403 1.639743 1.797877 -0.032505 0.164252 0.381485 0.507256 0.639171 0.846588 1.017154 1.215084 1.430076 1.565557 1.769839 1.944446 0.039879 0.299829 0.471992 0.648375 0.816027 1.061196 1.227314 1.352891 1.601369 1.737855 -0.030116 0.193774 0.373048 0.579901 0.821618 1.021072 1.251676 1.456289 1.642276 1.875895 0.139645 0.373363 0.580016 0.844791 1.093492 1.314337 1.565715 1.784411 -1.711801 0.199266 0.510714 0.713847 0.947353 1.153945 1.372542 1.701941 1.871791 0.184883 0.442933 0.691746 0.983323 1.192165 1.480252 1.752492 0.030706 0.313650 0.557482 0.801654 1.082848 1.361390 1.610297 1.911802 0.209797 0.451108 0.808958 1.120683 1.407421 1.708141 0.012298 0.315962 0.614414 0.934810 1.209210 1.544697 1.851261 0.138324 0.500159 0.747587 1.073170 1.395149 1.654596 -0.007332 0.329201 0.713742 1.030039 1.350535 1.698612 0.089036)
+ 33.327699 #(0.000000 0.251939 0.591787 0.994875 1.359261 1.685436 0.068383 0.452706 0.792638 1.188232 1.577674 1.939721 0.307917 0.747858 1.052252 1.462160 1.820261 0.235412 0.535414 0.939270 1.340766 1.757816 0.085026 0.555749 0.906510 1.309843 1.645826 0.097070 0.473189 0.872948 1.282503 1.740808 0.205266 0.592960 1.014563 1.387208 1.857337 0.250965 0.618905 1.090026 1.504554 1.957059 0.362176 0.834433 1.265151 1.710708 0.108932 0.582263 1.043690 1.436689 1.901500 0.325535 0.782441 1.269233 1.718053 0.125614 0.582162 1.048275 1.447760 1.934499 0.420190 0.902656 1.337000 1.851204 0.331610 0.861417 1.269397 1.748897 0.249747 0.682087 1.218577 1.721503 0.171686 0.634824 1.165967 1.644360 0.137736 0.621996 1.088086 1.604010 0.099196 0.578332 1.119472 1.650307 0.151523 0.715196 1.194997 1.701230 0.280871 0.782568 1.317499 1.820158 0.290777 0.850871 1.367812 1.912162 0.439362 0.974306 1.492706 0.045483 0.605066 1.171414 1.698370 0.261626 0.806782 1.336523 1.852127 0.431755 0.989343 1.555772 0.117593 0.633194 1.252774 1.822192 0.395027 0.968045 1.504568 0.124585 0.732314 1.269851 1.840352 0.406892 1.048370 1.580848 0.179250 0.808405 1.387540 0.002064 0.562409 1.188718 1.803164 0.393160 0.990738 1.613847 0.209832 0.781115 1.381879 0.001572 0.605537 1.235122 1.862722 0.531292 1.130073 1.745833 0.419636 1.021210 1.623009 0.268467 0.906650 1.529329 0.165655 0.863647 1.490122 0.136799 0.777139 1.392133 0.035616 0.666068 1.356775 -0.031254 0.675771 1.344644 0.015460 0.727375 1.359765 0.014199 0.671938 1.353461 -0.003745 0.650530 1.360635 0.011902 0.679204 1.415278 0.082360 0.791326 1.488696 0.154900 0.843061 1.538222 0.216994 0.946052 1.657378 0.335135 1.052031 1.749960 0.481760 1.228090 1.957293 0.647434 1.336710 0.012572 0.753548 1.494222 0.235574 0.988637 1.678049 0.442856 1.144765 1.876364 0.545577 1.299888 0.093816 0.837151 1.603270 0.331610 1.033623 1.819952 0.555765 1.339016 0.078704 0.786348 1.564182 0.368008 1.110163 1.898534 0.647072 1.409244 0.163954 0.926201 1.743490 0.475097 1.322904 0.054450 0.852835 1.629547 0.429537 1.253705 0.032302 0.797753 1.565090 0.347044 1.151024 0.002011 0.796779 1.563783 0.396822 1.187501 -0.015797 0.836498 1.633514 0.457172 1.269489 0.058467 0.915331 1.736225 0.560236 1.389792 0.204731 1.057123 1.895846 0.711311 1.576193 0.418365 1.217045 0.031145 0.893108 1.790767 0.626588 1.494324 0.320013 1.173245 0.050645 0.912841 1.791973 0.663103 1.475602 0.333571 1.196429 0.076271 0.977043 1.814761 0.674034 1.556444 0.441292 1.310098 0.223342 1.114205 0.010852 0.848217 1.748387 0.663023 1.574208 0.455108 1.358865 0.276929 1.147143 0.047699 0.925922 1.820095 0.735083 1.706065 0.641572 1.522063 0.411781 1.340714 0.315547 1.222655 0.143463 1.081232 -0.017197 0.935949 1.854101 0.820797 1.718207 0.672573 1.626160 0.548645 1.478526 0.471391 1.441835 0.369822 1.321497 0.264146 1.238598 0.180760 1.137893 0.131339 1.072924 0.039736 0.987651 -0.003817 0.933552 1.889951 0.929209 1.894420 0.824038 1.832090 0.885701 1.822934 0.749476 1.793295 0.782374 1.798883 0.753940 1.768050 0.797886 1.786649 0.742875 1.772486 0.793734 1.787516 0.806526 1.808485 0.835681 1.871648 0.878753 1.882881 0.919300 -0.010955 0.955517 0.028140 1.059567 0.071582 1.092311 0.112946 1.146197 0.178284 1.267365 0.272421 1.349572 0.372790 1.420349 0.468153 1.599166 0.588953 1.641705 0.772949 1.784681 0.819747 1.893503 0.971545 0.057218 1.106608 0.188947 1.263131 0.321938 1.426824 0.525150 1.599045 0.676378 1.709110 0.856777 1.946007 1.035759 0.172607 1.253130 0.337384 1.456086 0.496385 1.597254 0.740936 1.846365 0.978653 0.067502 1.190272 0.313545 1.360476 0.529111 1.672124 0.802916 1.905934 1.042497 0.152988 1.298069 0.430494 1.599959 0.709102 1.826958 1.011050 0.153628 1.249049 0.414434 1.577027 0.779234 1.901822 1.064280 0.221568 1.353960 0.497457 1.677228 0.831634 0.008057 1.166469 0.312984 1.496017 0.655802 1.853575 1.017752 0.222854 1.437165 0.580778 1.751444 0.963827 0.117983 1.298734 0.557930 1.730920 0.920399 0.113557 1.345174 0.551267 1.743969 0.935328 0.122849 1.392451 0.612989 1.779636 1.017857 0.223818 1.464822 0.684576 1.908560 1.120145 0.359755 1.639859 0.876324 0.059963 1.289925 0.551531 1.779521 1.011322 0.273348 1.512674 0.759645 0.029577 1.274355 0.486779 1.725803 1.020990 0.263341 1.519183 0.797767 0.043072 1.306945 0.616326 1.881354 1.152034 0.430996 1.680135 1.007795 0.302627 1.551482 0.826928 0.170463 1.450879 0.700661 -0.031214 1.273760 0.602222 1.859908 1.195672 0.518106 1.768508 1.099862 0.387096 1.704438 1.063736 0.320288 1.602404 0.958828 0.280145 1.580271 0.928791 0.275380 1.574600 0.914100 0.290242 1.572048 0.932020 0.269022 1.580715 0.966472 0.290208 1.619898 0.995077 0.308808 1.659798 0.999457 0.428574 1.757481 1.057404 0.414297 1.799940 1.182555 0.579808 1.923594 1.269571 0.658502 0.053273 1.403255 0.745158 0.169364 1.555133 0.970162 0.317918 1.685412 1.097767 0.470444 1.824039 1.290206 0.671823 0.059862 1.463225 0.898060 0.276636 1.706733 1.097120 0.540544 1.936291 1.348522 0.742337 0.168039 1.585004 1.012724 0.438556 1.844117 1.288953 0.703502 0.109741 1.615608 1.024464 0.485596 1.881431 1.345893 0.739456 0.270851 1.682911 1.144028 0.582575 0.022656 1.499643 0.921338 0.407573 1.883708 1.375820 0.805252 0.262180 1.728631 1.190004 0.695557 0.174400 1.605372 1.118974 0.623016 0.096881 1.555901 1.048279 0.567636 0.008042 1.534227 0.979264 0.492676 0.018632 1.520821 1.042898 0.502431 0.032747 1.535551 1.039109 0.580940 0.065782 1.579400 1.098690 0.648725 0.166074 1.660492 1.192890 0.744264 0.244349 1.791604 1.304126 0.852772 0.402486 1.910121 1.507888 0.986273 0.531606 0.095731 1.628142 1.234665 0.753598 0.320152 1.869107 1.434145 1.008386 0.587106 0.125562 1.633468 1.250177 0.782177 0.396495 1.982581 1.518954 1.180847 0.723875 0.284885 1.858711 1.410411 1.029087 0.622096 0.193503 1.815790 1.405594 0.996175 0.629563 0.196876 1.825780 1.365472 1.004696 0.635204 0.269472 1.862636 1.460810 1.102680 0.665089 0.363795 1.950315 1.536713 1.168891 0.814168 0.423349 0.110363 1.748447 1.349910 1.017621 0.608206 0.251585 1.903444 1.523242 1.172189 0.823841 0.506713 0.183893 1.831343 1.501914 1.149011 0.819193 0.430480 0.163363 1.805199 1.438522 1.132536 0.781460 0.448314 0.127512 1.862581 1.509353 1.224561 0.896063 0.553453 0.254762 1.925595 1.643803 1.339427 1.037169 0.710621 0.405600 0.112820 1.812964 1.576466 1.219579 0.939945 0.623158 0.408122 0.058381 1.810732 1.480289 1.239333 0.955397 0.679810 0.432479 0.152149 1.857831 1.604402 1.369987 1.071656 0.860472 0.555984 0.357825 0.052491 1.782608 1.504203 1.323645 1.022147 0.808930 0.565308 0.270814 0.100417 1.781052 1.582796 1.363147 1.096527 0.906114 0.693702 0.418587 0.181851 0.008778 1.741727 1.541223 1.378275 1.127503 0.922320 0.714178 0.503781 0.301341 0.063159 1.849554 1.742668 1.453378 1.283569 1.101850 0.898783 0.701855 0.504535 0.288508 0.141853 -0.006942 1.748197 1.588463 1.415402 1.262931 1.012959 0.929614 0.707688 0.550617 0.407225 0.218334 0.086769 1.968351 1.764908 1.619779 1.424754 1.307361 1.090841 0.967215 0.818022 0.677391 0.550424 0.434105 0.269644 0.164782 -0.016829 1.874718 1.713104 1.637015 1.473708 1.431728 1.197034 1.127184 0.998943 0.871457 0.727005 0.651372 0.501426 0.379072 0.303905 0.169657 0.041911 1.954627 1.878256 1.786257 1.657572 1.629688 1.501361 1.445108 1.400006 1.280220 1.172913 1.086706 1.020397 0.870672 0.832976 0.732699 0.746008 0.641646 0.525746 0.517674 0.446468 0.405538 0.224617 0.270770 0.177215 0.125287 0.009340 0.000130 -0.006935 1.950589 1.859621 1.794245 1.772157 1.764794 1.725580 1.643811 1.607587 1.601597 1.589900 1.507948 1.534513 1.455827 1.448792 1.423632 1.448201 1.451493 1.384562 1.401104 1.415334 1.401761 1.366662 1.387553 1.350532 1.318436 1.341996 1.368886 1.377838 1.384554 1.389811 1.381343 1.418413 1.472924 1.434287 1.444579 1.473899 1.449259 1.468727 1.510457 1.536559 1.567816 1.569796 1.662595 1.690932 1.720658 1.810972 1.815383 1.912638 1.886513 1.959782 -1.791612 0.053793 0.113610 0.165452 0.235895 0.309326 0.328636 0.432645 0.461226 0.498857 0.618106 0.670504 0.713825 0.787130 0.875930 0.946335 1.025869 1.042961 1.174177 1.305150 1.409628 1.451823 1.608802 1.670045 1.763083 1.859175 1.981266 0.036123 0.164770 0.246695 0.349794 0.471432 0.586620 0.737258 0.804566 0.959818 1.065672 1.217160 1.315100 1.446063 1.597353 1.676295 1.814676 1.963190 0.111128 0.207311 0.317848 0.451640 0.631289 0.766594 0.894948 1.060943 1.165827 1.368911 1.481914 1.640195 1.795468 -0.031611 0.162601 0.379016 0.508169 0.641151 0.845894 1.018307 1.215348 1.428140 1.566385 1.770011 1.943659 0.041081 0.299350 0.472217 0.646115 0.816234 1.062430 1.229984 1.352522 1.599802 1.736752 -0.027636 0.191010 0.373031 0.578997 0.823971 1.023332 1.254210 1.453883 1.643551 1.877343 0.136959 0.375695 0.578237 0.843461 1.091878 1.313783 1.565402 1.785868 -1.713877 0.199038 0.511477 0.714620 0.948958 1.155131 1.374123 1.703357 1.871897 0.184041 0.441048 0.693484 0.982198 1.190055 1.478497 1.755690 0.029916 0.313378 0.555647 0.800057 1.083755 1.364618 1.610351 1.913254 0.209825 0.453654 0.810047 1.121726 1.407826 1.707998 0.009843 0.315203 0.614881 0.938695 1.209520 1.544918 1.851380 0.139278 0.499347 0.748538 1.073849 1.396578 1.655736 -0.011377 0.332567 0.714551 1.029316 1.350407 1.701323 0.089175)
)
;;; 2048 all -------------------------------------------------------------------------------- (45.254)
(vector 2048 89.570060996356 #r(0 1 1 0 0 1 1 0 0 1 1 1 0 0 0 1 0 0 0 0 1 1 0 1 0 0 1 1 1 0 1 0 1 1 1 0 0 1 0 1 0 0 1 1 0 1 1 0 1 0 1 0 0 0 1 1 1 1 0 0 0 0 1 0 1 1 1 1 0 1 0 0 1 0 1 0 0 1 0 1 1 1 0 0 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 0 0 1 1 0 0 1 0 0 0 0 0 0 0 1 1 1 1 0 0 0 0 1 1 0 0 1 1 1 1 1 1 1 1 0 1 0 0 0 0 1 0 1 0 1 0 1 1 1 1 1 0 1 0 0 0 1 1 0 0 1 1 1 0 0 0 0 1 1 1 0 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 0 1 1 0 0 1 1 0 1 0 0 1 1 1 1 0 1 0 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 0 0 1 0 1 0 1 1 0 1 1 1 0 0 1 1 0 1 1 1 0 1 1 0 1 0 1 1 0 1 0 0 1 1 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 1 0 0 1 0 0 1 1 1 0 1 0 1 0 0 1 1 0 1 1 1 1 0 1 0 1 0 1 0 1 1 1 0 1 0 1 0 1 0 0 1 1 0 1 0 1 1 1 0 1 1 0 1 0 1 0 1 1 1 1 0 1 1 1 1 0 0 0 1 0 0 1 1 0 1 1 0 0 0 0 1 0 0 1 0 1 0 0 0 1 1 0 0 1 1 0 0 1 1 1 0 1 0 0 1 1 0 1 0 1 0 1 0 0 1 1 0 0 1 0 1 1 1 1 0 0 1 0 1 0 1 0 0 1 0 1 1 0 0 1 0 1 1 1 0 0 1 0 1 0 1 1 1 0 1 1 1 1 1 1 0 0 1 0 1 1 1 0 1 0 1 1 0 1 0 1 0 0 1 1 1 1 0 0 0 1 1 1 1 1 0 0 1 0 0 0 0 0 1 1 1 1 0 0 0 1 0 0 1 0 1 0 1 0 0 0 1 0 1 1 1 1 0 0 0 1 1 0 1 0 1 1 0 1 0 1 0 1 0 0 0 0 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 1 0 0 0 0 1 1 0 1 0 0 1 1 0 0 1 1 1 0 0 1 1 1 1 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 1 0 0 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 0 0 1 1 0 0 1 1 0 1 1 1 0 1 1 0 1 1 1 0 0 1 1 0 1 0 1 0 0 1 0 0 1 1 0 1 0 1 0 0 1 0 0 1 1 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 1 0 0 1 0 1 1 1 1 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 1 1 0 0 1 0 1 0 0 1 0 0 1 0 0 0 1 0 0 1 0 1 0 0 1 0 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 0 1 0 0 0 0 0 1 1 1 1 0 0 0 1 1 0 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 1 1 1 0 0 1 1 1 1 0 1 0 1 0 1 0 0 0 0 1 1 0 1 0 1 0 0 0 0 0 0 1 0 1 0 1 1 0 1 0 1 0 1 0 1 0 1 1 1 1 0 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 0 1 1 1 0 1 1 1 1 1 0 1 0 0 0 0 0 1 1 0 0 1 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 1 0 1 0 1 0 1 0 0 0 0 1 0 0 1 1 0 0 1 0 1 1 1 1 1 0 0 1 0 0 0 1 1 1 1 1 0 0 0 0 1 0 0 1 1 0 1 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 1 1 1 0 1 1 1 0 1 1 1 1 1 1 1 0 1 0 0 1 1 0 0 1 1 1 1 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 0 1 1 0 0 1 1 0 1 0 0 1 1 1 0 0 0 1 1 1 0 0 0 0 1 0 0 1 0 0 1 0 1 1 1 1 1 0 0 0 0 0 0 0 1 1 0 1 0 1 1 1 1 1 1 1 1 0 1 1 1 1 0 0 1 0 1 0 1 1 0 1 1 1 1 0 1 0 1 0 0 1 0 1 0 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 1 0 0 1 0 1 1 1 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 1 0 0 0 1 1 0 1 0 0 1 1 0 0 0 0 0 1 1 1 0 0 0 1 1 1 1 0 1 0 0 0 0 0 1 1 1 1 0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 1 0 1 1 1 1 1 1 0 1 1 1 1 0 1 0 0 0 0 1 1 0 0 1 0 0 1 0 1 0 1 1 0 0 1 1 0 1 0 1 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 1 1 0 0 1 0 1 0 0 1 0 0 1 1 1 1 0 0 0 1 0 1 1 0 0 0 0 0 1 0 0 0 0 0 1 0 0 1 0 1 0 1 0 1 0 0 1 0 1 1 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 1 0 0 0 1 0 1 1 0 0 1 1 0 1 0 1 1 0 1 0 0 1 1 0 0 1 0 1 0 1 1 0 0 0 0 0 0 0 0 1 0 0 1 0 0 1 1 0 0 0 0 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 1 0 0 0 0 1 1 1 0 0 0 1 1 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 0 0 0 1 1 0 1 1 1 0 1 0 0 0 0 0 0 0 0 1 0 1 1 0 1 1 1 1 1 1 1 1 1 1 0 0 1 1 0 0 1 1 1 0 0 1 0 1 1 0 1 1 1 1 1 0 1 1 1 0 1 1 0 1 0 0 1 1 0 1 1 1 0 1 1 1 0 0 0 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 1 1 0 1 1 1 1 1 0 0 0 0 0 0 0 1 1 0 1 0 1 0 1 1 0 0 0 0 0 0 1 1 1 1 0 0 1 0 1 0 0 1 0 0 1 1 1 1 0 1 1 0 0 0 0 1 0 0 1 0 0 1 1 0 0 1 0 0 1 0 1 1 1 0 1 0 0 0 0 1 0 1 0 1 1 1 0 1 1 1 1 1 0 0 1 1 1 1 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 0 1 1 0 0 1 1 1 0 1 1 1 0 1 0 1 0 0 1 0 0 1 0 0 1 1 0 1 1 0 0 0 0 0 0 1 0 0 1 1 0 1 0 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 1 0 0 0 0 1 0 1 0 1 0 1 0 1 0 0 1 1 0 1 0 0 1 0 0 0 0 1 0 0 0 0 1 1 1 1 1 0 0 0 1 0 0 0 0 0 1 1 1 1 0 0 0 0 1 0 1 1 0 0 0 1 0 1 1 1 1 0 1 1 1 1 0 0 1 0 0 1 1 1 1 0 0 0 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 1 1 1 1 1 1 1 0 0 1 0 0 0 0 0 0 1 1 1 1 0 0 0 1 0 1 1 0 0 0 0 0 0 1 1 0 1 1 0 0 1 1 0 1 1 0 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1 1 0 1 0 0 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 0 0 1 0 1 1 1 0 0 1 0 0 1 1 0 0 0 0 0 0 1 1 0 1 0 0 1 0 0 0 0 0 1 0 0 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 0 0 0 0 1 0 1 0 0 1 0 0 0 0 1 1 0 0 0 1 1 0 1 1 1 1 0)
;; from (try-all :all 2048 2049 1.0476749041086 0.34832901677121) = 55.7655 start for next
- 49.597757 #(0.000000 0.432865 1.592871 1.324139 1.788221 0.942167 0.643685 1.051045 0.282522 0.026474 0.428400 1.632120 1.318826 1.821120 0.938735 0.685180 1.164104 0.269070 0.040518 0.534459 1.585472 1.363294 1.842902 0.987766 0.775600 1.211716 0.310558 0.080649 0.586517 1.696966 1.455943 1.891139 1.056878 0.859480 1.271186 0.411741 0.218925 0.665278 1.768177 1.533604 0.021164 1.154578 0.897092 1.401276 0.524856 0.295680 0.801109 1.875797 1.691667 0.117511 1.245079 1.026873 1.509419 0.624936 0.412031 0.870360 0.041393 1.773929 0.262128 1.419027 1.172792 1.617850 0.833153 0.564935 1.041197 0.191245 -0.005375 0.435228 1.585742 1.376825 1.781847 1.001829 0.720122 1.225465 0.364498 0.112534 0.656581 1.800538 1.556616 0.053583 1.165896 0.966016 1.457663 0.586645 0.421307 0.868796 1.977304 1.789832 0.223488 1.420761 1.233904 1.686215 0.820974 0.626173 1.103464 0.223436 0.050096 0.530179 1.654756 1.489831 1.932348 1.093464 0.857622 1.372128 0.503735 0.305919 0.828816 1.949337 1.703606 0.245675 1.364030 1.174658 1.685385 0.783632 0.597090 1.107378 0.224457 0.067297 0.498904 1.693619 1.535392 0.001100 1.122466 0.924819 1.422218 0.582022 0.371868 0.883672 0.023121 1.851299 0.347558 1.492791 1.313353 1.780644 0.903790 0.769480 1.228486 0.349181 0.160342 0.723514 1.833797 1.643503 0.152469 1.292314 1.136124 1.585109 0.781677 0.605789 1.024752 0.200509 0.035881 0.545488 1.691727 1.473152 0.009326 1.165324 0.979681 1.472985 0.641008 0.464263 0.916070 0.115193 1.943574 0.470071 1.612905 1.412106 1.906166 1.099734 0.911156 1.445877 0.566995 0.415438 0.903760 0.068012 1.884615 0.361133 1.525102 1.394785 1.866799 1.085049 0.905038 1.343401 0.572999 0.336552 0.840021 0.058006 1.920662 0.419293 1.569314 1.377126 1.892516 1.053725 0.899312 1.382374 0.525629 0.389756 0.915240 0.054554 1.948670 0.432968 1.522295 1.393372 1.927981 1.101207 0.932830 1.420963 0.614510 0.443553 0.957140 0.097162 0.020076 0.491931 1.638578 1.498603 0.034700 1.185623 1.057195 1.570123 0.739618 0.524177 1.087927 0.280667 0.104100 0.634922 1.816392 1.630022 0.177551 1.337197 1.150994 1.738259 0.870029 0.720187 1.256272 0.409065 0.257038 0.726761 1.963048 1.804342 0.360761 1.537930 1.337719 1.844762 1.059764 0.909285 1.418297 0.610902 0.478255 0.989716 0.177245 0.055184 0.519514 1.737980 1.609345 0.124170 1.313347 1.158634 1.696401 0.894021 0.690094 1.250649 0.488164 0.277218 0.839087 -0.015171 1.881248 0.423342 1.578030 1.440523 1.967992 1.124826 1.047153 1.573050 0.745473 0.591794 1.101797 0.310544 0.178288 0.690885 1.866221 1.744743 0.239513 1.466522 1.318725 1.884330 1.039002 0.927125 1.486913 0.680174 0.528995 1.021479 0.250747 0.133926 0.680694 1.869366 1.711636 0.281386 1.427675 1.326563 1.882830 1.053193 0.926175 1.466057 0.682367 0.566146 1.065755 0.292827 0.172581 0.703018 1.907039 1.758235 0.303623 1.502293 1.410303 1.900119 1.083485 1.017339 1.575009 0.721227 0.630154 1.179454 0.388209 0.222690 0.769823 -0.008956 1.890911 0.443026 1.613239 1.445488 0.070601 1.310823 1.138309 1.700026 0.878984 0.755138 1.294973 0.552366 0.381438 0.960518 0.154523 0.054235 0.592109 1.784798 1.682482 0.246240 1.422847 1.310434 1.872185 1.120905 1.001049 1.516015 0.793315 0.649661 1.185249 0.408907 0.280125 0.847968 0.137038 1.943033 0.504327 1.755230 1.582360 0.130331 1.345963 1.261547 1.815327 1.039475 0.962355 1.489561 0.713235 0.640220 1.146346 0.393793 0.307409 0.835620 0.084262 1.960304 0.467383 1.777395 1.651007 0.152565 1.402097 1.314188 1.907657 1.135364 1.002445 1.554772 0.785828 0.681306 1.250456 0.481606 0.349895 0.900041 0.157904 0.034843 0.611277 1.834163 1.718691 0.336544 1.547009 1.424221 -0.027818 1.250987 1.108578 1.703157 0.930093 0.829445 1.431687 0.657083 0.508380 1.149601 0.368943 0.232398 0.837659 0.037487 1.956637 0.493380 1.782438 1.677205 0.258627 1.488171 1.375534 1.954782 1.173234 1.075498 1.644803 0.888310 0.765062 1.358393 0.611283 0.511548 1.066006 0.367096 0.255944 0.813796 0.082435 1.982970 0.551899 1.799859 1.688872 0.243264 1.496914 1.460830 0.036923 1.268960 1.199739 1.786589 0.995545 0.933511 1.493078 0.783647 0.634491 1.224537 0.501414 0.389756 1.017956 0.252159 0.135580 0.773228 -0.002147 1.958828 0.505692 1.738189 1.653701 0.234949 1.455803 1.428102 0.005460 1.247085 1.194008 1.787473 1.038809 0.946584 1.521146 0.768193 0.721450 1.273736 0.568359 0.470034 1.079849 0.325534 0.217136 0.882728 0.093762 0.035384 0.580014 1.857949 1.781207 0.338277 1.626696 1.566042 0.150639 1.389447 1.340871 1.953627 1.195959 1.108090 1.720739 0.931858 0.941045 1.477884 0.776380 0.698054 1.294673 0.551254 0.470567 1.081619 0.367349 0.242482 0.870322 0.123954 0.036747 0.647537 1.948672 1.856099 0.456419 1.690233 1.681655 0.269606 1.526421 1.474191 0.086996 1.321706 1.264523 1.857616 1.130194 1.071740 1.689560 0.947994 0.917707 1.542194 0.800078 0.751270 1.317079 0.653810 0.526709 1.174243 0.456859 0.391521 0.973530 0.208335 0.162238 0.774390 0.035275 -0.018889 0.636860 1.894819 1.829627 0.462423 1.753299 1.695016 0.324672 1.549111 1.505836 0.105156 1.365562 1.346178 1.945802 1.223084 1.210056 1.778638 1.030398 1.007469 1.676153 0.906749 0.885713 1.485879 0.755499 0.729408 1.305512 0.614331 0.557092 1.148040 0.431865 0.399300 1.059360 0.336089 0.306346 0.917114 0.195579 0.144273 0.757516 0.042571 -0.026216 0.654405 1.904272 1.878617 0.484079 1.795330 1.720583 0.370211 1.611611 1.577034 0.213189 1.489319 1.461582 0.078736 1.378237 1.315941 1.972831 1.252615 1.219917 1.886490 1.139344 1.124291 1.748944 1.008121 0.973317 1.651139 0.936551 0.896776 1.483480 0.839558 0.803316 1.383311 0.667482 0.691568 1.289156 0.593835 0.549443 1.146408 0.532008 0.450809 1.054655 0.377503 0.379716 0.984180 0.285225 0.261050 0.892660 0.181029 0.154607 0.800004 0.118378 0.063255 0.701146 -0.025117 -0.000001 0.629976 1.928075 1.906244 0.526129 1.822998 1.825327 0.415850 1.740871 1.767294 0.335590 1.680808 1.646106 0.306851 1.613519 1.581911 0.243532 1.540895 1.492136 0.148406 1.453907 1.376813 0.080748 1.397305 1.348964 -0.011207 1.311590 1.307089 1.928501 1.231088 1.251245 1.871032 1.182835 1.202878 1.820632 1.154354 1.130583 1.742805 1.062074 1.022618 1.753171 1.043938 1.013258 1.658491 1.024604 0.944849 1.609642 0.952950 0.897038 1.565003 0.884593 0.912924 1.552532 0.892121 0.880836 1.498501 0.880520 0.786418 1.465532 0.816299 0.813420 1.423290 0.752035 0.762743 1.421741 0.714590 0.723818 1.403987 0.733505 0.671351 1.412702 0.641308 0.651932 1.358274 0.689205 0.653982 1.258159 0.661194 0.621558 1.301944 0.609469 0.595918 1.270714 0.607222 0.610133 1.256263 0.599262 0.606483 1.272647 0.589368 0.603196 1.243206 0.567032 0.574766 1.248481 0.547265 0.581046 1.248405 0.545884 0.574934 1.242400 0.563385 0.590975 1.302477 0.595557 0.598981 1.286347 0.573656 0.621518 1.267660 0.562916 0.616733 1.243454 0.596055 0.640979 1.292918 0.620185 0.679600 1.287827 0.665780 0.652995 1.326697 0.693727 0.675577 1.347691 0.691879 0.747675 1.378948 0.762649 0.742568 1.415858 0.785369 0.778274 1.423730 0.795367 0.800309 1.487021 0.838008 0.827993 1.512430 0.907810 0.871187 1.543040 0.884992 0.900008 1.638239 0.949920 0.961755 1.677585 0.987190 1.018513 1.678460 1.001946 1.096200 1.783389 1.108153 1.076168 1.796404 1.145757 1.167884 1.816877 1.227231 1.207129 1.925401 1.301758 1.252501 -0.033136 1.332237 1.372270 0.028423 1.450758 1.418021 0.130334 1.489405 1.510035 0.176222 1.549612 1.576623 0.265940 1.598459 1.655456 0.303917 1.682678 1.704966 0.423892 1.763249 1.808957 0.488353 1.820168 1.862755 0.534951 1.946378 -0.115479 0.666199 0.023393 0.070415 0.776037 0.128186 0.196356 0.864792 0.217545 0.252618 0.983654 0.304095 0.389115 1.027461 0.448812 0.433801 1.150454 0.555772 0.544155 1.273177 0.632101 0.677317 1.365954 0.744777 0.790974 1.471500 0.822071 0.853589 1.598102 0.967229 0.975370 1.675087 1.077551 1.127441 1.852886 1.213207 1.210199 1.962339 1.304240 1.316836 0.086161 1.448424 1.477859 0.168832 1.574539 1.634408 0.361203 1.688291 1.728122 0.453375 1.814338 1.871351 0.547295 1.938859 1.979267 0.752732 0.074670 0.160869 0.827612 0.212649 0.303690 0.949851 0.357249 0.409363 1.123505 0.514448 0.536003 1.304242 0.654766 0.714393 1.455092 0.770881 0.875898 1.545383 0.969922 0.999892 1.730974 1.092273 1.222450 1.896848 1.280424 1.350530 0.032613 1.429107 1.444205 0.215184 1.624803 1.675066 0.342340 1.740939 1.838968 0.569216 1.949133 0.015232 0.698478 0.131234 0.151361 0.884335 0.271354 0.339635 1.095722 0.482243 0.517579 1.265483 0.675346 0.688472 1.422281 0.814655 0.928247 1.654512 1.068405 1.093822 1.815010 1.225299 1.260244 0.017712 1.420397 1.474081 0.220455 1.588472 1.648773 0.401957 1.778079 1.840700 0.625639 -0.012808 0.070030 0.792678 0.190737 0.284258 1.005387 0.437535 0.489104 1.218728 0.602131 0.683287 1.465082 0.844345 0.911267 1.639021 1.029139 1.130675 1.851590 1.268118 1.312010 0.057719 1.469504 1.530093 0.289014 1.690700 1.762107 0.471621 1.931281 -0.012817 0.740641 0.165067 0.208795 0.993684 0.366154 0.463936 1.182761 0.636567 0.684720 1.456517 0.844543 0.909905 1.694483 1.067261 1.181261 1.896495 1.332158 1.404902 0.148721 1.645362 1.679155 0.384571 1.818062 1.890447 0.640102 0.071315 0.176310 0.919899 0.272294 0.419881 1.132758 0.581784 0.644364 1.396819 0.836068 0.922668 1.687496 1.141228 1.207835 1.976947 1.393265 1.445536 0.156703 1.638569 1.718070 0.451856 1.881129 0.019744 0.709819 0.192369 0.200233 1.008355 0.419069 0.531216 1.302578 0.702030 0.803637 1.532231 0.954007 1.055324 1.859846 1.306678 1.377590 0.138108 1.531332 1.648592 0.426002 1.840641 1.951451 0.700627 0.118667 0.244651 0.998582 0.485323 0.494920 1.261859 0.732347 0.826064 1.562712 1.044415 1.134399 1.913175 1.329153 1.407665 0.210304 1.638322 1.725321 0.484147 1.936916 0.022008 0.780302 0.222619 0.378941 1.116036 0.561669 0.646670 1.460945 0.840177 0.975275 1.751371 1.215332 1.315124 0.085541 1.505629 1.627610 0.425238 1.825377 1.933820 0.732714 0.154007 0.292319 1.027427 0.529547 0.619665 1.349696 0.791752 0.981251 1.733406 1.162674 1.225536 0.032169 1.514092 1.592543 0.423713 1.836777 1.932372 0.696317 0.191085 0.296586 1.088262 0.524773 0.647464 1.415906 0.852802 1.001896 1.787222 1.217882 1.367593 0.135845 1.559711 1.706568 0.491434 1.938959 0.026345 0.826211 0.317377 0.432981 1.194648 0.647306 0.771866 1.535526 0.952010 1.145656 1.980339 1.386350 1.493970 0.242766 1.734727 1.909211 0.658526 0.105654 0.240947 1.055406 0.511622 0.606837 1.419260 0.864036 0.975595 1.804774 1.255562 1.392582 0.156261 1.624048 1.773878 0.556805 0.012216 0.101553 0.957436 0.383878 0.559809 1.328764 0.783210 0.930677 1.713014 1.224422 1.337576 0.125478 1.546688 1.739290 0.510760 0.051356 0.125824 0.903590 0.374800 0.570311 1.339019 0.818007 0.962926 1.765683 1.223160 1.352645 0.124754 1.578650 1.764146 0.590453 0.057826 0.175877 0.984158 0.432278 0.618760 1.384181 0.889783 1.023343 1.823416 1.277093 1.414188 0.246182 1.745636 1.841848 0.632862 0.150280 0.265895 1.101760 0.557549 0.758026 1.529218 1.025952 1.147354 1.946907 1.439368 1.589004 0.427538 1.864111 0.041990 0.827673 0.316445 0.468857 1.261958 0.771133 0.904081 1.706830 1.196837 1.354053 0.157014 1.645405 1.795526 0.592578 0.101982 0.281057 1.107888 0.555911 0.665961 1.514373 0.975447 1.213878 1.959789 1.475594 1.656049 0.416307 1.949872 0.140532 0.905252 0.432622 0.553868 1.405319 0.832421 1.008362 1.856115 1.331589 1.485200 0.316050 1.815997 0.001982 0.798883 0.288741 0.481539 1.323761 0.758828 0.934297 1.788942 1.267491 1.370187 0.217281 1.721203 1.919437 0.723380 0.279673 0.398068 1.213104 0.696604 0.889585 1.736104 1.231878 1.417072 0.196804 1.740060 1.896204 0.752408 0.209899 0.351910 1.189449 0.686930 0.826773 1.673487 1.203632 1.367796 0.227288 1.703465 1.892120 0.729701 0.258694 0.421789 1.254495 0.723732 0.895086 1.779562 1.244719 1.374161 0.270588 1.787482 1.924236 0.787793 0.287248 0.422089 1.333403 0.808325 0.984271 1.840316 1.336807 1.553111 0.371948 1.893784 0.031265 0.874015 0.422345 0.585588 1.373906 0.935718 1.074589 1.960457 1.423467 1.642278 0.497119 0.007230 0.172820 1.064655 0.555185 0.715595 1.605235 1.101805 1.263400 0.160550 1.626164 1.849766 0.620973 0.160024 0.397275 1.257895 0.728140 0.977614 1.783020 1.323145 1.477393 0.382882 1.860862 0.066768 0.875470 0.419086 0.592867 1.461744 0.999216 1.162569 0.047194 1.554396 1.742935 0.580510 0.114340 0.307878 1.210814 0.685210 0.900668 1.754451 1.284046 1.474337 0.316703 1.834072 0.067724 0.938411 0.414449 0.612252 1.463903 1.036203 1.215159 0.093484 1.579565 1.813929 0.627570 0.181199 0.397007 1.253571 0.803499 0.975099 1.879553 1.346316 1.565404 0.444558 1.911445 0.150267 1.014332 0.596259 0.761190 1.640692 1.167006 1.374288 0.200430 1.785916 -0.020237 0.841328 0.369575 0.587235 1.465755 1.022353 1.203397 0.040082 1.603319 1.800923 0.697642 0.246613 0.378743 1.303747 0.848235 1.017723 1.888665 1.465179 1.638069 0.541822 0.082773 0.284599 1.149056 0.705011 0.912207 1.802795 1.357122 1.532261 0.462396 1.960061 0.188350 1.028855 0.569613 0.826327 1.711792 1.244532 1.465696 0.305039 1.879498 0.140598 0.968889 0.509249 0.742336 1.596289 1.166386 1.391414 0.250189 1.804643 0.064874 0.903491 0.467350 0.675826 1.578530 1.102397 1.363852 0.225750 1.743932 0.006288 0.882481 0.438933 0.696451 1.580178 1.062251 1.334731 0.188903 1.764852 1.991822 0.884813 0.443960 0.695114 1.536355 1.147684 1.325690 0.207421 1.752051 -0.023263 0.928427 0.463372 0.697882 1.577692 1.110848 1.341223 0.235227 1.805566 0.036684 0.904441 0.507933 0.737993 1.620574 1.230872 1.392481 0.318832 1.877264 0.116128 0.977979 0.545815 0.770170 1.667826 1.282773 1.491249 0.424668 1.940451 0.197650 1.078051 0.632930 0.876449 1.807184 1.325741 1.610903 0.506501 0.124399 0.286036 1.237801 0.734018 0.978890 1.917198 1.533637 1.761730 0.630843 0.194340 0.429221 1.351806 0.919094 1.153849 0.063514 1.646281 1.887957 0.778829 0.340418 0.610717 1.475110 1.083155 1.334552 0.241175 1.811975 0.055298 0.973842 0.579397 0.808094 1.698861 1.228502 1.517724 0.430321 -0.012715 0.232021 1.209762 0.734727 1.038762 1.894879 1.499017 1.764964 0.656865 0.194997 0.486147 1.397331 0.988704 1.256155 0.152597 1.733661 1.991544 0.882853 0.443022 0.712924 1.634427 1.260408 1.474919 0.412849 -0.004509 0.267096 1.204753 0.725936 1.027284 1.958711 1.533697 1.775241 0.680270 0.314668 0.547444 1.449735 1.055653 1.383128 0.243443 1.840385 0.080308 1.022537 0.598258 0.873247 1.744915 1.383123 1.654137 0.545219 0.137721 0.414935 1.354838 0.924044 1.193412 0.160127 1.779808 0.028263 0.919676 0.526051 0.741475 1.740937 1.292793 1.580290 0.521987 0.149508 0.379570 1.270826 0.885333 1.161088 0.097110 1.728236 1.965362 0.904667 0.495476 0.749809 1.674421 1.271631 1.573863 0.486520 0.117535 0.354117 1.328470 0.968861 1.214600 0.194285 1.746354 -0.013159 0.972454 0.559816 0.831291 1.789789 1.391352 1.633609 0.642376 0.173893 0.493805 1.383170 1.027293 1.279111 0.201704 1.847088 0.115233 1.069029 0.652933 0.976810 1.890576 1.504075 1.796737 0.721053 0.315620 0.608487 1.595560 1.176288 1.447600 0.409920 -0.008271 0.315252 1.251649 0.874022 1.138274 0.108304 1.701728 0.013258 0.927868 0.575448 0.846099 1.783532 1.377785 1.683605 0.662680 0.277737 0.535356 1.483126 1.099360 1.456528 0.388972 0.005809 0.315780 1.208059 0.889115 1.127900 0.058940 1.729602 0.017441 0.963488 0.554371 0.868202 1.841553 1.454871 1.737963 0.632554 0.289748 0.615006 1.535634 1.164994 1.516592 0.452618 0.110624 0.369539 1.332611 0.980445 1.263002 0.221446 1.793101 0.137127 1.090077 0.696186 1.043495 1.991512 1.629891 1.912267 0.835862 0.540631 0.763715 1.769327 1.379958 1.666447 0.617190 0.267494 0.568007 1.553643 1.191148 1.449176 0.485909 0.105698 0.393627 1.344336 0.990108 1.268397 0.255753 1.909479 0.231988 1.208443 0.814232 1.117175 0.159529 1.753829 0.098434 1.030386 0.705624 0.963450 1.940764 1.624005 1.883850 0.859131 0.512040 0.828265 1.766614 1.408529 1.712566 0.655434 0.348884 0.645886 1.655297 1.247037 1.560679 0.595559 0.172718 0.503982 1.532111 1.117785 1.452470 0.421821 0.111329 0.389166 1.339463 1.002911 1.356462 0.328722 1.951461 0.256322 1.268860 0.952025 1.251385 0.230011 1.855153 0.199382 1.198794 0.829075 1.152002 0.141759 1.798851 0.134892 1.073982 0.739640 1.038813 0.038727 1.699535 0.038990 0.938557 0.683947 0.961488 1.945118 1.640693 1.959858 0.903335 0.592658 0.917891 1.942489 1.513365 1.844699 0.917182 0.518952 0.871440 1.849152 1.476241 1.824242 0.797513 0.500767 0.785754 1.824448 1.466127 1.818823 0.798962 0.467013 0.776405 1.771957 1.422550 1.762020 0.738178 0.400377 0.721303 1.732461 1.436154 1.750901 0.732186 0.438385 0.744556 1.796746 1.448501 1.773803 0.729359 0.433969 0.747508 1.785476 1.479685 1.762912 0.805656 0.486883 0.778930 1.820379 1.488654 1.832564 0.813166 0.505157 0.832300 1.858331 1.502516 1.851071 0.818299 0.522658 0.854273 1.898075 1.496807 1.849394 0.874480 0.582761 0.930056 1.880027 1.582550 1.908397 0.891373 0.600683 0.873246 1.945276 1.613104 1.974828 0.989774 0.653805 0.964411 -0.032735 1.680973 0.035614 1.062005 0.661299 1.068083 0.085607 1.773476 0.115768 1.149387 0.781321 1.165122 0.145233 1.821894 0.214749 1.232621 0.960286 1.300877 0.293840 1.936867 0.318614 1.335076 1.050506 1.368069 0.394976 0.069792 0.428475 1.495659 1.128825 1.503688 0.550822 0.258799 0.578006 1.607899 1.346658 1.700417 0.631785 0.350486 0.712870 1.719463 1.447998 1.775988 0.807449 0.560552 0.860024 1.891535 1.554976 1.958262 1.020865 0.656380 0.993813 0.055258 1.769097 0.072037 1.165005 0.875803 1.246799 0.214821 1.910055 0.337750 1.298291 0.996892 1.331279 0.411622 0.139243 0.409518 1.505483 1.258567 1.538797 0.588689 0.328653 0.648901 1.669818 1.399372 1.811750 0.824763 0.526414 0.863005 1.889105 1.613855 1.952692 0.985453 0.707839 1.077277 0.128247 1.820638 0.254136 1.257006 0.943972 1.289407 0.326020 0.016341 0.448157 1.466547 1.195432 1.507509 0.611970 0.265971 0.687009 1.722964 1.388494 1.856610 0.886492 0.588674 0.933363 -0.004635 1.694685 0.063055 1.147288 0.850327 1.245042 0.275918 1.937461 0.298671 1.431234 1.121611 1.474917 0.520088 0.242529 0.609350 1.708129 1.410558 1.821242 0.845688 0.556064 0.947395 -0.850031 1.713901 0.070147 1.109488 0.840455 1.227131 0.262250 0.054546 0.366126 1.417980 1.152186 1.555113 0.612462 0.355632 0.720283 1.759048 1.524868 1.893222 0.944541 0.666697 1.030867 0.086227 1.845031 0.230492 1.279325 1.037542 1.437547 0.459750 0.191757 0.622554 1.682832 1.382748 1.770132 0.857737 0.598033 0.997876 0.029582 1.825363 0.144386 1.204006 0.967348 1.370347 0.434948 0.169743 0.558239 1.638313 1.393485 1.743237 0.853905 0.620857 0.948028 0.027996)
+ 49.567718 #(0.000000 0.432867 1.592315 1.323995 1.788301 0.942703 0.643415 1.050236 0.283212 0.025371 0.428449 1.632606 1.318706 1.821043 0.939018 0.684636 1.164175 0.268794 0.039599 0.533669 1.585257 1.363257 1.842904 0.987896 0.776376 1.211229 0.311262 0.081147 0.587620 1.697268 1.455152 1.890902 1.056202 0.860299 1.271502 0.410643 0.218955 0.665895 1.768322 1.534310 0.021065 1.154424 0.897564 1.401258 0.524389 0.294853 0.802190 1.876110 1.692267 0.117786 1.244986 1.027217 1.509404 0.625436 0.412628 0.869022 0.040947 1.773072 0.261835 1.419153 1.172292 1.617825 0.833745 0.564387 1.040956 0.191258 -0.005697 0.435074 1.585421 1.377170 1.781934 1.001378 0.720411 1.225520 0.365353 0.112682 0.657016 1.800547 1.557815 0.052624 1.166032 0.965540 1.457945 0.586661 0.420974 0.868779 1.977505 1.789969 0.222728 1.420033 1.232779 1.685312 0.821134 0.626689 1.102656 0.224021 0.050011 0.530477 1.654985 1.489725 1.932123 1.092316 0.858142 1.371428 0.504196 0.305923 0.828349 1.948388 1.703840 0.245202 1.364354 1.174382 1.684899 0.783392 0.596762 1.107230 0.224881 0.067556 0.499076 1.693985 1.535059 0.001446 1.121976 0.925122 1.422024 0.581382 0.372407 0.884035 0.023342 1.851392 0.347539 1.491971 1.313966 1.779852 0.904034 0.768947 1.228624 0.348956 0.160673 0.722793 1.833992 1.643292 0.152413 1.292406 1.136257 1.585421 0.781877 0.604704 1.024490 0.200554 0.035600 0.546132 1.692718 1.473712 0.008955 1.165047 0.980141 1.473826 0.641637 0.464502 0.915569 0.114853 1.943700 0.469704 1.612993 1.411397 1.906676 1.100118 0.911825 1.445873 0.567498 0.415857 0.903867 0.068013 1.884402 0.360331 1.525704 1.394829 1.865430 1.084623 0.904061 1.343547 0.572634 0.336476 0.840254 0.057560 1.921132 0.420243 1.569849 1.376238 1.893187 1.053390 0.899818 1.382426 0.525775 0.389960 0.916373 0.054836 1.948715 0.432928 1.523038 1.393896 1.928017 1.101155 0.932227 1.421499 0.614365 0.444030 0.957529 0.097300 0.019635 0.491025 1.638886 1.498744 0.034818 1.185753 1.056856 1.570556 0.739019 0.523406 1.087860 0.280158 0.104363 0.635269 1.815726 1.629247 0.177041 1.336885 1.151719 1.737154 0.869999 0.719541 1.256829 0.410003 0.257297 0.726793 1.963292 1.804567 0.360523 1.537892 1.337141 1.845482 1.060339 0.908329 1.418199 0.611199 0.477266 0.989390 0.177001 0.054670 0.520057 1.738504 1.609601 0.124236 1.313026 1.158577 1.696629 0.893306 0.689664 1.250976 0.487865 0.276512 0.839095 -0.014723 1.880546 0.423107 1.577895 1.439623 1.968475 1.125305 1.046998 1.573048 0.745410 0.592232 1.102023 0.310229 0.178257 0.690580 1.865723 1.744379 0.239279 1.467042 1.318596 1.883647 1.038312 0.927627 1.486932 0.680660 0.528845 1.021516 0.250611 0.134403 0.680237 1.868863 1.712085 0.281125 1.426813 1.325292 1.883391 1.052708 0.925813 1.465972 0.681405 0.566325 1.066164 0.292256 0.173180 0.702438 1.906843 1.758433 0.303613 1.502706 1.410426 1.901011 1.083045 1.016817 1.575076 0.722087 0.630566 1.178939 0.388884 0.223267 0.769346 -0.008647 1.890965 0.443173 1.612405 1.444953 0.070035 1.310450 1.138086 1.700130 0.878469 0.754757 1.294507 0.551829 0.381372 0.960337 0.153258 0.054237 0.592285 1.785320 1.682326 0.247085 1.422883 1.309805 1.871557 1.121328 1.001343 1.516176 0.793449 0.649587 1.185230 0.409084 0.279917 0.848286 0.136926 1.942882 0.504428 1.754844 1.581813 0.130538 1.345934 1.261008 1.816416 1.039395 0.962109 1.489486 0.713130 0.640676 1.145434 0.395000 0.307485 0.836015 0.084223 1.959645 0.467558 1.777460 1.650785 0.151930 1.402174 1.314624 1.907809 1.134452 1.002707 1.554847 0.785786 0.681133 1.250964 0.481903 0.350188 0.900010 0.157250 0.035344 0.611498 1.834619 1.717868 0.336619 1.547099 1.424633 -0.027761 1.251422 1.108495 1.703278 0.929838 0.829866 1.431017 0.657186 0.508434 1.149093 0.368795 0.232921 0.837188 0.037339 1.956086 0.493796 1.783520 1.678399 0.258099 1.487390 1.376483 1.954082 1.172634 1.075547 1.643650 0.888512 0.764542 1.358131 0.611813 0.510833 1.066316 0.367326 0.256250 0.814523 0.082059 1.983561 0.551870 1.800002 1.689557 0.243377 1.496090 1.461841 0.037241 1.268039 1.199521 1.786369 0.995714 0.933699 1.492500 0.783061 0.634712 1.224586 0.501188 0.389373 1.018480 0.252584 0.135552 0.772629 -0.002227 1.959295 0.504878 1.737503 1.655076 0.234820 1.456420 1.427717 0.005719 1.247486 1.195125 1.786480 1.038846 0.946696 1.521820 0.768202 0.721783 1.274051 0.568343 0.469325 1.079628 0.326091 0.217077 0.882315 0.093790 0.035595 0.579972 1.858356 1.782383 0.338593 1.626232 1.565866 0.150354 1.389893 1.341040 1.952591 1.195759 1.108814 1.721577 0.932533 0.940764 1.478577 0.775545 0.697512 1.295069 0.550814 0.470192 1.081738 0.367690 0.242133 0.869829 0.122597 0.036062 0.647288 1.949491 1.856569 0.456770 1.689870 1.681971 0.270299 1.526378 1.473801 0.085664 1.320890 1.264940 1.856977 1.130485 1.071360 1.689398 0.947308 0.917854 1.542225 0.800455 0.751407 1.317878 0.654332 0.527805 1.174615 0.456795 0.391118 0.973215 0.208164 0.162768 0.773930 0.035787 -0.018162 0.636843 1.895370 1.829842 0.461273 1.752415 1.695237 0.324348 1.549211 1.505015 0.104885 1.366286 1.347033 1.945153 1.223066 1.209878 1.778483 1.030392 1.008268 1.676055 0.907042 0.886059 1.485547 0.754779 0.729864 1.305490 0.614361 0.557204 1.148555 0.432620 0.399513 1.059758 0.336187 0.306871 0.917328 0.195607 0.144377 0.757972 0.042932 -0.025403 0.654044 1.904409 1.878542 0.484407 1.795905 1.720086 0.369889 1.611880 1.577601 0.212774 1.489451 1.461584 0.078125 1.377544 1.316192 1.973728 1.252602 1.219313 1.887717 1.138539 1.124115 1.749584 1.008718 0.972502 1.650776 0.936705 0.897271 1.483349 0.839204 0.803267 1.383351 0.666797 0.691959 1.289189 0.594447 0.549014 1.146559 0.532234 0.450430 1.054646 0.377082 0.379950 0.983679 0.285356 0.260365 0.892783 0.180530 0.155008 0.799971 0.119070 0.063418 0.700631 -0.024320 0.000170 0.630423 1.927514 1.906035 0.526315 1.822263 1.825919 0.415292 1.740026 1.766881 0.335748 1.680886 1.646165 0.305899 1.614131 1.582157 0.242276 1.541161 1.491496 0.149009 1.453356 1.377175 0.081163 1.397028 1.349297 -0.011181 1.311184 1.306557 1.929038 1.230725 1.251112 1.870756 1.183126 1.202330 1.820339 1.154435 1.130646 1.743670 1.062827 1.022731 1.753544 1.044073 1.013880 1.657691 1.025048 0.945797 1.608786 0.953184 0.897629 1.564752 0.884660 0.912465 1.552122 0.891748 0.880727 1.498790 0.881046 0.785958 1.466080 0.816359 0.814253 1.422614 0.752222 0.762901 1.421287 0.714778 0.724042 1.403352 0.733653 0.671688 1.413019 0.640957 0.651266 1.358207 0.689404 0.653890 1.258220 0.661205 0.621518 1.301511 0.608917 0.595871 1.270073 0.606471 0.610460 1.255754 0.599099 0.606736 1.272585 0.589569 0.602911 1.242558 0.567288 0.574684 1.248498 0.547464 0.580687 1.248524 0.545849 0.574265 1.243398 0.563722 0.590784 1.303067 0.596378 0.599196 1.285863 0.574011 0.620349 1.267366 0.562971 0.616460 1.243064 0.596590 0.640258 1.292667 0.620786 0.679497 1.288162 0.665417 0.653482 1.326572 0.693112 0.675977 1.348536 0.691835 0.747129 1.379145 0.761967 0.742459 1.416156 0.785349 0.778842 1.424212 0.795212 0.800323 1.486389 0.838794 0.827984 1.512202 0.908388 0.871184 1.542758 0.885313 0.898872 1.638107 0.949651 0.961518 1.678278 0.986634 1.018410 1.678263 1.002837 1.095772 1.783440 1.108401 1.076599 1.796125 1.146088 1.167775 1.816550 1.227047 1.207885 1.925869 1.302311 1.252608 -0.033560 1.332917 1.372627 0.028810 1.451612 1.418497 0.130595 1.489658 1.508959 0.175720 1.549544 1.577506 0.265334 1.598754 1.655386 0.303636 1.682920 1.705085 0.422937 1.763758 1.808759 0.487597 1.819959 1.862534 0.535522 1.946809 -0.115040 0.665727 0.023440 0.070347 0.775932 0.128014 0.196216 0.864642 0.216597 0.251771 0.984063 0.303565 0.389204 1.026850 0.448606 0.433946 1.150404 0.556464 0.544755 1.273544 0.632335 0.676696 1.365522 0.745089 0.790602 1.470979 0.821280 0.853694 1.597705 0.968043 0.975805 1.674665 1.077440 1.127454 1.852922 1.212641 1.210402 1.962614 1.303429 1.316053 0.085094 1.447808 1.478256 0.169251 1.574497 1.634558 0.360911 1.688192 1.728019 0.453907 1.814498 1.871393 0.547317 1.939141 1.980060 0.752858 0.075684 0.159658 0.827663 0.212550 0.303773 0.950489 0.357186 0.409593 1.123641 0.513729 0.535927 1.304278 0.654770 0.715276 1.455028 0.770911 0.875458 1.545623 0.969556 0.999326 1.730343 1.091944 1.221903 1.897206 1.279698 1.350940 0.033121 1.429331 1.444500 0.214645 1.624520 1.675381 0.342678 1.741234 1.839710 0.569067 1.948230 0.014741 0.698607 0.131538 0.151472 0.884075 0.272063 0.340173 1.096109 0.482874 0.517643 1.264982 0.675270 0.687646 1.422498 0.814473 0.927878 1.655072 1.068595 1.094027 1.815286 1.225952 1.260627 0.017518 1.420732 1.474908 0.221079 1.588411 1.648864 0.402394 1.777837 1.840849 0.625734 -0.013551 0.070997 0.793117 0.190649 0.284534 1.004964 0.437911 0.489005 1.218364 0.602492 0.683422 1.464901 0.844705 0.911894 1.639234 1.028938 1.131046 1.851461 1.268449 1.311957 0.057751 1.468700 1.529995 0.288719 1.690772 1.761890 0.472035 1.930738 -0.013466 0.739963 0.165160 0.208786 0.994602 0.366476 0.464112 1.182693 0.636295 0.685026 1.456920 0.844690 0.909542 1.694912 1.067458 1.181710 1.896020 1.331547 1.405093 0.149419 1.644291 1.679491 0.384699 1.817854 1.890845 0.639752 0.071469 0.176258 0.919643 0.272564 0.419048 1.133077 0.581062 0.644372 1.397392 0.836011 0.922411 1.687262 1.141512 1.208415 1.976298 1.393176 1.445999 0.156886 1.639451 1.717861 0.452034 1.880223 0.020039 0.710467 0.191458 0.199131 1.008126 0.419293 0.531426 1.302951 0.702043 0.804382 1.530971 0.954520 1.055688 1.859776 1.306332 1.378402 0.138346 1.530246 1.649136 0.425226 1.840371 1.950895 0.700119 0.117848 0.243983 0.998337 0.485082 0.495644 1.262421 0.732943 0.825281 1.562148 1.044597 1.134859 1.913786 1.329348 1.407982 0.210241 1.639570 1.724221 0.485359 1.936637 0.022416 0.780234 0.222800 0.379146 1.116670 0.562320 0.646806 1.461100 0.840574 0.975096 1.751925 1.215860 1.314689 0.085684 1.505585 1.627253 0.425272 1.825694 1.933635 0.732471 0.154002 0.293364 1.026476 0.529439 0.620517 1.349346 0.791393 0.981595 1.732717 1.162814 1.225302 0.032429 1.513773 1.592540 0.424285 1.837515 1.932787 0.696363 0.191608 0.297201 1.088546 0.526024 0.647177 1.416664 0.853591 1.001064 1.787249 1.217712 1.365926 0.134884 1.560031 1.707163 0.491278 1.939608 0.026142 0.825490 0.317127 0.432137 1.195215 0.647750 0.771485 1.535312 0.952377 1.145164 1.979879 1.386545 1.494030 0.242720 1.734870 1.909421 0.657965 0.105480 0.241113 1.055904 0.511362 0.606258 1.419393 0.863439 0.976471 1.804572 1.254523 1.393261 0.156202 1.623783 1.773755 0.556200 0.012104 0.102034 0.957510 0.383106 0.558804 1.328628 0.782936 0.931226 1.712243 1.224120 1.337231 0.125210 1.547047 1.739529 0.510601 0.052040 0.125175 0.904023 0.374677 0.569617 1.339044 0.817825 0.963857 1.765379 1.223730 1.352932 0.124896 1.578329 1.763732 0.590983 0.058356 0.175690 0.983226 0.431599 0.619198 1.384475 0.890644 1.022662 1.823770 1.277398 1.414323 0.246027 1.745775 1.841464 0.633812 0.150686 0.265666 1.101643 0.557667 0.757426 1.529067 1.026131 1.147606 1.946928 1.439934 1.588390 0.427026 1.863237 0.041843 0.827397 0.317282 0.467943 1.262095 0.770564 0.903911 1.707068 1.197056 1.353472 0.157130 1.644999 1.795871 0.592263 0.101480 0.281064 1.107924 0.556122 0.665051 1.514588 0.975568 1.214099 1.960652 1.475473 1.655324 0.415803 1.950937 0.141089 0.905192 0.433424 0.554192 1.404809 0.831603 1.008522 1.856348 1.331058 1.485868 0.315647 1.815809 0.002424 0.798849 0.288136 0.481137 1.323716 0.759501 0.934442 1.789036 1.266893 1.370494 0.217484 1.720213 1.919463 0.723899 0.279695 0.397755 1.213550 0.696571 0.890358 1.736645 1.231543 1.417332 0.197845 1.741080 1.896170 0.753298 0.211116 0.352101 1.189152 0.687416 0.826788 1.674516 1.203169 1.368921 0.227999 1.703726 1.892471 0.730212 0.258617 0.421947 1.253927 0.723675 0.894852 1.780759 1.244874 1.374194 0.270281 1.786799 1.924311 0.787792 0.286652 0.422414 1.333642 0.808115 0.983879 1.840926 1.336161 1.553946 0.371662 1.894203 0.031162 0.873908 0.422052 0.586318 1.373886 0.935990 1.074467 1.960591 1.422997 1.641904 0.497239 0.007073 0.173833 1.064348 0.554953 0.715806 1.604883 1.101410 1.263671 0.160544 1.626125 1.849808 0.621828 0.159765 0.396942 1.257864 0.728289 0.977198 1.782265 1.323199 1.476814 0.383227 1.860638 0.066505 0.875510 0.419639 0.592848 1.462867 0.999254 1.162814 0.047296 1.554802 1.743336 0.580100 0.114118 0.307921 1.210498 0.685105 0.901542 1.754068 1.284226 1.473677 0.317399 1.833581 0.067373 0.938188 0.414790 0.612327 1.463908 1.036784 1.215437 0.093746 1.580122 1.813987 0.627014 0.181787 0.397287 1.253371 0.802703 0.974485 1.878884 1.346846 1.564781 0.444509 1.911658 0.150029 1.015281 0.595721 0.761125 1.640760 1.167717 1.372912 0.200176 1.785258 -0.019662 0.840630 0.369426 0.587060 1.465713 1.021618 1.203091 0.040141 1.602672 1.800614 0.698057 0.247455 0.379317 1.303082 0.846768 1.017198 1.888623 1.465776 1.638269 0.541981 0.082494 0.285198 1.148968 0.705085 0.912920 1.802423 1.357456 1.532562 0.461763 1.959510 0.188507 1.029767 0.569579 0.826009 1.710408 1.244470 1.465600 0.305543 1.879511 0.140560 0.968833 0.509426 0.742378 1.595553 1.166937 1.391349 0.251220 1.804569 0.065483 0.904416 0.467821 0.675549 1.578415 1.102664 1.363505 0.225789 1.744895 0.006398 0.881609 0.439267 0.696361 1.578824 1.062765 1.333865 0.189103 1.764751 1.991878 0.885034 0.443513 0.696318 1.536554 1.147984 1.325871 0.207460 1.752430 -0.021946 0.928092 0.463239 0.697470 1.577903 1.110855 1.341102 0.235079 1.806741 0.037476 0.904080 0.507650 0.736964 1.620175 1.231259 1.392307 0.318665 1.877280 0.116842 0.978372 0.545913 0.769693 1.667961 1.283131 1.491074 0.424546 1.941070 0.197910 1.078564 0.633137 0.876361 1.807223 1.325766 1.611501 0.507095 0.124134 0.285335 1.237648 0.733340 0.978806 1.917702 1.533685 1.761848 0.630112 0.194523 0.428624 1.351718 0.919721 1.153829 0.062880 1.647141 1.887808 0.778596 0.339900 0.610463 1.475324 1.083130 1.334579 0.240549 1.812202 0.055999 0.973238 0.579286 0.807094 1.698750 1.228808 1.518635 0.430736 -0.012304 0.231054 1.209403 0.734779 1.038578 1.894830 1.498448 1.763986 0.657407 0.194521 0.485914 1.397948 0.988514 1.256110 0.153261 1.733640 1.992053 0.883045 0.443065 0.712486 1.633878 1.261009 1.474940 0.412344 -0.005277 0.267033 1.204129 0.726134 1.027350 1.958993 1.534647 1.774233 0.680617 0.314539 0.547491 1.449432 1.056656 1.382780 0.243879 1.840823 0.080001 1.022845 0.597784 0.872738 1.745699 1.382093 1.654893 0.544864 0.137355 0.415733 1.354930 0.924122 1.192702 0.160596 1.779323 0.027680 0.918930 0.526350 0.740720 1.741394 1.293016 1.580301 0.522582 0.148985 0.379137 1.271111 0.885268 1.161554 0.096769 1.727884 1.966293 0.905501 0.495623 0.749064 1.674483 1.271381 1.574377 0.486034 0.117247 0.354026 1.328065 0.969102 1.214717 0.194395 1.746610 -0.011926 0.972086 0.559529 0.831238 1.789798 1.390595 1.633953 0.642188 0.174475 0.493395 1.382830 1.026271 1.280363 0.200974 1.846777 0.115115 1.069072 0.652710 0.976859 1.891103 1.503908 1.795969 0.721397 0.315004 0.608687 1.595182 1.176729 1.447257 0.409452 -0.008371 0.314838 1.251449 0.874129 1.137144 0.109162 1.701645 0.014051 0.927713 0.575774 0.845669 1.784397 1.378207 1.683674 0.663238 0.278254 0.535506 1.483556 1.100153 1.457016 0.388883 0.005642 0.316097 1.207284 0.888972 1.128414 0.058575 1.729190 0.016896 0.963591 0.554187 0.867852 1.840929 1.453733 1.737448 0.632445 0.290099 0.615559 1.536348 1.165103 1.515835 0.452780 0.110661 0.369432 1.332977 0.980508 1.262246 0.221989 1.793856 0.136310 1.089617 0.696209 1.043272 1.992267 1.629651 1.912819 0.835810 0.540995 0.763069 1.769268 1.379271 1.666600 0.617625 0.266932 0.567664 1.553620 1.191093 1.449009 0.486150 0.105269 0.393769 1.344240 0.989875 1.268496 0.256408 1.909223 0.231907 1.208420 0.813732 1.116992 0.160912 1.753805 0.098769 1.030323 0.706213 0.963514 1.940588 1.623921 1.883706 0.859012 0.512713 0.828728 1.767054 1.408708 1.712574 0.655296 0.349156 0.645282 1.655359 1.247024 1.560644 0.595395 0.173306 0.503331 1.532382 1.117532 1.452275 0.421233 0.111605 0.389834 1.338474 1.003248 1.356157 0.328873 1.951186 0.256599 1.269061 0.952057 1.250685 0.230464 1.854952 0.199831 1.199646 0.829254 1.151579 0.141779 1.799156 0.135198 1.075152 0.740282 1.039186 0.038840 1.699937 0.039328 0.938138 0.683856 0.961632 1.946342 1.640662 1.960053 0.902599 0.592891 0.917501 1.942287 1.513528 1.845283 0.917328 0.519135 0.871603 1.848472 1.476078 1.823906 0.797781 0.499777 0.785745 1.824452 1.466051 1.818340 0.799165 0.467044 0.777651 1.772042 1.422136 1.762520 0.738261 0.400462 0.721746 1.731793 1.437157 1.750757 0.732094 0.438580 0.744346 1.796305 1.448744 1.773567 0.730097 0.434096 0.747319 1.785067 1.479070 1.763370 0.805637 0.487393 0.779616 1.819973 1.488783 1.832681 0.813767 0.505826 0.833425 1.858212 1.502633 1.851705 0.819234 0.522378 0.854397 1.897769 1.496096 1.849506 0.874322 0.582195 0.931231 1.880681 1.582342 1.908420 0.891883 0.600239 0.873954 1.945481 1.612615 1.975069 0.989682 0.654105 0.964289 -0.033283 1.680923 0.036407 1.061717 0.660894 1.067857 0.084996 1.774037 0.115802 1.149613 0.781168 1.165428 0.145114 1.821545 0.214019 1.233513 0.960694 1.300412 0.293985 1.936251 0.318657 1.335897 1.050699 1.368725 0.394256 0.069338 0.428718 1.495760 1.128420 1.503430 0.551211 0.258693 0.578947 1.607794 1.347069 1.700158 0.631741 0.350029 0.713138 1.719097 1.447040 1.777128 0.807703 0.560825 0.860972 1.892299 1.555448 1.958070 1.020335 0.656430 0.993913 0.054574 1.770096 0.072417 1.164607 0.874963 1.247577 0.213886 1.910705 0.337815 1.298213 0.997251 1.330676 0.412032 0.139185 0.409467 1.505135 1.259292 1.538564 0.588793 0.328973 0.648793 1.669944 1.400329 1.810945 0.824459 0.526764 0.862310 1.889120 1.613821 1.953223 0.985616 0.707986 1.076940 0.127569 1.819620 0.255010 1.256703 0.943536 1.288612 0.326366 0.016115 0.447524 1.466762 1.195710 1.507434 0.613095 0.266207 0.687339 1.722612 1.388605 1.857805 0.885634 0.587547 0.933374 -0.005388 1.693599 0.062846 1.146963 0.850164 1.245771 0.275554 1.937687 0.299011 1.431014 1.121367 1.475253 0.520718 0.242063 0.609886 1.707586 1.410361 1.821705 0.846212 0.556384 0.947359 -0.849897 1.713846 0.069565 1.108976 0.840501 1.227874 0.262847 0.054942 0.366844 1.418132 1.152965 1.554913 0.612241 0.355480 0.720332 1.758793 1.524871 1.892693 0.944797 0.665782 1.030720 0.086832 1.844454 0.230649 1.279426 1.037255 1.437346 0.459424 0.191795 0.622807 1.682771 1.382333 1.770397 0.856995 0.597453 0.997708 0.029755 1.824568 0.143040 1.204709 0.967982 1.370680 0.435315 0.168763 0.558103 1.637902 1.394735 1.743083 0.854087 0.621070 0.948249 0.028012)
)
@@ -1983,7 +1983,7 @@
;;; 65 odd -------------------------------------------------------------------------------- ; 8.0622
(vector 65 10.169842720032 #r(0 0 1 1 0 0 1 0 1 0 1 1 0 1 1 0 1 1 1 1 1 0 1 0 1 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 1 1 0 0 0 0 1 1 0 0 1 1 1 1 1 1 0 0 0 0 1 0 1)
- 8.041843 #r(0.000000 1.510279 1.423698 1.698060 1.501053 1.180996 -0.085543 1.272940 0.246128 1.452754 1.116882 0.406181 0.071379 0.504041 0.790673 1.684489 -0.028841 0.150831 0.258232 0.575724 1.903805 0.049803 1.632670 1.087031 1.406375 1.614155 0.540793 1.593111 0.703911 1.182639 1.722176 0.257146 -0.290703 0.360167 1.805766 1.244616 1.636667 1.267448 1.403263 0.048920 1.072378 0.033352 0.081404 0.128813 0.847252 1.224433 1.268463 0.838170 0.941587 1.720222 0.172123 0.951570 1.520723 1.306591 0.465991 -0.022358 1.791525 1.039956 0.489959 1.798920 0.197346 1.247948 0.566292 0.910361 0.850668)
+ 8.040855 #(0.000000 1.507786 1.415372 1.703926 1.500233 1.179747 -0.086038 1.271067 0.241330 1.453321 1.112825 0.408932 0.079619 0.501656 0.792814 1.679514 -0.023064 0.144220 0.265584 0.573417 1.899192 0.051511 1.631616 1.086663 1.410383 1.613900 0.536011 1.591177 0.698399 1.181483 1.728211 0.256554 -0.283132 0.355776 1.802436 1.248796 1.634590 1.262544 1.397780 0.053710 1.072831 0.031772 0.078446 0.128037 0.853258 1.218686 1.277789 0.847077 0.934403 1.722304 0.163187 0.957497 1.531555 1.320004 0.466076 -0.023032 1.791699 1.045097 0.495828 1.812354 0.196561 1.248643 0.569902 0.907793 0.854507)
)
;;; 66 odd -------------------------------------------------------------------------------- ; 8.1240
@@ -2021,14 +2021,7 @@
;;; 71 odd -------------------------------------------------------------------------------- ; 8.4261
(vector 71 10.642364501953 #r(0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 0 1 0 0 1 0 1 0 1 0 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 0 1 1 1 0 1 1 0 1 0 0 0 0 0 1 0 0 0 1 0 0 1 1 1 1 0 0 1 1 0 0)
- 8.475519 #r(0.000000 1.238076 0.753931 1.905336 0.009769 0.107430 -0.130621 1.591198 0.182824 0.768320 1.146473 0.823523 0.829676 0.742699 -0.276539 0.324236 1.092544 0.415195 1.670265 1.207403 0.977157 1.540240 1.842707 1.816863 1.497289 1.724381 0.528087 1.371720 0.846254 0.443580 1.148328 1.771135 -0.168351 0.710309 -0.056239 1.109626 1.555511 -0.110149 0.103207 0.997197 1.006113 0.446860 1.034785 1.366376 1.616338 -0.046807 1.211677 1.130244 1.187406 1.353421 0.750549 1.080694 1.186040 0.268525 1.418417 0.401769 1.093799 -0.192487 0.855080 0.124908 -0.060822 1.069669 1.270728 0.527632 1.877202 0.240913 -0.052204 1.530974 1.498303 0.436500 1.851527)
-
- ;; from this, but :odd 71 0.53864770353023 #r(9.9351872829636 -0.2379167494546 3.1853837584999)??
- ;; 9.9437 #r(0.0000 1.0614 0.0950 1.1008 0.0787 1.0289 1.9512 0.8458 1.7125 0.5514 1.3626 0.1459 0.9014 1.6290 0.3289 1.0010 1.6452 0.2617 0.8503 1.4112 1.9442 0.4494 0.9268 1.3764 1.7982 0.1921 0.5583 0.8967 1.2072 1.4899 1.7449 1.9720 0.1713 0.3428 0.4865 0.6024 0.6904 0.7507 0.7831 0.7878 0.7646 0.7136 0.6349 0.5283 0.3939 0.2316 0.0416 1.8238 1.5781 1.3047 1.0034 0.6744 0.3175 1.9328 1.5203 1.0800 0.6119 0.1159 1.5922 1.0407 0.4613 1.8541 1.2192 0.5564 1.8658 1.1474 0.4012 1.6272 0.8253 1.9957 1.1382 )
-
- 8.471193 #r(0.000000 1.251993 0.120909 1.147167 0.101021 0.991005 0.102768 0.840256 1.667018 0.493083 1.454975 0.236751 0.930972 1.613715 0.282901 1.264934 1.852683 0.309294 0.763244 1.396502 0.016107 0.421575 0.832061 0.905495 1.670197 0.206770 0.024145 0.415927 1.292038 1.512037 1.549693 1.890115 0.264325 -0.038970 0.344515 0.662351 0.896654 0.664956 0.697808 0.735895 0.787344 0.830776 0.256004 0.590650 0.201668 0.204354 0.381917 1.530833 1.289723 1.098254 0.882568 0.234043 0.016492 0.014075 1.543842 0.771174 0.029614 -0.188598 1.614192 0.901328 0.316437 -0.299368 1.157490 0.464174 -0.326258 1.156953 0.332845 1.674680 0.336028 -0.185110 1.185822)
-
- 8.406561 #r(0.000000 1.136768 0.110422 1.080469 0.111645 0.980565 0.087135 0.892409 1.705799 0.484945 1.412134 0.209542 0.909173 1.678801 0.332063 1.134599 1.765595 0.287552 0.824497 1.474171 0.122562 0.547316 0.786695 0.921126 1.628959 0.181855 0.048990 0.491779 1.249164 1.531973 1.630614 -0.083456 0.308877 -0.134450 0.334308 0.596938 0.779083 0.610588 0.769576 0.748353 0.930715 0.765564 0.342767 0.573683 0.144254 0.219685 0.317964 1.469956 1.186980 1.051035 0.789756 0.253764 0.026652 -0.023543 1.467574 0.724088 0.114734 -0.223070 1.555542 0.968486 0.132084 -0.314737 1.118620 0.462013 -0.390063 1.067074 0.324923 1.582422 0.354510 -0.234876 1.172540)
+ 8.385861 #(0.000000 1.144511 0.109267 1.049574 0.078787 0.972362 0.082925 0.901606 1.725287 0.495907 1.393879 0.196182 0.915293 1.683141 0.381517 1.154499 1.783653 0.331402 0.847409 1.498592 0.125674 0.561688 0.770046 0.873277 1.603760 0.191083 0.058482 0.458030 1.250172 1.531745 1.636499 -0.115007 0.295590 -0.154328 0.340248 0.625688 0.817738 0.618244 0.791963 0.763782 0.965830 0.732384 0.372520 0.633577 0.148745 0.255363 0.360470 1.449262 1.176282 1.064821 0.800281 0.236314 0.046573 -0.000568 1.463085 0.726302 0.079276 -0.238658 1.567708 0.913843 0.194119 -0.291508 1.111349 0.448080 -0.336316 1.054497 0.322996 1.607539 0.310703 -0.264736 1.227410)
)
;;; 72 odd -------------------------------------------------------------------------------- ; 8.4853
@@ -2417,28 +2410,29 @@
;;; 256 odd --------------------------------------------------------------------------------
(vector 256 22.546259712247 #r(0 1 1 1 0 1 0 0 1 0 1 0 0 1 0 0 1 1 0 0 1 0 0 0 1 1 0 0 1 1 1 0 1 1 0 0 0 1 0 0 0 1 1 0 0 1 0 0 0 1 0 1 1 0 0 0 0 1 1 1 1 0 1 0 0 0 0 0 1 0 0 0 1 1 1 0 1 1 1 1 0 1 0 1 1 0 0 1 0 0 0 1 1 0 1 1 1 1 0 1 1 0 1 1 0 1 1 1 0 1 1 1 1 0 0 0 0 0 1 1 0 0 1 0 1 0 0 0 0 1 1 1 0 1 1 1 0 0 0 0 1 0 1 1 0 1 0 1 0 1 0 0 0 0 0 1 0 1 1 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 0 1 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 1 0 0 1 0 1 1 1 0 1 0 1 0 1 1 0 1 1 0 0 0 0 0 1 1 1 1 1 1 0 1 1 0 1 1 0 0 1 1 1 0 0 1 0 1 0 0 1 1 0 0 0 0 0 1 0 1 0 0 1)
- 16.932554 #r(0.000000 0.299828 1.705033 -0.245282 1.517634 -0.512250 1.852696 -0.212031 1.625444 0.510314 1.972741 0.173230 1.725475 1.547901 0.804668 1.394746 0.173496 0.531764 0.731522 -0.060988 0.953386 0.234883 1.327931 1.710749 0.682372 1.593381 0.151697 0.696761 0.537335 1.969147 0.015426 0.808226 1.907797 1.558581 1.628528 1.165756 1.125630 1.795673 0.141122 0.016332 1.288127 0.941042 0.739123 0.972611 0.864761 0.875493 1.065737 0.205053 1.185762 0.863116 -0.053729 1.247127 1.771030 0.213109 0.203770 1.794944 0.080805 1.593027 0.197375 0.662307 -0.007433 1.307614 1.700096 0.641288 -0.016776 0.227057 0.210364 1.170957 1.587764 0.027010 1.239534 0.423010 0.803348 -0.009082 0.446764 0.636465 0.493264 -0.127025 0.112814 0.882192 1.818458 -0.107988 0.396084 1.293132 0.043609 1.657883 0.579794 0.180007 1.771600 1.131077 0.309105 0.137609 1.680511 0.060225 1.648041 -0.009446 0.270642 0.473937 1.608416 -0.014724 1.203911 1.240003 1.624613 1.562696 0.423323 0.330495 1.342929 0.063255 0.191341 0.910443 0.987286 0.949497 1.223867 1.261957 1.880192 0.302246 1.712139 1.779224 1.265963 1.777754 0.696982 1.379173 0.849932 1.580925 0.603387 1.028575 0.637130 0.740605 0.190997 1.448533 1.601710 1.704646 0.662313 0.835536 0.132357 0.868721 1.868738 1.555439 0.857103 1.813342 0.384273 0.308585 0.123611 1.182477 1.477561 1.678828 1.369057 1.213135 0.205042 0.425013 1.472803 1.396888 1.212323 1.858077 1.187399 0.010710 1.114100 1.840176 0.270787 0.093299 1.447701 0.449012 1.201616 1.113975 0.530506 1.655828 1.255713 -0.011414 0.956758 0.101851 1.223128 0.632983 0.423115 0.389217 1.423871 0.446874 1.820967 -0.029749 -0.443778 1.464394 0.868892 0.727400 0.578567 1.659072 1.017705 1.973528 -0.008925 0.757464 0.297947 -0.349297 0.883303 0.128256 1.200088 1.880227 0.584973 0.246525 0.618040 0.702249 1.255753 -0.329844 0.271022 0.297799 1.233191 1.390939 1.235027 0.303733 0.154150 0.491021 1.847433 1.056124 1.120988 1.805844 0.419548 1.016328 0.066448 0.893486 1.505832 0.702704 1.551981 1.267138 0.736198 0.947423 0.706820 -0.380019 0.873753 1.478444 0.561669 0.158253 0.016654 0.113131 1.644053 0.533397 0.826036 1.694860 0.852972 1.098260 0.229336 0.855766 1.051022 1.369585 0.520607 1.599761 1.473656 0.002020 0.572466 1.209260 1.275104 1.740654 1.738870 1.725547 1.490686 0.651000 0.118628 -0.196423 0.917329 0.845710)
+ 16.795239 #(0.000000 0.296154 1.680877 -0.254080 1.501754 -0.512663 1.828962 -0.203122 1.617623 0.512792 0.031508 0.128064 1.700674 1.579780 0.780671 1.382749 0.156230 0.508361 0.684835 -0.082656 0.952163 0.216290 1.325868 1.705996 0.689607 1.611356 0.161173 0.669332 0.552848 1.961725 0.036125 0.787049 1.929903 1.548616 1.622816 1.183061 1.155276 1.811641 0.114476 0.016874 1.295393 0.971408 0.748286 0.978588 0.864055 0.867948 1.094178 0.191483 1.177458 0.889452 -0.048163 1.250308 1.754915 0.202781 0.168326 1.843132 0.053492 1.600000 0.170385 0.614104 -0.014299 1.311293 1.695962 0.614804 -0.011317 0.218558 0.216379 1.177709 1.557001 0.032671 1.210733 0.440978 0.777401 -0.011566 0.449033 0.616164 0.545308 -0.141242 0.073641 0.897111 1.791004 -0.169952 0.402638 1.317670 0.024113 1.622985 0.570193 0.167442 1.784453 1.110120 0.320283 0.157779 1.689633 0.097787 1.652636 0.011835 0.290012 0.477116 1.632275 -0.001345 1.211165 1.255620 1.598080 1.572426 0.388765 0.310957 1.287724 0.011672 0.183174 0.906100 1.006665 0.935380 1.222060 1.305452 1.835007 0.309348 1.690662 1.782585 1.267761 1.743137 0.701398 1.383418 0.900583 1.554290 0.626691 1.043053 0.667701 0.773466 0.148379 1.434723 1.592405 1.720212 0.638560 0.810936 0.148703 0.837104 1.856938 1.601356 0.819165 1.801723 0.386201 0.324614 0.171004 1.202167 1.467975 1.678016 1.324956 1.235357 0.221312 0.427891 1.471086 1.389842 1.234609 1.858920 1.173508 -0.029963 1.148991 1.815644 0.293148 0.085655 1.464822 0.435470 1.196187 1.120437 0.502444 1.690961 1.226962 0.008225 0.949523 0.104300 1.187380 0.628636 0.392034 0.356962 1.386925 0.446430 1.851786 -0.063581 -0.475924 1.470171 0.815816 0.756648 0.604433 1.660325 0.993483 1.971856 -0.012075 0.756969 0.272069 -0.303274 0.843836 0.097037 1.184864 1.891334 0.577274 0.212782 0.644529 0.726566 1.267011 -0.347422 0.267066 0.302885 1.247685 1.428158 1.218169 0.322597 0.142997 0.473452 1.868226 1.049720 1.114667 1.781008 0.417450 1.011920 0.079529 0.911909 1.478189 0.747170 1.579828 1.276291 0.737080 0.964944 0.705651 -0.380989 0.837972 1.471874 0.544370 0.117037 -0.019460 0.117557 1.628410 0.517544 0.803780 1.689923 0.875515 1.105116 0.197643 0.862186 1.055017 1.347532 0.529576 1.633184 1.473109 -0.014100 0.561648 1.213884 1.249792 1.719036 1.780713 1.727736 1.468222 0.647895 0.150121 -0.211790 0.915321 0.832161)
)
;;; 512 odd --------------------------------------------------------------------------------
(vector 512 35.541 #r(0 1 1 0 0 1 0 0 1 0 1 0 0 1 0 0 0 0 1 0 1 0 1 1 0 1 1 1 1 0 0 1 1 0 0 0 1 1 1 1 0 0 1 0 0 1 1 1 1 0 0 1 0 1 1 0 1 0 0 0 0 0 0 0 1 1 1 0 1 0 0 1 1 0 0 0 0 1 0 1 1 0 0 1 1 0 1 0 1 0 1 0 0 0 1 1 1 0 1 0 1 1 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 1 0 0 0 0 0 0 0 0 1 0 0 0 0 1 1 0 1 1 0 0 0 0 1 0 1 1 0 0 0 1 1 1 0 1 0 1 1 1 1 0 0 1 1 0 0 1 1 0 0 0 1 1 0 0 0 0 0 1 1 0 0 1 0 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 1 0 1 1 1 0 1 0 1 0 1 1 0 1 0 0 1 0 0 1 1 0 0 1 0 1 1 0 1 1 0 1 0 0 0 0 0 0 1 1 1 0 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 0 1 0 0 0 0 1 1 0 1 0 0 1 1 0 1 1 0 0 1 0 0 0 1 0 0 0 0 1 1 0 1 0 1 0 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 1 0 1 0 0 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 1 0 0 0 1 0 0 0 1 0 0 1 0 0 1 0 1 0 0 0 0 0 1 1 0 1 1 1 0 0 0 0 1 1 1 1 1 1 0 1 1 0 0 1 0 1 1 0 0 1 0 0 0 1 1 1 1 1 1 1 1 1 1 0 1 1 0 1 0 0 1 1 1 0 1 1 1 1 0 0 1 0 0 0 1 1 0 1 1 0 0 1 0 0 0 0 1 0 1 1 1 1 1 0 1 0 0 0 1 0 0 1 0 1 0 1 1 0 1 0 0 0 0 1 0 1 0 1 0 1 1 0 1 1 0 1 1 1 0 1 1 1 0 1 0 0 1 0 1 0 0 0 0 0 0 1 1 1 0 1 0 0)
;; from (try-all :odd 512 513 0.0057812032540294 1.0142361702487) = 28.7291 start for next
- 23.716849 #r(0.000000 1.386177 0.713008 0.003452 1.325461 0.665248 0.008142 1.314724 0.691474 0.066339 1.435981 0.804093 0.172765 1.522234 0.893751 0.277258 1.610102 1.005246 0.376177 1.775441 1.206877 0.615802 0.010188 1.376708 0.765127 0.173375 1.635776 1.029586 0.489561 1.940906 1.346730 0.810290 0.190213 1.646200 1.058365 0.502081 -0.085212 1.398947 0.892744 0.400807 1.903960 1.353268 0.833725 0.289010 1.806848 1.257743 0.707460 0.242200 1.750575 1.251783 0.742940 0.232633 1.756296 1.281177 0.783502 0.304115 1.846750 1.350399 0.916463 0.494039 0.029209 1.596080 1.095129 0.687317 0.229205 1.736704 1.290854 0.857342 0.417897 0.006810 1.604785 1.207241 0.745888 0.368498 1.939438 1.557313 1.176888 0.751323 0.345064 1.946256 1.587416 1.205053 0.847721 0.500526 0.105201 1.713914 1.348245 0.999166 0.643810 0.294307 -0.009291 1.648246 1.318017 0.946007 0.571567 0.250113 1.948602 1.641225 1.351970 1.040145 0.722431 0.402249 0.068667 1.761778 1.483321 1.168792 0.902292 0.622562 0.393716 0.071396 1.793757 1.520668 1.253207 0.968382 0.706598 0.478102 0.212208 1.966285 1.706429 1.495684 1.219831 0.986339 0.727326 0.553916 0.347750 0.133150 1.913130 1.701236 1.512062 1.283083 1.044773 0.859493 0.685612 0.480978 0.318075 0.155658 1.970256 1.731367 1.604854 1.456327 1.268574 1.110936 0.962304 0.806527 0.641956 0.496465 0.404452 0.274399 0.124501 -0.069746 1.814128 1.693756 1.567361 1.452982 1.402427 1.267889 1.106117 1.025358 0.944270 0.854118 0.753166 0.662874 0.577504 0.540814 0.454691 0.364705 0.334774 0.260515 0.174172 0.114008 0.059753 0.021108 1.967795 1.940561 1.926108 1.817829 1.816578 1.829230 1.763717 1.746146 1.768340 1.735638 1.694243 1.717300 1.700307 1.673492 1.703276 1.765354 1.728149 1.721871 1.792759 1.836518 1.790659 1.869572 1.931889 1.911416 -0.049508 0.040552 0.076661 0.124548 0.190446 0.213683 0.290047 0.374351 0.444676 0.515097 0.588488 0.695903 0.781037 0.806660 0.921756 1.050977 1.179273 1.276197 1.323471 1.440301 1.570781 1.698955 1.827110 1.973403 0.095016 0.228855 0.385876 0.488292 0.634453 0.804119 0.947283 1.092378 1.233063 1.412122 1.598977 1.789895 1.950360 0.140199 0.270111 0.484542 0.676076 0.875520 1.062416 1.258627 1.458192 1.707297 1.921954 0.119209 0.298949 0.581405 0.769515 1.026853 1.223167 1.513273 1.727029 -0.017306 0.209900 0.500939 0.701672 0.977279 1.216826 1.499384 1.779833 0.099435 0.337187 0.641811 0.927329 1.208595 1.453552 1.744657 0.045196 0.356852 0.724238 1.011858 1.349837 1.617935 1.987915 0.263154 0.637781 0.962300 1.293802 1.623598 1.910194 0.353508 0.625937 1.050232 1.343506 1.742985 0.092929 0.488000 0.864319 1.233651 1.609043 0.033469 0.414020 0.804580 1.109133 1.582193 1.963439 0.408246 0.805244 1.229890 1.616430 -0.005644 0.499002 0.871222 1.383619 1.742006 0.241871 0.636412 1.111292 1.523864 0.013426 0.430112 0.957489 1.390576 1.854792 0.298131 0.775965 1.336493 1.765508 0.284032 0.739560 1.225735 1.770015 0.245509 0.759950 1.283127 1.750994 0.271698 0.822357 1.329050 1.911458 0.424517 0.913054 1.452733 0.010207 0.507166 1.142838 1.653176 0.267116 0.766064 1.355041 1.954872 0.526119 1.075422 1.710371 0.220956 0.795713 1.455244 0.009017 0.572263 1.233742 1.805199 0.351214 1.029595 1.670810 0.244898 0.937764 1.599384 0.123281 0.827498 1.421956 0.071912 0.728628 1.352525 0.045071 0.629616 1.340343 -0.005599 0.656031 1.375774 0.006637 0.704005 1.346778 0.026276 0.793500 1.469628 0.149189 0.900114 1.563003 0.245092 0.942737 1.649937 0.383461 1.127594 1.833496 0.630173 1.303349 0.131274 0.795917 1.555017 0.354577 1.010369 1.836168 0.566636 1.392645 0.086446 0.905432 1.674552 0.357250 1.244274 1.933313 0.772802 1.613083 0.347109 1.198474 -0.009249 0.816204 1.581830 0.444697 1.252833 0.100839 0.820624 1.756368 0.556323 1.425952 0.202073 1.114604 1.862430 0.795077 1.577287 0.478129 1.375476 0.190400 1.049976 -0.001037 0.879181 1.750477 0.621432 1.466044 0.413933 1.258876 0.154463 1.083320 0.023406 0.861084 1.792442 0.739423 1.747839 0.555786 1.545715 0.467356 1.398174 0.305932 1.268574 0.245015 1.132661 0.145880 1.048422 0.017779 0.982729 1.923364 0.991511 1.957307 0.987170 1.902716 0.862590 1.910349 0.888567 1.920187 0.891111 1.886256 0.901663 1.918496 0.888352 1.914645 0.897685 -0.010739 0.984051 0.045577 1.089818 0.179909 1.199148 0.242854 1.360751 0.407503 1.407270 0.484554 1.541970 0.605558 1.705736 0.805033 1.904246 0.915747 0.018600 1.130323 0.275353 1.311301 0.394011 1.535459 0.601518 1.753472 0.894346 0.028620 1.161824 0.267287 1.447242 0.509507 1.658579 0.805465 0.032994 1.137888 0.321598 1.466044 0.648028 1.757642 1.015016 0.177874 1.323344 0.563863 1.750425 0.967203 0.229423 1.447094 0.698358)
+ 23.671929 #(0.000000 1.394774 0.712446 0.011390 1.320968 0.659351 -0.008320 1.313240 0.694851 0.060183 1.432654 0.813529 0.163626 1.535999 0.879450 0.278926 1.617184 1.004506 0.375540 1.782345 1.197449 0.607355 0.002396 1.363420 0.756097 0.185031 1.621603 1.037243 0.483395 1.928119 1.363762 0.804526 0.189778 1.651558 1.062208 0.500941 -0.075074 1.405257 0.890818 0.394842 1.911903 1.355672 0.849224 0.301066 1.807390 1.255870 0.693187 0.227600 1.735043 1.242178 0.742336 0.233952 1.762299 1.270235 0.790011 0.308951 1.836644 1.354488 0.921400 0.494999 0.025201 1.587671 1.103973 0.691355 0.220676 1.734558 1.286929 0.843709 0.410420 -0.006971 1.607196 1.209111 0.751765 0.386155 1.942608 1.557321 1.164938 0.751583 0.327905 1.936579 1.577912 1.206377 0.857161 0.505199 0.118727 1.717026 1.345140 0.993575 0.646730 0.303538 -0.011386 1.650842 1.312008 0.942736 0.567994 0.248650 1.939815 1.633206 1.347278 1.045017 0.717493 0.404068 0.067008 1.765012 1.486042 1.162071 0.894044 0.630469 0.397971 0.091219 1.810554 1.526476 1.250148 0.961972 0.700896 0.483003 0.223175 1.963082 1.710143 1.486233 1.218696 0.988351 0.739642 0.554498 0.355837 0.133963 1.915891 1.705644 1.523419 1.285832 1.053062 0.874125 0.692572 0.484481 0.311565 0.170248 1.976224 1.742644 1.599596 1.464221 1.277195 1.116864 0.962109 0.809938 0.634326 0.497278 0.396860 0.284580 0.128985 -0.071217 1.797139 1.689775 1.561871 1.443254 1.404159 1.268988 1.090595 1.014300 0.948946 0.849232 0.746745 0.663564 0.581278 0.529565 0.441404 0.352080 0.331281 0.258865 0.169196 0.108151 0.057169 0.008492 1.949526 1.938926 1.918542 1.813205 1.824349 1.830337 1.762353 1.746749 1.769559 1.736903 1.696380 1.708741 1.693274 1.668654 1.702992 1.761560 1.718068 1.712045 1.783757 1.824135 1.787552 1.872780 1.931601 1.904160 -0.054686 0.045327 0.087323 0.111606 0.190216 0.218731 0.277511 0.375174 0.454469 0.525126 0.598612 0.697356 0.774922 0.813883 0.920068 1.048886 1.190227 1.277134 1.333680 1.438283 1.560240 1.699496 1.824833 1.976083 0.100327 0.235895 0.398739 0.489620 0.625797 0.806554 0.956104 1.099545 1.234377 1.401592 1.603650 1.788527 1.956992 0.141911 0.268264 0.480605 0.673081 0.875537 1.064387 1.257849 1.454531 1.716863 1.919865 0.129815 0.306350 0.577622 0.772298 1.036637 1.213402 1.513774 1.729662 -0.002596 0.208869 0.488779 0.685562 0.981987 1.211994 1.498318 1.771767 0.102947 0.329653 0.640725 0.943659 1.210741 1.456094 1.730763 0.047563 0.349860 0.721965 1.014490 1.351627 1.621199 1.982774 0.271984 0.626092 0.960662 1.279387 1.631453 1.909420 0.358768 0.626258 1.065703 1.352080 1.733193 0.090620 0.485078 0.863194 1.232466 1.604769 0.046467 0.420883 0.806679 1.118547 1.582862 1.969919 0.406212 0.804928 1.217456 1.613674 -0.002335 0.501556 0.874690 1.391434 1.743749 0.230084 0.640621 1.109027 1.523323 0.024025 0.428615 0.967310 1.387309 1.847686 0.298267 0.764416 1.340389 1.762131 0.294339 0.729188 1.230573 1.747255 0.261177 0.768666 1.299822 1.752087 0.274965 0.810803 1.332883 1.911034 0.431328 0.924227 1.456104 0.011967 0.512099 1.153407 1.655289 0.277959 0.756008 1.365887 1.950449 0.530665 1.070693 1.715361 0.220081 0.797361 1.455116 0.018653 0.570229 1.237031 1.800803 0.351577 1.033360 1.674236 0.246152 0.935462 1.598491 0.130968 0.813866 1.422645 0.076390 0.727354 1.354867 0.043180 0.630693 1.349296 -0.010156 0.662877 1.386692 -0.000234 0.700841 1.361643 0.025338 0.791248 1.467397 0.147530 0.905656 1.576415 0.249147 0.951858 1.647660 0.379926 1.119037 1.837465 0.628540 1.307793 0.124757 0.807484 1.562900 0.346466 1.015329 1.814495 0.567565 1.397053 0.084414 0.887038 1.685760 0.363451 1.243000 1.937877 0.756922 1.610544 0.355044 1.195580 -0.011045 0.819695 1.584370 0.458439 1.249964 0.092165 0.810572 1.762628 0.546518 1.441999 0.184963 1.122115 1.857001 0.792761 1.561414 0.480428 1.365453 0.196430 1.050124 -0.001030 0.870676 1.745548 0.631218 1.470766 0.421821 1.242678 0.163647 1.078029 0.030979 0.859462 1.794884 0.730493 1.745946 0.557381 1.548194 0.471779 1.399659 0.300074 1.268305 0.253862 1.130144 0.144439 1.052163 0.019837 0.984609 1.918876 0.993764 1.965206 0.986351 1.891665 0.866004 1.908249 0.900866 1.931553 0.902848 1.883758 0.893879 1.911009 0.894248 1.918833 0.906771 -0.008589 1.000182 0.039433 1.077034 0.171908 1.195972 0.264925 1.357117 0.408478 1.398499 0.476193 1.546542 0.595313 1.722825 0.806510 1.895014 0.919561 0.011635 1.126697 0.267939 1.310178 0.397573 1.531947 0.593069 1.751591 0.893706 0.031306 1.162353 0.275347 1.437714 0.516873 1.653660 0.810480 0.034958 1.132399 0.325845 1.473179 0.656546 1.760044 1.029004 0.197563 1.319950 0.556254 1.759284 0.969808 0.241789 1.454259 0.717776)
)
;;; 1024 odd --------------------------------------------------------------------------------
(vector 1024 52.508 #r(0 1 0 1 0 0 1 1 0 1 0 1 0 0 1 0 1 0 0 0 0 0 0 1 1 1 1 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 0 1 1 0 0 1 0 1 1 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 0 1 1 1 1 1 1 1 1 1 0 0 1 1 1 0 0 0 0 1 1 1 1 1 1 0 1 1 1 1 1 0 0 0 1 1 0 0 0 0 0 0 0 0 1 1 1 1 1 0 1 0 0 1 0 0 0 0 1 0 0 1 0 0 1 1 0 1 0 0 1 1 0 0 0 0 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 0 1 0 0 1 1 0 1 1 0 0 1 1 0 1 0 1 0 1 1 0 1 0 0 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 1 1 1 0 1 0 0 1 1 0 0 0 1 1 0 0 0 1 0 0 0 0 0 0 1 0 1 1 0 1 1 0 1 0 1 1 0 0 1 0 0 1 0 0 0 0 0 0 1 0 0 0 1 0 1 0 1 1 1 0 0 1 1 1 0 1 0 0 1 1 0 0 1 1 1 0 1 0 1 1 0 0 0 1 0 0 0 0 0 0 1 1 0 0 1 1 1 1 1 0 0 0 1 1 0 1 1 0 1 0 1 0 1 0 1 0 0 1 1 1 0 1 1 1 1 1 0 0 0 0 1 0 0 1 0 0 0 0 0 1 0 0 1 1 0 1 0 0 0 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 1 1 1 0 0 1 0 1 1 1 1 0 0 0 1 0 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 1 0 0 1 1 0 1 0 1 0 0 1 1 0 0 1 1 1 0 1 0 0 0 1 1 1 1 0 0 1 0 0 0 1 1 1 0 0 0 1 1 1 1 0 0 1 0 1 0 1 0 0 1 1 0 1 1 0 1 1 1 0 0 1 0 1 0 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1 0 0 1 1 0 1 0 1 1 0 1 1 0 0 1 1 0 0 1 1 0 1 1 0 1 0 0 1 1 0 1 1 1 1 0 1 1 0 0 1 1 0 1 0 1 0 0 1 0 1 0 1 1 1 1 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 0 1 0 1 1 1 1 0 1 1 1 1 1 1 0 0 0 1 1 1 0 1 1 1 1 0 1 1 1 1 0 0 0 1 1 0 0 1 0 1 1 0 0 1 0 1 1 0 1 1 0 0 0 0 0 0 1 0 1 0 1 1 0 0 1 1 1 1 1 0 1 0 0 0 1 1 1 0 1 1 0 0 1 0 0 1 0 0 0 1 0 1 0 0 1 1 1 1 1 1 1 1 0 1 1 1 1 0 1 0 1 1 0 1 0 0 1 1 0 0 1 0 0 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 0 1 1 1 1 1 0 1 0 1 1 1 1 0 1 0 1 0 1 1 1 0 1 0 0 1 1 1 1 0 1 1 1 0 1 1 1 1 1 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 1 1 1 1 1 1 0 1 0 0 1 1 0 1 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 1 0 1 1 0 0 1 1 1 1 0 0 1 0 1 0 0 0 1 0 0 0 1 1 1 1 1 1 0 0 1 0 0 1 1 0 0 1 1 1 1 0 0 0 0 0 1 1 1 1 0 1 0 1 1 1 1 1 0 0 0 1 1 1 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 1 1 1 1 0 1 0 0 1 0 0 1 0 0 0 1 0 1 0 1 1 0 1 1 1 0 0 1 1 1 1 1 1 1 0 1 0 1 1 0 1 1 0 0 0 1 1 0 0 1 1 0 1 1 1 1 1 0 0 0 0 1 0 0 1 0 1 1 1 0 0 1 0 1 1 0 0 0 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 0 0 0 1 0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 1 0 0 1 0 0 1 0 0 0 0 0 1 1 1 0 1 0 0 0 1 0 0 0 0 1 1 0 1 0 1 0 0 0 0 0 1 0 0 1 1 1 1 0 1 0 0 1 1 0 0 0 0 0 1 0 1 0 1 0 1 1 0 0)
;; pp:
- 34.392721 #r(0.000000 1.317015 0.674779 1.982962 1.240298 0.528350 1.833009 1.184236 0.493774 1.806145 1.182946 0.448825 1.821424 1.151757 0.480986 1.763416 1.095092 0.480961 1.791102 1.089742 0.425064 1.810482 1.139747 0.479199 1.851874 1.159831 0.593521 1.908566 1.257454 0.624639 1.923688 1.356173 0.730179 0.065917 1.453464 0.796504 0.143823 1.498311 0.930898 0.268139 1.670589 1.071439 0.437215 1.830479 1.211388 0.579275 1.944545 1.352798 0.782323 0.163213 1.546183 0.998593 0.372903 1.740779 1.173402 0.607928 1.957457 1.421061 0.794849 0.200913 1.627038 1.034849 0.443314 1.872228 1.278283 0.705912 0.120047 1.589838 1.008630 0.435503 1.873305 1.305243 0.750876 0.182690 1.613160 1.076228 0.522005 1.956954 1.342360 0.862346 0.285706 1.760264 1.217014 0.657381 0.105715 1.596004 1.072881 0.509956 1.989648 1.482549 0.909572 0.382452 1.811853 1.285963 0.790319 0.256573 1.787382 1.233231 0.764390 0.267593 1.710421 1.204241 0.717040 0.198483 1.666956 1.176156 0.629456 0.175734 1.712604 1.178350 0.682452 0.188929 1.683627 1.202732 0.719895 0.262572 1.790292 1.295239 0.795972 0.278798 1.833102 1.391719 0.903871 0.449916 1.974967 1.508707 1.037936 0.583107 0.141605 1.703044 1.238440 0.740044 0.299258 1.855225 1.429576 0.989596 0.514764 0.062488 1.647875 1.166263 0.761797 0.338506 1.886563 1.481742 1.044532 0.567257 0.147738 1.716688 1.294451 0.881968 0.450214 0.034958 1.623040 1.198786 0.793126 0.363888 1.989592 1.572534 1.171188 0.776534 0.389043 1.952235 1.569973 1.168583 0.777864 0.378289 -0.001325 1.586748 1.247726 0.850390 0.447022 0.074915 1.698680 1.326882 0.923704 0.565421 0.237083 1.853803 1.462394 1.056831 0.725010 0.363991 0.012216 1.652820 1.277504 0.885858 0.571701 0.222046 1.859385 1.459785 1.149298 0.900479 0.511390 0.159291 1.820323 1.458104 1.134095 0.799510 0.484897 0.157474 1.805324 1.476907 1.156786 0.816645 0.506771 0.217712 1.883199 1.597354 1.267437 0.968501 0.643403 0.348141 0.020835 1.704752 1.434890 1.117956 0.830415 0.530503 0.257242 1.947331 1.636892 1.333893 1.094111 0.807494 0.497231 0.208241 1.915803 1.637253 1.344506 1.123056 0.818815 0.558438 0.305779 0.033645 1.746424 1.518158 1.254602 0.968482 0.703273 0.446681 0.191633 1.923009 1.675267 1.476497 1.243700 0.963799 0.702657 0.470865 0.216712 1.947604 1.723443 1.524612 1.317633 1.059361 0.803260 0.606501 0.385543 0.151108 1.924868 1.695521 1.503299 1.281531 1.057219 0.859940 0.639048 0.449655 0.223761 0.026912 1.843647 1.609629 1.457584 1.243217 1.015301 0.856152 0.640867 0.449759 0.305372 0.109063 1.942683 1.700967 1.531585 1.369794 1.168417 1.002048 0.845104 0.663340 0.497202 0.326517 0.140599 1.976113 1.831407 1.680660 1.549301 1.318125 1.191866 1.065805 0.880646 0.703951 0.550638 0.452796 0.318542 0.141930 -0.012601 1.907136 1.768430 1.584977 1.494785 1.346262 1.172515 1.087240 0.966198 0.858840 0.703924 0.583577 0.474879 0.356476 0.197334 0.117696 0.015827 1.890727 1.784295 1.703630 1.595638 1.506189 1.428853 1.274571 1.233343 1.102367 1.018735 0.924053 0.785452 0.761105 0.689124 0.597680 0.499179 0.407270 0.343269 0.277076 0.175925 0.088491 0.032717 1.967765 1.919505 1.879027 1.804127 1.733139 1.641796 1.606538 1.554956 1.479897 1.436117 1.392760 1.340159 1.307310 1.256130 1.185964 1.154240 1.120113 1.056364 1.031418 1.011146 1.002760 0.949072 0.908672 0.908037 0.883988 0.852980 0.834564 0.819259 0.795425 0.760734 0.784982 0.783111 0.748706 0.732608 0.767981 0.770232 0.734127 0.724984 0.741588 0.719772 0.746177 0.752984 0.689077 0.730980 0.788291 0.778438 0.770103 0.834963 0.846761 0.844355 0.877284 0.886824 0.967748 0.943247 0.953145 0.998516 1.074936 1.134627 1.111633 1.183518 1.239447 1.257881 1.304163 1.349165 1.420127 1.460314 1.496520 1.556878 1.614974 1.710803 1.681591 1.773792 1.838949 1.957629 0.007509 0.060966 0.115693 0.179937 0.241468 0.370584 0.498441 0.512979 0.546150 0.672229 0.777236 0.837830 0.920719 1.012615 1.155268 1.230312 1.320616 1.421802 1.501826 1.610987 1.679360 1.836841 1.934427 0.048217 0.190841 0.256986 0.405599 0.477014 0.615469 0.744693 0.842741 1.035072 1.099483 1.194667 1.378972 1.515049 1.643373 1.758812 1.911300 0.069797 0.206668 0.341125 0.455780 0.613455 0.755668 0.907850 1.081007 1.195602 1.383308 1.535129 1.721055 1.878218 0.041536 0.189026 0.353901 0.557274 0.704028 0.848737 1.054909 1.205891 1.405592 1.560938 1.774026 1.957109 0.091600 0.275670 0.473243 0.686721 0.885668 1.094370 1.301170 1.471171 1.681947 1.843932 0.083106 0.309503 0.504329 0.657776 0.958045 1.134304 1.324317 1.567796 1.766909 -0.010677 0.204548 0.402525 0.672227 0.872133 1.100672 1.351290 1.618868 1.843408 0.075626 0.310891 0.533995 0.758681 1.049764 1.305644 1.509216 1.751579 -0.013073 0.274157 0.516916 0.787195 1.008768 1.270118 1.566936 1.844511 0.111113 0.352928 0.603624 0.891444 1.163881 1.458453 1.733841 0.023761 0.272991 0.561395 0.839977 1.118462 1.400784 1.742015 0.003935 0.343587 0.574049 0.863833 1.186411 1.499354 1.787869 0.097742 0.435769 0.722422 1.020105 1.302404 1.633505 1.971294 0.287332 0.601601 0.938262 1.263087 1.592727 1.925082 0.218290 0.545858 0.867906 1.215434 1.551258 1.932054 0.206490 0.558053 0.870542 1.249383 1.578868 1.965694 0.297948 0.669516 1.033694 1.365067 1.747836 0.132641 0.442218 0.763117 1.198426 1.557543 1.923389 0.271522 0.661990 1.014563 1.444192 1.797008 0.161991 0.524112 0.888782 1.298446 1.718909 0.076039 0.484430 0.839832 1.306121 1.668787 0.083313 0.435491 0.879913 1.257582 1.690719 0.080308 0.506436 0.891141 1.311805 1.764926 0.152722 0.559148 0.971038 1.448176 1.861615 0.252724 0.712441 1.076577 1.539614 1.971176 0.471842 0.835551 1.309070 1.717329 0.180700 0.636594 1.064174 1.544102 -0.007762 0.416278 0.869839 1.382020 1.815476 0.242696 0.711954 1.170869 1.650991 0.114702 0.570777 1.081829 1.495277 0.019284 0.487771 0.924782 1.480485 1.900085 0.404735 0.867120 1.327489 1.826631 0.358328 0.808934 1.333994 1.818046 0.333979 0.806858 1.380168 1.806454 0.359466 0.853343 1.382938 1.862803 0.340011 0.872790 1.396435 1.899417 0.442767 0.947972 1.493994 1.980445 0.529919 1.068138 1.589158 0.137689 0.663574 1.181143 1.752788 0.322938 0.820947 1.373072 1.889133 0.445963 0.992038 1.528221 0.095252 0.632298 1.198655 1.748035 0.297075 0.936319 1.444019 0.047595 0.589072 1.154608 1.695982 0.330959 0.852209 1.389811 0.077042 0.588685 1.198301 1.795185 0.391299 0.937105 1.523925 0.144908 0.714581 1.301387 1.939659 0.493164 1.107096 1.703099 0.316955 0.870409 1.501496 0.129186 0.711707 1.317045 1.978135 0.584637 1.224551 1.868953 0.442970 1.080315 1.707774 0.357018 0.974517 1.620426 0.235492 0.841352 1.521747 0.123410 0.790984 1.421592 0.064670 0.723003 1.351207 0.045603 0.693853 1.324941 1.912908 0.655177 1.230998 1.943702 0.623916 1.262813 1.966107 0.647728 1.291260 -0.014812 0.660846 1.298115 1.981874 0.677526 1.342226 0.031840 0.703622 1.442866 0.109986 0.793203 1.504134 0.206491 0.825844 1.597562 0.229750 0.978345 1.663467 0.352650 1.124308 1.766717 0.525984 1.219293 1.922574 0.634505 1.397287 0.124002 0.815463 1.541148 0.270810 0.971099 1.707596 0.437736 1.212172 1.890534 0.685239 1.396549 0.142117 0.918957 1.612171 0.353680 1.097854 1.856615 0.625689 1.360735 0.144106 0.868556 1.645077 0.371361 1.159444 1.934695 0.709026 1.444089 0.261765 0.979371 1.759253 0.586016 1.331408 0.040944 0.869861 1.656050 0.398966 1.230315 -0.011049 0.832509 1.590410 0.444043 1.224804 1.942115 0.805768 1.569036 0.391426 1.193271 0.004924 0.842160 1.602154 0.437188 1.258662 0.040043 0.863713 1.717625 0.507115 1.354811 0.156612 1.008626 1.821294 0.688919 1.479431 0.297482 1.146867 -1.810005 0.794603 1.643039 0.507902 1.394627 0.290315 1.060141 1.927240 0.768749 1.644777 0.486261 1.317365 0.218780 1.036302 1.922905 0.779349 1.630284 0.563756 1.406014 0.271501 1.141687 0.041164 0.874901 1.775827 0.668920 1.546772 0.364463 1.296432 0.170145 1.097114 1.973808 0.882000 1.792309 0.693487 1.612279 0.474678 1.407303 0.261600 1.229905 0.148970 1.031540 1.947561 0.833597 1.730941 0.706036 1.602109 0.526360 1.446317 0.373717 1.307908 0.239206 1.185883 0.110452 1.032954 1.964211 0.907562 1.815735 0.787542 1.710692 0.656401 1.632264 0.576380 1.564089 0.528884 1.469549 0.431489 1.360957 0.347473 1.293543 0.222180 1.220673 0.162142 1.148842 0.133424 1.094691 0.066720 1.019692 -0.006786 1.047790 0.011236 0.965321 -0.001627 0.937877 1.944261 0.948457 1.895707 0.938491 1.920374 0.874935 1.899449 0.872969 1.896569 0.903922 1.912216 0.936328 1.952448 0.974497 -0.020866 1.017959 0.034307 1.070969 0.074184 1.113113 0.135779 1.148879 0.214381 1.271662 0.291028 1.343329 0.357341 1.403370 0.477523 1.529396 0.455395 1.531182 0.601378 1.631083 0.711227 1.779155 0.803158 1.876551 0.904319 -0.035936 1.056817 0.081070 1.174378 0.241814 1.361054 0.443021 1.490091 0.588025 1.673301 0.764365 1.818515 0.913749 -1.572594 1.052243 0.145347 1.264925 0.396952 1.483333 0.517869 1.682100 0.797822 1.866022 0.903075 0.059188 1.174828 0.259185 1.333418 0.505568 1.549370 0.702792 1.812741 0.956324 0.074522 1.232362 0.362743 1.384904 0.593454 1.680361 0.825559 -0.014856 1.137655 0.232493 1.374902 0.524195 1.748587 0.847680 -0.019007 1.123158 0.242002 1.489181 0.571161 1.741577 0.879445 0.077203 1.250223 0.427139 1.517047 0.773877 1.934390 1.107301 0.293756 1.489154 0.668130 1.818952 0.975240 0.242147 1.451579)
+ 34.271047 #(0.000000 1.320286 0.676396 1.982067 1.243285 0.530540 1.836077 1.181314 0.495360 1.805455 1.182203 0.446884 1.820708 1.148827 0.479624 1.764699 1.092567 0.473891 1.792057 1.086949 0.425390 1.812367 1.136015 0.479118 1.850496 1.163776 0.592084 1.910319 1.261672 0.626769 1.926417 1.354493 0.721851 0.062240 1.452208 0.798194 0.138340 1.500821 0.933689 0.273625 1.670453 1.073444 0.435300 1.826218 1.213403 0.575384 1.942307 1.350286 0.778789 0.162530 1.549572 1.002443 0.381038 1.742959 1.178236 0.609543 1.960795 1.419761 0.799043 0.200374 1.631548 1.032043 0.443914 1.867990 1.277010 0.709283 0.121743 1.587466 1.011315 0.437186 1.871059 1.307388 0.743378 0.185134 1.612769 1.069970 0.519362 1.950754 1.344436 0.861015 0.286803 1.756503 1.216824 0.659531 0.109237 1.595803 1.070459 0.514447 1.993047 1.482657 0.905650 0.381008 1.807679 1.288054 0.789652 0.257641 1.782170 1.232725 0.760718 0.269447 1.711444 1.205969 0.718355 0.195599 1.670325 1.176261 0.636401 0.177764 1.713954 1.181018 0.684072 0.191111 1.684531 1.198787 0.719941 0.266117 1.788749 1.300425 0.797428 0.278584 1.829348 1.392428 0.904169 0.448408 1.975741 1.505644 1.036008 0.578937 0.144777 1.702647 1.236923 0.737498 0.302638 1.858061 1.433334 0.992978 0.513885 0.061198 1.646116 1.169739 0.764058 0.338942 1.885100 1.480157 1.037592 0.568741 0.143027 1.714739 1.299200 0.880284 0.450933 0.032583 1.626589 1.201663 0.792338 0.366811 1.986725 1.572061 1.171330 0.778476 0.388309 1.956758 1.563539 1.170336 0.774974 0.375951 -0.000870 1.591651 1.251388 0.847953 0.445214 0.077517 1.704802 1.324047 0.921917 0.564564 0.238857 1.855130 1.464984 1.051943 0.721308 0.361542 0.014850 1.653520 1.278928 0.883589 0.573559 0.218623 1.864847 1.462232 1.147502 0.903078 0.514453 0.161133 1.820542 1.455362 1.128657 0.798180 0.481873 0.160263 1.809901 1.474548 1.155182 0.813753 0.511114 0.219909 1.884898 1.594997 1.263319 0.970639 0.642492 0.344426 0.019243 1.707391 1.433353 1.116000 0.828260 0.529503 0.258191 1.946200 1.637545 1.330753 1.094840 0.807647 0.498356 0.213661 1.917452 1.635824 1.347813 1.125503 0.822216 0.561762 0.302279 0.030027 1.744579 1.519178 1.255130 0.969203 0.705607 0.446003 0.192855 1.923225 1.675224 1.471309 1.242826 0.964470 0.701302 0.463872 0.216858 1.945894 1.727774 1.522281 1.315299 1.053989 0.802406 0.601333 0.384963 0.154977 1.925846 1.691317 1.496317 1.284308 1.065509 0.861886 0.635625 0.448817 0.222164 0.026618 1.834850 1.612010 1.455866 1.244781 1.017828 0.858349 0.642883 0.451590 0.304144 0.113656 1.938931 1.703429 1.535716 1.372923 1.166776 0.998544 0.846307 0.662120 0.497727 0.324538 0.141290 1.978592 1.831180 1.681930 1.550011 1.319178 1.194020 1.061617 0.884394 0.702566 0.553099 0.456051 0.318288 0.131236 -0.008006 1.906701 1.766192 1.588478 1.502348 1.343888 1.170516 1.084103 0.969319 0.854676 0.703360 0.580386 0.476301 0.359305 0.196760 0.117628 0.016071 1.884653 1.787595 1.701695 1.598971 1.507174 1.428959 1.272835 1.236664 1.106689 1.019903 0.923250 0.782972 0.760812 0.687952 0.597168 0.504599 0.409334 0.347007 0.275528 0.182185 0.093535 0.034980 1.961654 1.921602 1.879333 1.803714 1.738036 1.639907 1.601491 1.554722 1.480998 1.438904 1.392097 1.342542 1.305402 1.257821 1.190050 1.154675 1.123828 1.062711 1.033572 1.014626 1.004467 0.942332 0.906123 0.911169 0.883482 0.856198 0.835593 0.821589 0.797753 0.758807 0.787956 0.784870 0.750275 0.730164 0.762687 0.771782 0.732226 0.727821 0.741936 0.722177 0.747771 0.750276 0.685645 0.733547 0.784996 0.781915 0.769885 0.832250 0.842163 0.844782 0.874569 0.886737 0.968715 0.942868 0.950734 1.000233 1.077428 1.134512 1.109538 1.184945 1.241133 1.261793 1.304147 1.353627 1.420237 1.460613 1.493267 1.555977 1.613428 1.709635 1.679231 1.772497 1.838875 1.955684 0.009576 0.062211 0.123309 0.177382 0.236147 0.368109 0.494920 0.513417 0.544486 0.670501 0.776768 0.838474 0.918021 1.017400 1.154399 1.225090 1.318464 1.419002 1.500500 1.611018 1.681808 1.835520 1.934569 0.046167 0.190146 0.259277 0.403317 0.476059 0.614265 0.742039 0.841147 1.033016 1.100608 1.192938 1.386237 1.517777 1.642112 1.759198 1.912498 0.074043 0.203712 0.338690 0.456250 0.613343 0.750996 0.904317 1.080341 1.196795 1.377374 1.532505 1.723156 1.879303 0.039271 0.188840 0.350308 0.556920 0.704255 0.848541 1.056223 1.213896 1.405928 1.568302 1.776279 1.955280 0.092637 0.280256 0.471838 0.682648 0.885232 1.094005 1.298697 1.470775 1.682635 1.843739 0.082071 0.304418 0.501593 0.659460 0.950325 1.130545 1.329534 1.567897 1.767920 -0.008184 0.198647 0.398357 0.673290 0.874703 1.100281 1.347100 1.620063 1.844991 0.079358 0.313053 0.533006 0.756430 1.055956 1.305919 1.507946 1.752557 -0.010216 0.275989 0.517842 0.786009 1.009391 1.270424 1.564553 1.845657 0.107373 0.350936 0.601741 0.893631 1.160570 1.456505 1.730638 0.021814 0.272744 0.560788 0.838833 1.118321 1.398694 1.741803 0.005633 0.340402 0.570853 0.860526 1.191313 1.498541 1.791770 0.098528 0.433197 0.715757 1.017240 1.297789 1.635947 1.969598 0.288362 0.602945 0.942271 1.265649 1.592001 1.925800 0.216574 0.545007 0.863973 1.216046 1.548811 1.931012 0.206589 0.560209 0.870849 1.248169 1.575639 1.968174 0.298656 0.668812 1.032889 1.367303 1.747227 0.131205 0.443388 0.763197 1.197845 1.560824 1.922638 0.270063 0.663340 1.015306 1.444191 1.797425 0.161887 0.525022 0.888065 1.303746 1.714275 0.081811 0.484861 0.841496 1.307494 1.668170 0.079368 0.429335 0.880923 1.256027 1.695841 0.080221 0.509503 0.891158 1.313571 1.768378 0.151036 0.562459 0.973975 1.445432 1.864233 0.252400 0.718591 1.072456 1.537629 1.978561 0.472725 0.839575 1.309493 1.718903 0.179856 0.637196 1.066704 1.544338 -0.011794 0.420049 0.867921 1.380862 1.809680 0.241806 0.712891 1.168969 1.651955 0.114226 0.569213 1.084201 1.491013 0.017302 0.488713 0.923072 1.477559 1.895148 0.404595 0.866696 1.319535 1.826643 0.360112 0.812646 1.338345 1.819999 0.331649 0.806186 1.380027 1.810674 0.361888 0.854117 1.380972 1.857605 0.339551 0.871263 1.399643 1.896037 0.444376 0.945656 1.487929 1.977678 0.530764 1.066264 1.589039 0.137788 0.662869 1.181856 1.752064 0.319450 0.819525 1.373739 1.887127 0.443724 0.989453 1.529563 0.095851 0.634300 1.201103 1.749086 0.294556 0.932432 1.439119 0.047505 0.593487 1.156096 1.696467 0.336138 0.854778 1.389146 0.076604 0.589223 1.200124 1.793692 0.395450 0.936585 1.523407 0.143491 0.711929 1.296012 1.936224 0.497823 1.106691 1.703029 0.310751 0.869305 1.501394 0.128383 0.709213 1.320836 1.976274 0.582673 1.222646 1.869876 0.436487 1.084391 1.701717 0.354862 0.973861 1.619102 0.232912 0.840772 1.520085 0.127672 0.786594 1.420573 0.067146 0.724881 1.352446 0.042038 0.695191 1.332329 1.912892 0.662284 1.232065 1.950128 0.627201 1.265750 1.969315 0.642511 1.285861 -0.020500 0.661694 1.295349 1.984356 0.673906 1.338806 0.039098 0.704885 1.446968 0.110456 0.788719 1.505525 0.207953 0.823809 1.597883 0.230890 0.980349 1.663658 0.356840 1.128139 1.768903 0.522971 1.217506 1.924282 0.640035 1.393796 0.123616 0.815284 1.548587 0.266072 0.975870 1.703876 0.432900 1.214445 1.884314 0.688760 1.396370 0.144995 0.917953 1.607453 0.354042 1.103062 1.863796 0.623277 1.360185 0.144290 0.862865 1.644453 0.370636 1.158082 1.937878 0.710063 1.444589 0.251644 0.979938 1.762308 0.589861 1.336851 0.047923 0.870163 1.658442 0.402337 1.227823 -0.007241 0.834381 1.593721 0.446431 1.226041 1.946224 0.806841 1.560940 0.394291 1.188209 0.003903 0.840052 1.603862 0.438844 1.256941 0.037853 0.860854 1.712333 0.506346 1.360070 0.152783 1.010568 1.818584 0.689531 1.484168 0.297179 1.145462 -1.816230 0.794502 1.642687 0.508945 1.390944 0.289730 1.055832 1.931797 0.765099 1.641017 0.486231 1.314874 0.219552 1.036509 1.920377 0.779356 1.629134 0.566449 1.409719 0.273234 1.137342 0.041264 0.874688 1.776517 0.668906 1.543925 0.362163 1.288055 0.171358 1.092734 1.973875 0.883525 1.792310 0.694638 1.612304 0.474091 1.404780 0.262469 1.229483 0.150645 1.031657 1.945078 0.833516 1.730904 0.706660 1.598946 0.529648 1.446683 0.372159 1.309763 0.232389 1.185386 0.108553 1.035581 1.967785 0.900118 1.817232 0.784603 1.712791 0.650860 1.628638 0.575261 1.560527 0.530897 1.474276 0.432087 1.361782 0.341886 1.293642 0.225670 1.218017 0.158296 1.145380 0.131011 1.092986 0.066169 1.016833 -0.008260 1.047977 0.006141 0.962919 0.003412 0.935865 1.942137 0.952761 1.900045 0.940044 1.921467 0.878720 1.898715 0.870485 1.897081 0.901692 1.917397 0.937583 1.954879 0.973668 -0.025007 1.020496 0.029704 1.070736 0.072039 1.112798 0.134806 1.144491 0.217013 1.272078 0.289904 1.345119 0.363564 1.408583 0.476459 1.532536 0.456571 1.527931 0.602080 1.631818 0.714381 1.783772 0.804988 1.878848 0.905289 -0.042325 1.057476 0.083283 1.173706 0.242988 1.362175 0.445551 1.486807 0.585886 1.670762 0.759426 1.820535 0.914177 -1.577562 1.051449 0.144083 1.263371 0.398651 1.486124 0.516462 1.678988 0.793688 1.866926 0.903199 0.059715 1.174595 0.260992 1.334032 0.503175 1.546750 0.702193 1.804483 0.953330 0.071288 1.232057 0.362157 1.386255 0.594031 1.674396 0.828409 -0.013684 1.132416 0.234535 1.370848 0.521680 1.745916 0.847364 -0.021190 1.127302 0.239002 1.486553 0.571531 1.741247 0.877442 0.077726 1.250225 0.420439 1.516461 0.774176 1.934408 1.106595 0.292402 1.490231 0.668929 1.818698 0.979060 0.246834 1.459329)
)
;;; 2048 odd --------------------------------------------------------------------------------
(vector 2048 83.108 #r(0 1 1 0 1 0 1 0 1 1 1 0 0 0 0 0 1 0 1 1 0 1 1 0 0 1 1 0 1 1 0 1 1 1 1 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 1 1 0 0 0 1 0 0 0 1 0 1 1 1 1 0 1 1 0 0 1 0 1 0 0 0 0 1 1 1 1 0 0 0 0 1 1 1 0 1 1 0 1 1 0 0 0 1 1 1 1 0 0 0 1 0 1 1 1 1 1 0 0 0 0 0 0 1 0 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 1 1 0 0 0 1 0 1 1 1 0 1 0 0 1 0 1 1 1 1 0 1 0 1 0 1 0 0 1 0 1 0 0 0 1 1 0 1 1 1 0 1 1 0 0 1 0 1 1 1 1 1 1 1 0 0 0 0 1 1 1 1 1 0 1 1 1 0 1 0 0 0 1 1 0 1 0 1 1 0 0 1 1 0 1 0 1 1 1 0 1 1 0 1 1 1 0 1 1 0 1 0 1 1 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 1 1 1 0 1 0 1 0 1 0 1 0 1 0 0 0 1 1 1 1 1 0 1 1 1 0 0 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 1 0 0 0 0 0 0 1 0 1 1 0 1 1 1 1 1 0 1 0 1 0 1 1 1 1 1 1 1 0 1 1 1 1 1 0 1 0 1 0 0 1 0 0 1 0 1 0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 0 0 0 0 0 1 1 1 1 0 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 1 1 1 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 0 1 1 0 0 0 1 1 1 0 1 1 0 1 0 0 0 1 1 0 0 1 0 0 0 0 1 1 1 1 1 0 0 1 1 0 0 0 1 0 1 0 0 1 0 1 0 0 0 1 1 1 0 1 0 0 1 0 0 0 0 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 1 0 0 1 1 0 1 0 0 0 0 1 1 0 1 1 0 1 1 1 0 0 1 0 0 0 0 1 0 1 1 1 0 1 0 1 0 0 1 1 1 0 1 1 0 1 1 0 1 1 1 0 0 1 1 0 0 1 1 0 0 0 1 0 1 1 0 0 1 1 1 1 1 1 0 0 0 1 0 1 0 0 0 1 0 1 1 1 1 0 1 0 0 1 0 0 0 0 1 0 0 0 1 0 0 1 1 1 0 0 0 0 1 0 0 1 0 1 0 1 1 1 0 1 0 1 0 0 0 0 1 0 0 1 0 1 1 0 1 0 1 0 0 0 0 0 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 1 0 1 0 0 1 0 1 1 0 1 0 0 0 1 1 1 1 1 1 1 0 0 1 1 1 1 1 1 1 1 0 1 1 0 1 0 0 0 0 1 0 0 0 0 1 0 1 1 0 0 0 1 0 1 1 1 0 0 0 1 0 1 1 0 1 0 0 0 1 0 0 1 0 0 1 1 0 1 1 1 1 0 0 1 0 0 1 1 0 0 1 1 0 1 0 1 0 0 0 0 0 0 0 1 0 0 0 1 0 1 1 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 0 1 1 0 1 1 0 0 0 1 0 0 1 1 0 0 1 1 1 0 0 1 1 1 0 0 0 1 0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 0 1 0 1 1 0 0 1 1 0 1 0 1 1 1 1 0 0 0 0 1 1 0 1 0 1 1 0 0 0 1 1 1 1 1 0 0 0 1 0 1 1 1 1 1 0 1 0 0 0 0 0 0 0 0 1 1 0 1 0 0 1 1 1 1 0 0 0 0 1 0 1 0 0 1 0 0 0 0 0 1 1 0 1 1 1 0 0 0 0 1 1 1 1 0 0 0 0 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 1 0 0 1 0 0 1 1 1 0 1 0 0 0 0 0 0 0 0 1 0 1 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 0 0 1 1 0 1 1 1 0 0 0 1 0 1 0 1 0 0 1 0 1 1 1 1 1 1 1 1 1 0 0 1 1 0 0 0 1 1 0 1 1 0 1 0 1 0 1 1 1 1 1 0 0 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 0 1 1 1 0 0 1 1 1 0 1 1 0 0 1 1 1 1 1 0 0 0 0 0 1 0 0 0 1 0 1 0 0 0 0 1 0 1 1 0 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 1 1 1 1 0 0 1 0 0 1 0 1 1 0 1 1 1 0 1 1 0 1 1 0 0 0 1 1 1 0 1 1 0 1 1 0 1 0 1 0 0 1 0 0 0 0 0 1 1 1 0 0 0 0 0 1 0 1 0 1 0 0 1 1 0 1 0 1 0 0 0 0 0 1 0 1 0 0 1 1 1 0 0 0 0 0 1 0 1 0 0 0 1 1 0 1 1 1 0 0 1 1 1 0 0 0 1 0 1 0 1 1 1 0 0 1 0 1 0 0 1 0 0 1 0 1 0 0 1 0 1 0 1 1 1 0 1 0 0 0 1 1 1 0 1 1 1 1 1 1 0 1 1 0 0 1 1 0 1 1 0 0 0 1 1 0 0 0 1 0 0 1 0 0 0 0 0 1 0 1 1 0 0 0 0 1 0 1 1 1 0 0 0 1 1 1 1 0 1 0 1 1 0 0 0 0 0 1 0 1 1 0 0 0 1 1 0 0 1 0 0 1 0 1 0 0 1 1 1 1 0 0 1 1 1 1 1 1 0 1 1 1 0 1 0 1 0 0 1 1 0 0 0 1 0 1 1 0 0 1 0 0 1 0 0 1 0 1 1 0 1 1 0 1 1 1 0 0 0 1 0 0 1 1 0 1 0 0 0 1 0 0 1 0 1 1 1 0 1 1 1 1 0 1 1 0 1 0 1 1 0 1 0 0 0 0 1 0 0 0 1 0 0 1 0 1 1 1 1 0 0 0 0 1 1 0 1 0 0 1 1 1 1 1 0 0 1 0 0 0 1 0 0 0 0 1 1 0 0 1 0 1 0 0 1 0 0 1 1 0 1 1 0 0 0 0 1 1 0 0 0 1 1 1 0 1 0 0 0 0 0 1 0 0 1 1 1 0 0 0 0 0 1 1 0 1 1 1 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 1 0 1 0 0 0 0 1 0 1 1 1 0 1 0 1 1 1 1 1 1 0 1 1 0 0 0 1 0 1 1 0 0 1 1 1 1 0 0 0 1 0 0 1 1 0 0 1 0 1 0 0 0 1 0 1 1 1 0 0 0 1 1 1 0 0 1 1 1 0 0 1 1 1 1 0 0 0 0 0 1 0 0 0 0 0 1 1 0 1 1 1 1 0 0 1 0 1 0 1 0 1 0 1 1 1 1 0 0 0 0 1 0 1 0 0 1 1 0 0 1 1 0 0 1 0 0 0 1 0 0 0 0 0 0 0 1 1 0 1 1 1 1 0 0 1 1 0 1 1 1 1 1 0 1 0 0 1 0 0 1 0 0 0 1 0 1 1 0 1 1 1 1 1 1 1 0 1 0 1 1 0 0 1 1 1 1 0 0 0 0 1 1 0 1 0 0 1 1 1 0 0 1 0 0 0 1 0 0 0 0 1 0 1 0 1 1 0 0 1 0 1 0 0 0 1 1 0 1 0 1 1 1 1 1 0 0 1 1 1 1 1 0 1 0 0 1 1 0 0 1 0 0 0 1 0 1 0 0 1 1 0 0 0 1 1 1 0 1 1 0 1 1 1 1 1 1 1 0 0 0 0 1 1 1 1 0 0 0 1 1 0 1 0 1 1 1 0 1 0 0 0 0 1 1 1 0 0 0 1 1 0 0 1 1 1 0 1 0 1 0 1 1 0 0 1 0 0 0 1 0 1 0 1 0 1 0 1 0 1 0 0 0 0 1 1 1 0 0 1 1 0 1 1 0 1 1 0 1 1 0 0 1 1 1 0 1 1 0 1 0 0 0 1 0 1 1 1 1 0 0 1 1 0 1 0 1 1 1 0 1 0 0 0 1 0 0 1 1 1 0 0 0 1 1 1 0 1 1 0 1 0 0 1 1 1 1 1 0 0 1 1 0 0 0 1 1 1 0 0 1 1 1 1 0 0 1 0 1 1 1 0 0 0 0 1 1 1 1 0 0 1 0 1 0 1 1 0 1 0 1 1 1 1 1 1 1 1 1 1 0 0 0 1 0 0 0 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0)
+
;; pp:
- 49.287435 #r(0.000000 1.163050 0.277646 1.373554 0.532725 1.655947 0.820565 1.927219 1.072745 0.213781 1.356870 0.485766 1.631061 0.742006 1.904473 1.072791 0.168162 1.327500 0.482508 1.618303 0.771705 1.904773 1.075185 0.215222 1.331659 0.505811 1.654486 0.806874 1.967453 1.148945 0.298519 1.468811 0.620677 1.776228 0.916764 0.084037 1.276979 0.394330 1.564305 0.749970 1.921810 1.121962 0.283495 1.432158 0.569765 1.736470 0.945747 0.080800 1.281360 0.443507 1.625343 0.807138 1.931288 1.158701 0.321739 1.530411 0.700718 1.890240 1.080826 0.244264 1.426463 0.600267 1.774421 0.956059 0.179462 1.370744 0.545050 1.731587 0.953856 0.145408 1.309295 0.511421 1.720420 0.940468 0.138677 1.323833 0.526937 1.717512 0.960485 0.118979 1.328593 0.512297 1.743197 0.943001 0.142257 1.379625 0.549098 1.794241 0.979771 0.180869 1.419130 0.639674 1.850039 1.057471 0.290050 1.461420 0.718417 1.916269 1.159248 0.376289 1.563835 0.838106 0.037452 1.264868 0.508203 1.717190 0.935903 0.151060 1.445292 0.635249 1.867259 1.091222 0.317894 1.534564 0.808426 0.018427 1.266394 0.501751 1.761251 0.969688 0.237229 1.447668 0.716233 1.967410 1.198658 0.437002 1.692103 0.935631 0.200934 1.451676 0.665324 1.935418 1.194689 0.438772 1.699157 0.941183 0.203098 1.450490 0.729357 1.974455 1.213355 0.514075 1.770795 1.016076 0.295868 1.541971 0.834628 0.084952 1.374773 0.619458 1.894143 1.155880 0.407649 1.664716 0.945886 0.261286 1.509195 0.790733 0.047158 1.339941 0.639173 1.891712 1.178155 0.440268 1.738740 1.006239 0.332871 1.560537 0.905839 0.183339 1.475973 0.742124 0.065572 1.351730 0.625747 1.922985 1.191379 0.495991 1.756410 1.042066 0.381601 1.688479 0.992449 0.276849 1.595880 0.892119 0.200958 1.480411 0.818652 0.063966 1.413208 0.715156 0.060494 1.306176 0.640302 1.933579 1.251340 0.581804 1.880299 1.222695 0.508151 1.829141 1.161265 0.457492 1.752607 1.117371 0.435825 1.739733 1.091313 0.385593 1.723501 1.053105 0.375468 1.675086 1.049746 0.382492 1.691106 1.002188 0.342988 1.668975 1.033939 0.350582 1.709840 1.039364 0.383857 1.699746 1.051825 0.373545 1.743567 1.077799 0.434091 1.756970 1.053381 0.443137 1.778145 1.141987 0.502378 1.868431 1.182592 0.530883 1.877105 1.221950 0.588162 -0.002020 1.300304 0.652550 0.036320 1.381929 0.759328 0.108443 1.476502 0.816837 0.213269 1.571344 0.932844 0.309569 1.662539 1.059667 0.419312 1.755499 1.147048 0.543079 1.922420 1.264945 0.657934 0.013132 1.401680 0.801987 0.158358 1.552678 0.920579 0.315474 1.699024 1.059115 0.446156 1.851458 1.209975 0.614230 1.975779 1.374097 0.796121 0.175298 1.591247 0.945333 0.354628 1.747078 1.154595 0.559485 1.967019 1.333396 0.720565 0.122103 1.526595 0.940456 0.327202 1.755683 1.117391 0.561694 1.958381 1.361193 0.803458 0.184110 1.616629 1.006925 0.442089 1.829688 1.261188 0.655027 0.090202 1.509923 0.945564 0.313543 1.753214 1.130948 0.568508 0.031964 1.450068 0.852461 0.283077 1.729985 1.127584 0.580935 -0.001861 1.435678 0.878175 0.293173 1.719785 1.184765 0.606034 0.040632 1.478744 0.942562 0.348499 1.801185 1.227587 0.696736 0.112509 1.564761 0.997649 0.448218 1.895579 1.324465 0.786873 0.273294 1.679282 1.152398 0.603084 0.027394 1.495848 0.964252 0.380193 1.852378 1.306385 0.788058 0.249156 1.687499 1.121997 0.611298 0.090174 1.559009 0.973272 0.464823 1.921940 1.378762 0.867253 0.345833 1.810423 1.301030 0.744928 0.252599 1.735986 1.205901 0.677471 0.145109 1.614381 1.080917 0.586366 0.083099 1.542748 1.001440 0.520731 0.003110 1.438773 0.930269 0.427623 1.972229 1.416238 0.940471 0.422555 1.905093 1.411628 0.878267 0.378282 1.870882 1.386240 0.872844 0.369185 1.888119 1.372843 0.868051 0.364903 1.849288 1.377695 0.870674 0.392638 1.894252 1.393508 0.953494 0.447692 1.964212 1.461256 0.958900 0.491909 0.001252 1.522315 1.032375 0.545182 0.047665 1.604571 1.102550 0.587351 0.146687 1.653910 1.193132 0.725831 0.238418 1.753114 1.296242 0.838033 0.349570 1.877468 1.384694 0.938419 0.481820 0.045217 1.557648 1.099375 0.609911 0.138825 1.670480 1.217161 0.761162 0.340569 1.849982 1.398484 0.929634 0.476983 0.033188 1.587225 1.150229 0.660516 0.218545 1.773455 1.321194 0.875537 0.412455 1.975569 1.556914 1.085507 0.655478 0.222974 1.781550 1.346518 0.898635 0.461489 0.030688 1.577108 1.128616 0.706201 0.284734 1.848941 1.423074 1.012127 0.550319 0.127044 1.684664 1.271718 0.847352 0.414193 1.990134 1.521095 1.136567 0.750291 0.337126 1.862249 1.460431 1.049297 0.669842 0.216907 1.819953 1.412426 0.984992 0.572590 0.137306 1.767447 1.330047 0.905950 0.512494 0.103808 1.706053 1.292143 0.937524 0.519078 0.097820 1.712597 1.292745 0.903437 0.500926 0.107737 1.719337 1.308083 0.905177 0.496968 0.133013 1.759477 1.355972 0.957870 0.560591 0.197890 1.801611 1.398075 1.020267 0.618113 0.240199 1.874548 1.486894 1.113092 0.726528 0.377432 1.957833 1.606621 1.229674 0.862702 0.506555 0.105441 1.735997 1.326469 0.994534 0.620808 0.244606 1.879074 1.511642 1.143326 0.775799 0.401368 0.075791 1.702891 1.377919 1.004500 0.619170 0.276148 1.905577 1.568310 1.206071 0.869241 0.512412 0.122276 1.822305 1.441374 1.069500 0.718082 0.389240 0.063602 1.687756 1.378724 0.999805 0.650714 0.332978 1.980285 1.636670 1.301261 0.946200 0.636798 0.314748 1.971775 1.637355 1.287360 0.964448 0.629994 0.298934 1.960682 1.641690 1.343792 1.003153 0.675512 0.317256 0.019972 1.693194 1.366188 1.021532 0.736417 0.404438 0.047067 1.755472 1.430810 1.127679 0.827156 0.504993 0.204999 1.869602 1.559982 1.266750 0.972466 0.612460 0.337579 0.023582 1.728936 1.434699 1.106015 0.784009 0.538390 0.203285 1.928266 1.597064 1.317846 1.015077 0.718614 0.443946 0.127570 1.807078 1.525053 1.247182 0.954079 0.675954 0.383769 0.077633 1.801620 1.532606 1.255462 0.983867 0.644793 0.353207 0.086592 1.828378 1.554513 1.293246 0.994370 0.712475 0.454107 0.144932 1.895728 1.591466 1.368095 1.085410 0.814684 0.542596 0.266934 0.005277 1.745816 1.477185 1.204917 0.948437 0.678999 0.410227 0.182102 1.882179 1.612229 1.401104 1.147230 0.888055 0.606492 0.343709 0.087358 1.853764 1.632545 1.312124 1.126022 0.888426 0.609422 0.346571 0.088432 1.864069 1.624618 1.413636 1.129791 0.907899 0.664305 0.453125 0.192741 1.939732 1.724665 1.446730 1.208735 1.009088 0.791036 0.553547 0.269865 0.050008 1.869993 1.607891 1.398702 1.178112 0.955620 0.721846 0.505763 0.260159 0.071405 1.830854 1.568352 1.366891 1.174316 0.942949 0.745228 0.526140 0.332456 0.118352 1.885916 1.701433 1.472261 1.239299 1.044248 0.831700 0.625882 0.454237 0.215857 0.017252 1.819254 1.615407 1.449492 1.196228 0.982253 0.820818 0.604584 0.442977 0.216483 0.024304 1.829511 1.646493 1.443177 1.275320 1.091080 0.881819 0.729119 0.498708 0.327643 0.166437 1.958363 1.799653 1.588527 1.414994 1.260561 1.019025 0.883661 0.702271 0.505868 0.333038 0.161804 1.992906 1.833629 1.635304 1.475105 1.312466 1.145459 0.986121 0.827858 0.611131 0.477466 0.312332 0.162403 1.993033 1.816815 1.647505 1.499793 1.348955 1.165690 1.035882 0.893667 0.723295 0.585232 0.422874 0.271934 0.113531 1.952972 1.802172 1.650708 1.483461 1.343486 1.218552 1.084842 0.927073 0.776245 0.635502 0.458305 0.373982 0.258566 0.082490 1.916515 1.785127 1.662029 1.542014 1.401296 1.288328 1.126154 1.007559 0.889400 0.744625 0.632843 0.508419 0.378037 0.200669 0.085018 0.008202 1.848031 1.734169 1.614621 1.493930 1.370837 1.302166 1.164868 1.024290 0.930883 0.834625 0.701624 0.606512 0.466962 0.388720 0.279406 0.140918 0.032687 1.927348 1.811775 1.710266 1.620460 1.492805 1.381998 1.317908 1.197423 1.122147 0.998133 0.894736 0.822100 0.734668 0.601331 0.525309 0.427892 0.326892 0.282159 0.156951 0.069505 1.983007 1.895744 1.832368 1.741307 1.671465 1.579508 1.479397 1.407456 1.341307 1.292493 1.172022 1.054844 1.025425 0.938514 0.866058 0.788578 0.719667 0.627909 0.568933 0.499665 0.417215 0.362650 0.295768 0.225056 0.146637 0.113130 0.045846 1.971304 1.915101 1.840250 1.815002 1.742119 1.655607 1.609235 1.549662 1.484722 1.419617 1.408714 1.318908 1.280672 1.236078 1.178979 1.119651 1.066519 1.044417 1.008080 0.950081 0.924323 0.862134 0.835117 0.809024 0.773528 0.699906 0.685111 0.616527 0.592797 0.532897 0.500140 0.456585 0.437938 0.409107 0.390095 0.358332 0.312446 0.308676 0.240543 0.209907 0.216831 0.210411 0.161769 0.125653 0.125949 0.116670 0.080163 0.075626 0.045297 0.004806 -0.000881 0.026299 1.965793 1.933605 1.942786 1.944348 1.952614 1.952589 1.927103 1.902751 1.909232 1.908039 1.900517 1.879669 1.891581 1.879298 1.891872 1.877416 1.870643 1.886309 1.944953 1.916353 1.939154 1.880988 1.904419 1.908941 1.910254 1.932089 1.969282 1.952058 1.945000 1.980171 0.011419 0.039090 0.041500 0.047816 0.085029 0.081559 0.110170 0.137541 0.124670 0.182784 0.191545 0.201628 0.268114 0.278620 0.284381 0.311542 0.326223 0.361901 0.375616 0.463339 0.474532 0.486778 0.532068 0.571238 0.610468 0.633708 0.681958 0.718256 0.773051 0.824140 0.873293 0.876610 0.910965 0.966901 1.003523 1.070562 1.122780 1.175620 1.208791 1.265780 1.302068 1.370182 1.451044 1.483311 1.520585 1.580432 1.644102 1.730843 1.770789 1.797830 1.879017 1.937891 0.019856 0.060042 0.124553 0.170564 0.216811 0.336571 0.366439 0.419283 0.547803 0.615076 0.686756 0.743054 0.808192 0.868812 0.967965 1.030425 1.105495 1.195851 1.276820 1.343432 1.439087 1.529664 1.600300 1.698173 1.760479 1.837558 1.924128 0.038094 0.120241 0.214007 0.317951 0.407855 0.504676 0.570855 0.654240 0.764928 0.855805 0.954502 1.051709 1.155105 1.262197 1.344793 1.435407 1.543123 1.670772 1.770468 1.865799 1.988288 0.099499 0.209570 0.297997 0.416558 0.512994 0.646099 0.763826 0.829292 0.972586 1.100975 1.192463 1.318284 1.435661 1.552010 1.667446 1.796953 1.895828 0.041405 0.168834 0.302036 0.399196 0.525607 0.643567 0.817912 0.935908 1.049011 1.178889 1.349363 1.470533 1.565826 1.734269 1.896736 0.005501 0.133187 0.267100 0.426661 0.580310 0.701157 0.855104 0.989792 1.134964 1.281741 1.433081 1.557022 1.743754 1.844434 0.034007 0.156833 0.323091 0.480395 0.650146 0.794963 0.940476 1.107393 1.252731 1.423226 1.591762 1.737804 1.887833 0.066146 0.199816 0.395900 0.573298 0.691305 0.879701 1.072741 1.236826 1.402627 1.563880 1.718916 1.915062 0.045140 0.237581 0.438738 0.580798 0.784617 0.966030 1.127512 1.284041 1.500016 1.652029 1.856424 0.063337 0.220388 0.388642 0.607545 0.805909 0.974538 1.152853 1.362173 1.532955 1.747946 1.927504 0.137055 0.324156 0.511474 0.727234 0.929245 1.096943 1.311277 1.529510 1.717204 1.929354 0.136096 0.316537 0.493748 0.725549 0.936978 1.151687 1.364715 1.550641 1.788754 1.967369 0.214151 0.411319 0.596806 0.843522 1.075423 1.273303 1.508848 1.709102 1.926626 0.164669 0.367063 0.581444 0.843645 1.064477 1.297447 1.488808 1.750805 1.965800 0.201438 0.416395 0.646546 0.890452 1.084015 1.348861 1.594443 1.818075 0.050802 0.296115 0.523258 0.792692 1.017642 1.273538 1.482331 1.728422 1.963843 0.219496 0.485923 0.690905 0.954474 1.220165 1.432291 1.730053 1.984033 0.222784 0.506499 0.721622 1.020753 1.264124 1.484071 1.737442 0.008877 0.293763 0.536176 0.800572 1.062039 1.344801 1.603165 1.888281 0.130074 0.414558 0.656092 0.938783 1.204182 1.472600 1.715585 0.025355 0.292603 0.583538 0.845516 1.127921 1.372150 1.695546 1.966468 0.221543 0.530377 0.793558 1.098411 1.356632 1.654543 1.955535 0.215710 0.523709 0.795967 1.100511 1.400246 1.690427 1.972022 0.266207 0.566998 0.873330 1.145759 1.473687 1.732502 0.041309 0.361298 0.681781 0.985976 1.233662 1.568222 1.842062 0.150190 0.511624 0.781348 1.087933 1.430677 1.711532 0.035866 0.350229 0.682226 0.921244 1.280371 1.577240 1.931037 0.233182 0.556380 0.877749 1.201053 1.529754 1.819573 0.176157 0.513656 0.816790 1.153452 1.451900 1.807514 0.113756 0.472986 0.806765 1.112493 1.445282 1.798965 0.093781 0.440000 0.772831 1.149981 1.498818 1.820883 0.161426 0.511652 0.813634 1.170367 1.539558 1.880179 0.197605 0.545597 0.908196 1.248869 1.624027 1.993151 0.291418 0.679658 1.035077 1.372909 1.711740 0.072351 0.454139 0.769060 1.133182 1.524037 1.903171 0.230092 0.617044 0.952001 1.338296 1.713107 0.075994 0.443935 0.779891 1.161968 1.532485 1.934216 0.232916 0.643695 1.033693 1.388978 1.763418 0.158282 0.531564 0.923030 1.280607 1.680049 0.033058 0.432091 0.830342 1.225022 1.574525 1.980673 0.372020 0.765894 1.154297 1.543700 1.929241 0.336874 0.704501 1.078420 1.502864 1.874394 0.278411 0.673779 1.082558 1.485362 1.892655 0.272103 0.679143 1.126508 1.483018 1.858194 0.311886 0.706336 1.119689 1.515117 1.930234 0.352607 0.728958 1.180615 1.582674 -0.011458 0.382422 0.817149 1.225669 1.663555 0.072122 0.522136 0.931979 1.334156 1.759365 0.194206 0.619361 1.047129 1.473102 1.908252 0.351516 0.772083 1.179926 1.644483 0.044574 0.475749 0.917446 1.334503 1.758597 0.228962 0.656066 1.131261 1.531736 1.952420 0.415411 0.858312 1.294649 1.758848 0.189426 0.612886 1.083380 1.497505 1.985693 0.443336 0.886511 1.331150 1.813863 0.233070 0.676790 1.130099 1.603581 0.055302 0.540261 0.998997 1.449019 1.920455 0.358725 0.844856 1.264985 1.778111 0.235398 0.686816 1.158649 1.610447 0.090461 0.550418 1.066038 1.507364 1.994625 0.420151 0.944881 1.409278 1.887639 0.359391 0.848416 1.314772 1.770668 0.248792 0.760921 1.244402 1.756852 0.252652 0.703484 1.163404 1.654408 0.164679 0.655036 1.142941 1.625021 0.133904 0.622543 1.126263 1.630291 0.123546 0.625620 1.093073 1.619368 0.102469 0.606535 1.087101 1.587765 0.099897 0.628994 1.136702 1.620371 0.161959 0.636159 1.142893 1.681191 0.151857 0.677434 1.211596 1.703772 0.227926 0.771686 1.266146 1.802804 0.317100 0.816843 1.330334 1.861595 0.386103 0.907612 1.408022 1.955543 0.472098 0.989797 1.544380 0.060134 0.607569 1.120958 1.622179 0.202636 0.754702 1.259644 1.800413 0.355305 0.852467 1.427250 1.936931 0.476054 1.030783 1.560498 0.106947 0.646657 1.237864 1.760957 0.297533 0.839061 1.392090 1.981467 0.509204 1.041723 1.622010 0.107363 0.685230 1.282738 1.821548 0.392932 0.943170 1.514801 0.035058 0.608491 1.175191 1.746330 0.299139 0.879938 1.445070 -0.001787 0.554868 1.132782 1.683410 0.273212 0.846311 1.408423 0.003830 0.577097 1.115510 1.694824 0.296676 0.868917 1.443750 0.022513 0.593863 1.183583 1.773899 0.348573 0.938190 1.535508 0.069825 0.715089 1.266797 1.883415 0.452363 1.042844 1.630007 0.194710 0.822770 1.421686 0.006472 0.621176 1.225177 1.804178 0.408934 1.002193 1.614950 0.209691 0.797600 1.413215 0.043022 0.605270 1.230426 1.842139 0.430016 1.071181 1.656314 0.292321 0.899593 1.524578 0.123367 0.722937 1.338216 1.965637 0.591781 1.216201 1.814694 0.429343 1.061910 1.690552 0.337918 0.935448 1.583594 0.173086 0.798338 1.428447 0.077432 0.684896 1.325474 1.963397 0.593516 1.253180 1.853700 0.531347 1.151683 1.746520 0.425377 1.027823 1.699093 0.333177 0.972850 1.609902 0.254362 0.906653 1.526954 0.225847 0.835769 1.466855 0.149601 0.794755 1.472543 0.118131 0.734656 1.404030 0.060242 0.727045 1.340500 0.029564 0.718625 1.343988 -0.004346 0.685714 1.342591 1.966238 0.667503 1.349852 -0.002971 0.703210 1.357155 0.009465 0.670856 1.356398 0.013330 0.698167 1.342918 0.045357 0.716155 1.383634 0.066321 0.749850 1.425646 0.130825 0.789828 1.468799 0.124200 0.833100 1.513466 0.184968 0.911501 1.594174 0.253162 0.976866 1.658160 0.318972 1.008058 1.691692 0.429447 1.114864 1.830218 0.507740 1.192600 1.907363 0.627089 1.308050 -0.023869 0.692513 1.415262 0.119283 0.836039 1.521751 0.244980 0.952758 1.642834 0.365258 1.090581 1.783116 0.502517 1.253315 1.907048 0.640444 1.381762 0.084253 0.818390 1.500682 0.258511 0.959052 1.666093 0.436675 1.168622 1.860895 0.574076 1.283511 0.009657 0.798719 1.538205 0.214051 0.952450 1.698753 0.447784 1.186388 1.858247 0.626974 1.347987 0.102119 0.855522 1.567443 0.343708 1.048347 1.808415 0.563378 1.317260 0.037027 0.798248 1.543255 0.284540 1.038822 1.782415 0.536310 1.274786 0.033989 0.801778 1.518276 0.287239 1.093224 1.832048 0.574059 1.361341 0.088951 0.857131 1.626231 0.399419 1.160410 1.908691 0.691937 1.400996 0.198198 1.010876 1.783108 0.552378 1.321187 0.069810 0.822885 1.649640 0.398546 1.161881 1.992740 0.718709 1.494106 0.274327 1.069239 1.874949 0.654740 1.412139 0.213263 1.030112 1.748596 0.568168 1.374868 0.155842 0.909714 1.739498 0.532008 1.295260 0.100142 0.892104 1.684374 0.494276 1.299126 0.082168 0.868839 1.674733 0.523178 1.308308 0.060301 0.901403 1.723633 0.527144 1.315281 0.095071 0.928769 1.769688 0.546110 1.365559 0.165197 0.991664 1.800022 0.649448 1.439023 0.280113 1.099551 1.892902 0.728472 1.558461 0.355122 1.155267 0.036651 0.803555 1.642245 0.486101 1.329471 0.153373 0.982109 1.814973 0.657477 1.472081 0.306013 1.138804 1.982639 0.806632 1.637032 0.492622 1.340692 0.166678 0.988021 1.860739 0.705110 1.541783 0.378007 1.213916 0.031456 0.923334 1.732364 0.624150 1.479737 0.314949 1.150499 0.017070 0.859860 1.709562 0.576208 1.451144 0.288172 1.156845 0.018462 0.888828 1.738856 0.600882 1.451392 0.305358 1.162471 0.071454 0.893471 1.790525 0.655173 1.527197 0.387534 1.299810 0.149548 1.016876 1.901076 0.773925 1.669962 0.533885 1.422131 0.264889 1.162826 0.053904 0.925273 1.783822 0.699297 1.593338 0.446127 1.329094 0.254005 1.148241 0.039106 0.936392 1.775754 0.686922 1.585294 0.459409 1.358560 0.246673 1.169932 0.062721 0.983726 1.860184 0.765327 1.652246 0.576169 1.499099 0.384989 1.260554 0.200648 1.126723 -0.014215 0.905397 1.801886 0.753345 1.641865 0.558767 1.467752 0.368838 1.294027 0.198410 1.090981 0.052952 0.991699 1.874409 0.806543 1.749760 0.655559 1.568484 0.520862 1.412201 0.366118 1.291778 0.238178 1.186893 0.061166 0.989290 1.973099 0.910404 1.832384 0.729437 1.723776 0.611997 1.559408 0.503451 1.415081 0.384261 1.301727 0.266130 1.222404 0.110539 1.064083 0.035684 0.943491 1.931964 0.862767 1.795698 0.762421 1.744397 0.666272 1.629091 0.597084 1.552001 0.500765 1.485981 0.446479 1.384691 0.357775 1.317093 0.302197 1.238922 0.194762 1.180556 0.151639 1.104156 0.074275 1.063876 0.008701 0.973523 1.931938 0.929619 1.899785 0.841696 1.876181 0.845013 1.791292 0.775116 1.753572 0.692830 1.726733 0.701663 1.665288 0.631802 1.649201 0.617241 1.594365 0.594942 1.588591 0.590950 1.543461 0.545092 1.544258 0.510400 1.542625 0.487864 1.489414 0.513606 1.491923 0.493471 1.497027 0.496715 1.533646 0.485406 1.488094 0.496820 1.543844 0.524720 1.515833 0.565220 1.558524 0.600489 1.612307 0.598486 1.630142 0.583528 1.626331 0.601297 1.642574 0.701670 1.674391 0.711291 1.729818 0.761143 1.763746 0.824000 1.826874 0.860664 1.866172 0.942874 1.940443 0.980274 -0.790948 1.041163 0.048939 1.113624 0.095128 1.190982 0.189672 1.265115 0.274570 1.325492 0.374151 1.447798)
+ 48.938317 #(0.000000 1.167623 0.282225 1.376653 0.534514 1.660914 0.823370 1.930658 1.070085 0.214625 1.354025 0.484578 1.623954 0.740719 1.908933 1.074867 0.168238 1.320193 0.479927 1.615001 0.773055 1.914067 1.071083 0.213385 1.332812 0.510800 1.651702 0.813446 1.965854 1.141096 0.307117 1.475035 0.625028 1.771862 0.912651 0.086444 1.282411 0.390695 1.560441 0.750832 1.917327 1.118233 0.287542 1.425738 0.578911 1.736440 0.952043 0.084501 1.279879 0.441668 1.623933 0.806211 1.933432 1.157213 0.320181 1.527410 0.698033 1.881574 1.079658 0.244634 1.424867 0.602355 1.780375 0.962173 0.182065 1.368337 0.548745 1.734105 0.951438 0.146458 1.305815 0.508320 1.722615 0.945078 0.140412 1.321110 0.529516 1.717275 0.959303 0.120549 1.322802 0.515478 1.744705 0.944865 0.143706 1.374903 0.546142 1.797945 0.983189 0.180160 1.427362 0.644156 1.851906 1.061747 0.288472 1.462756 0.716178 1.906213 1.158696 0.374832 1.568725 0.827160 0.037611 1.267047 0.502288 1.711331 0.936855 0.156378 1.444240 0.631552 1.865843 1.086534 0.315308 1.535315 0.811499 0.017383 1.269380 0.496907 1.762897 0.964919 0.240278 1.452545 0.716923 1.972925 1.199211 0.441548 1.691781 0.935087 0.201054 1.453632 0.668128 1.935787 1.194845 0.447342 1.705599 0.937891 0.212609 1.452424 0.727408 1.974678 1.215973 0.516063 1.765606 1.017849 0.296296 1.538306 0.833245 0.085288 1.371617 0.616223 1.896734 1.154892 0.404688 1.662495 0.942344 0.262430 1.502037 0.786497 0.044602 1.342306 0.642533 1.888323 1.178587 0.443662 1.733278 1.015176 0.334662 1.571936 0.910767 0.183051 1.474511 0.745803 0.060238 1.350418 0.635046 1.920092 1.189534 0.499792 1.753110 1.035493 0.378396 1.682413 0.992174 0.270253 1.591558 0.889613 0.198678 1.477059 0.813940 0.071877 1.409494 0.709255 0.052773 1.306019 0.644886 1.927568 1.246923 0.583469 1.880367 1.223587 0.503415 1.831220 1.170859 0.460883 1.758714 1.111217 0.439105 1.737433 1.089008 0.382728 1.725135 1.059849 0.371606 1.674013 1.061339 0.389549 1.684839 1.001814 0.345519 1.667016 1.034958 0.352234 1.709324 1.032943 0.387985 1.699924 1.047648 0.383156 1.742441 1.085359 0.435289 1.748636 1.049142 0.438617 1.779398 1.147519 0.504498 1.863372 1.183919 0.541649 1.879488 1.226400 0.585925 -0.002341 1.297877 0.653704 0.036723 1.384237 0.760937 0.109741 1.479508 0.827606 0.209062 1.570729 0.935399 0.309542 1.662907 1.056347 0.423451 1.752453 1.153722 0.542171 1.913747 1.265658 0.651890 0.014128 1.405051 0.800727 0.153722 1.557204 0.925355 0.320210 1.703454 1.059741 0.453405 1.846781 1.214019 0.616997 1.979336 1.373413 0.796228 0.173191 1.590046 0.942072 0.354468 1.752409 1.148401 0.562688 1.963192 1.336209 0.726036 0.125851 1.526454 0.940065 0.329273 1.754630 1.116898 0.557398 1.954010 1.359099 0.797818 0.188823 1.612597 1.007437 0.442434 1.837576 1.257874 0.651980 0.094580 1.509460 0.943247 0.312161 1.746667 1.129515 0.573848 0.028415 1.452578 0.856570 0.285853 1.727867 1.134745 0.582983 -0.002878 1.433995 0.873528 0.297786 1.719335 1.185550 0.610743 0.039818 1.476173 0.944896 0.350844 1.806899 1.222763 0.694622 0.116127 1.565651 0.996106 0.448360 1.901658 1.322457 0.782944 0.262548 1.683986 1.151424 0.600666 0.022174 1.493951 0.958455 0.377457 1.849933 1.307090 0.784160 0.254453 1.691107 1.123965 0.612527 0.081748 1.561305 0.977198 0.464963 1.925710 1.391234 0.861063 0.344579 1.797148 1.300206 0.740379 0.250849 1.743807 1.209677 0.681988 0.144283 1.606981 1.083582 0.578120 0.086244 1.539491 1.003053 0.519618 0.001729 1.438716 0.932987 0.424940 1.973315 1.413069 0.936268 0.425359 1.905181 1.406004 0.876827 0.377573 1.872372 1.386358 0.871448 0.364168 1.890777 1.374215 0.871078 0.364342 1.843180 1.377816 0.878190 0.386930 1.890768 1.393332 0.954097 0.447136 1.969403 1.463510 0.955467 0.491952 -0.004058 1.524437 1.033931 0.542484 0.046054 1.605007 1.108774 0.596223 0.142256 1.656697 1.195275 0.729522 0.241250 1.752421 1.289611 0.831660 0.343814 1.879262 1.393827 0.937184 0.486404 0.041735 1.558985 1.103891 0.606105 0.145024 1.664568 1.221279 0.766126 0.339495 1.850694 1.402930 0.928499 0.479037 0.028538 1.590890 1.147969 0.657376 0.219279 1.773094 1.310932 0.885540 0.420311 1.979382 1.556686 1.089023 0.650216 0.223710 1.784581 1.347944 0.903039 0.453728 0.029501 1.574077 1.130407 0.710038 0.279504 1.852736 1.424979 1.008706 0.551046 0.127293 1.682427 1.266223 0.845129 0.412469 1.992550 1.526570 1.138074 0.747185 0.336825 1.866466 1.457134 1.054015 0.666940 0.218423 1.817619 1.408012 0.984947 0.573493 0.136780 1.764033 1.329735 0.903286 0.509631 0.107272 1.714355 1.292605 0.935879 0.517706 0.105151 1.705931 1.288681 0.891823 0.507883 0.110817 1.717029 1.307361 0.904579 0.496974 0.139902 1.761911 1.350929 0.950950 0.557034 0.198762 1.804025 1.393649 1.026133 0.620012 0.239038 1.876464 1.486449 1.114141 0.732191 0.374203 1.962259 1.603528 1.228975 0.868028 0.508538 0.103928 1.729825 1.324975 0.987483 0.621810 0.251583 1.883172 1.509410 1.148295 0.771729 0.404091 0.069839 1.702352 1.383234 0.997793 0.615769 0.268818 1.899984 1.566440 1.202921 0.867621 0.513258 0.128821 1.824657 1.438112 1.066258 0.722202 0.390635 0.058767 1.695791 1.374438 0.999297 0.642595 0.332568 1.977415 1.631814 1.297492 0.945148 0.637140 0.311549 1.965770 1.636985 1.287744 0.972721 0.631523 0.295406 1.966037 1.641873 1.351870 1.017314 0.676276 0.314147 0.021143 1.689586 1.360720 1.027179 0.737342 0.407695 0.054624 1.752288 1.432264 1.119029 0.832726 0.502472 0.195940 1.873462 1.563227 1.261455 0.974464 0.615136 0.341537 0.026287 1.736090 1.430730 1.110562 0.789300 0.536362 0.209096 1.932086 1.606344 1.323516 1.013787 0.721162 0.439597 0.131979 1.799092 1.525417 1.253260 0.957483 0.671751 0.382251 0.074846 1.802859 1.530230 1.256037 0.982272 0.648065 0.351070 0.085445 1.832790 1.553531 1.297659 0.993303 0.713003 0.454087 0.148617 1.889745 1.592397 1.364633 1.080885 0.818640 0.548036 0.272772 0.006871 1.745355 1.482322 1.202059 0.953328 0.684027 0.406687 0.185160 1.888652 1.616222 1.397199 1.149929 0.888703 0.606901 0.344603 0.086202 1.856052 1.635016 1.316703 1.123003 0.890076 0.610977 0.347871 0.094414 1.867293 1.625224 1.413640 1.132950 0.910376 0.663960 0.452258 0.190891 1.936498 1.718671 1.455517 1.214384 1.012824 0.790236 0.555158 0.275886 0.058174 1.869275 1.605596 1.398303 1.174781 0.950928 0.728650 0.505977 0.266181 0.067894 1.828757 1.566238 1.364389 1.169789 0.947453 0.745519 0.528723 0.331921 0.121393 1.878086 1.704273 1.467279 1.240981 1.043375 0.830667 0.631469 0.454114 0.222905 0.014720 1.816471 1.613927 1.445713 1.189306 0.975978 0.811345 0.602053 0.448606 0.215481 0.021259 1.827124 1.651851 1.445676 1.279705 1.090959 0.884552 0.724977 0.500360 0.328434 0.156290 1.958056 1.796294 1.580393 1.416534 1.260974 1.019490 0.878567 0.705207 0.503616 0.327719 0.159927 1.996425 1.832160 1.638336 1.479521 1.311900 1.145735 0.980475 0.826806 0.610003 0.478791 0.312526 0.165023 1.984468 1.815612 1.656258 1.498320 1.349677 1.167934 1.030468 0.890901 0.725442 0.582932 0.420274 0.269701 0.118831 1.955007 1.798624 1.655853 1.483782 1.346361 1.210747 1.082290 0.925459 0.775544 0.640536 0.472447 0.376695 0.254186 0.079449 1.917818 1.774777 1.664878 1.536332 1.397556 1.290519 1.129067 1.005837 0.894161 0.746188 0.630943 0.508914 0.385674 0.204280 0.086107 0.002473 1.847697 1.732598 1.617395 1.491848 1.372600 1.303780 1.164852 1.024005 0.934055 0.830835 0.706993 0.609704 0.468381 0.386299 0.275606 0.141501 0.038979 1.929917 1.809789 1.715874 1.613514 1.498658 1.383214 1.320391 1.190878 1.117115 1.003206 0.888877 0.823091 0.734960 0.603626 0.525682 0.421969 0.322800 0.281984 0.161925 0.071698 1.981031 1.896931 1.831077 1.746001 1.668142 1.580757 1.476346 1.409429 1.335213 1.287612 1.169626 1.050243 1.022504 0.947889 0.868700 0.788735 0.721532 0.628758 0.574378 0.496899 0.417938 0.365706 0.291260 0.222974 0.147521 0.105182 0.050073 1.971542 1.912537 1.842501 1.811968 1.751631 1.651987 1.606277 1.549138 1.482209 1.419531 1.406537 1.323625 1.279718 1.235676 1.177530 1.125044 1.063358 1.047038 1.016187 0.947495 0.919568 0.858526 0.836537 0.810871 0.772817 0.701352 0.681799 0.613373 0.593594 0.539761 0.507429 0.464819 0.441648 0.411344 0.392107 0.348205 0.301369 0.308706 0.247053 0.208241 0.216046 0.206810 0.167490 0.124675 0.124039 0.121146 0.072040 0.075269 0.040405 -0.002353 0.004670 0.036079 1.964376 1.932923 1.944708 1.940814 1.952244 1.949226 1.929245 1.904671 1.913271 1.908479 1.911726 1.882223 1.893258 1.882787 1.892935 1.873025 1.875107 1.887426 1.935042 1.916857 1.941491 1.887800 1.897065 1.912466 1.909295 1.937992 1.966419 1.951366 1.950669 1.993395 0.012517 0.036712 0.036965 0.042470 0.083491 0.082907 0.108158 0.139463 0.119555 0.184657 0.184922 0.203318 0.267665 0.279628 0.285520 0.309145 0.322645 0.367831 0.371353 0.465521 0.470013 0.494174 0.530794 0.568241 0.616563 0.631549 0.678124 0.716441 0.769066 0.825612 0.869296 0.876676 0.914402 0.967433 1.005183 1.072376 1.120849 1.180362 1.209450 1.267538 1.299781 1.365468 1.454232 1.483217 1.519755 1.581123 1.644706 1.738657 1.776548 1.793230 1.875424 1.935983 0.012946 0.059774 0.127031 0.172376 0.212347 0.333625 0.366687 0.420625 0.546582 0.614331 0.685424 0.747709 0.794251 0.864955 0.962854 1.032653 1.104403 1.197927 1.277471 1.338392 1.443199 1.531379 1.604788 1.703851 1.762495 1.831178 1.920740 0.039507 0.123314 0.208825 0.315311 0.411979 0.508148 0.563574 0.656825 0.763286 0.863562 0.947763 1.052165 1.155863 1.263029 1.337045 1.430892 1.540954 1.671180 1.773746 1.867849 1.986007 0.103863 0.202277 0.304660 0.423647 0.523758 0.650840 0.761975 0.823189 0.974608 1.092718 1.191480 1.309541 1.433617 1.552700 1.668978 1.797089 1.891002 0.049514 0.161227 0.299906 0.396662 0.527285 0.643574 0.811342 0.934969 1.050156 1.187185 1.347338 1.462897 1.571305 1.740041 1.902380 0.003401 0.133208 0.269746 0.430182 0.588759 0.701058 0.863524 0.994706 1.136737 1.282942 1.430377 1.561454 1.742625 1.840309 0.038452 0.155061 0.324821 0.481975 0.646501 0.800620 0.943515 1.096121 1.247372 1.424286 1.584778 1.738499 1.889598 0.065703 0.197229 0.397534 0.566731 0.698938 0.883393 1.070795 1.234091 1.400289 1.565708 1.722501 1.919697 0.053412 0.241535 0.441143 0.590215 0.791618 0.966021 1.128031 1.276025 1.493498 1.656119 1.858910 0.065064 0.224170 0.391259 0.606178 0.803453 0.981656 1.158314 1.358685 1.544905 1.753753 1.932471 0.135869 0.328397 0.512767 0.719508 0.934490 1.093810 1.309285 1.532285 1.717750 1.927518 0.136321 0.313720 0.493762 0.718014 0.935538 1.150810 1.361689 1.556333 1.805243 1.974613 0.212285 0.411200 0.608244 0.842629 1.080653 1.273837 1.513842 1.716967 1.919951 0.164727 0.369694 0.579059 0.834151 1.067429 1.290591 1.495590 1.752409 1.961446 0.199000 0.429249 0.641148 0.896549 1.076714 1.353344 1.600990 1.809338 0.053661 0.299737 0.526322 0.794150 1.006087 1.266438 1.491558 1.728697 1.958490 0.219390 0.475781 0.691916 0.957520 1.225096 1.434106 1.726570 1.984341 0.220911 0.508654 0.726991 1.015072 1.259741 1.479979 1.734937 0.012313 0.297991 0.538731 0.794441 1.056267 1.345863 1.599562 1.889794 0.126193 0.416233 0.651655 0.933378 1.203962 1.466564 1.714436 0.030806 0.296108 0.580970 0.845591 1.124438 1.373843 1.690180 1.962652 0.225080 0.525949 0.795485 1.095396 1.360062 1.659714 1.961515 0.221441 0.528774 0.799887 1.100605 1.410002 1.689804 1.975411 0.267050 0.564358 0.875434 1.150454 1.480310 1.738755 0.043111 0.355160 0.678632 0.992821 1.240765 1.568415 1.839416 0.148815 0.513192 0.781574 1.085726 1.426402 1.717157 0.032674 0.344382 0.688214 0.913564 1.287903 1.583865 1.937260 0.232622 0.557820 0.879525 1.197226 1.534402 1.820283 0.171769 0.516153 0.808571 1.156522 1.451167 1.811697 0.111240 0.471117 0.805734 1.119618 1.440829 1.799243 0.093303 0.445335 0.780582 1.149832 1.493098 1.825364 0.164126 0.507025 0.816842 1.179593 1.539966 1.884561 0.198164 0.546892 0.904927 1.254393 1.624814 1.991933 0.293976 0.683340 1.032795 1.372436 1.715921 0.077794 0.455233 0.768797 1.134394 1.524496 1.898628 0.235584 0.611051 0.953063 1.340580 1.709830 0.080046 0.445846 0.782676 1.160591 1.533251 1.928534 0.236430 0.645942 1.033695 1.399244 1.761751 0.154964 0.534627 0.919594 1.282679 1.679311 0.030459 0.432716 0.826532 1.223539 1.585872 1.974777 0.373302 0.759619 1.160928 1.535107 1.926064 0.339964 0.713931 1.071966 1.504966 1.869793 0.274817 0.674052 1.080235 1.489185 1.892780 0.272788 0.670783 1.122425 1.483792 1.859541 0.311146 0.703607 1.125549 1.525228 1.928047 0.347093 0.729971 1.182002 1.578967 -0.005714 0.386648 0.822291 1.222735 1.665478 0.071062 0.521136 0.930234 1.332735 1.762099 0.197489 0.625607 1.052479 1.471447 1.906706 0.348659 0.766031 1.176693 1.640088 0.043971 0.478062 0.912755 1.336121 1.751350 0.228876 0.653057 1.129680 1.536266 1.957139 0.418211 0.862125 1.290430 1.768200 0.196690 0.613992 1.087517 1.499720 1.982797 0.444314 0.888437 1.331645 1.807370 0.225781 0.674815 1.136944 1.606790 0.051270 0.541044 1.001759 1.450483 1.925298 0.356160 0.843723 1.269319 1.773942 0.233322 0.683060 1.157308 1.614654 0.094612 0.560761 1.070873 1.508945 1.986529 0.416500 0.942592 1.406503 1.892666 0.362935 0.845478 1.312623 1.770496 0.247787 0.765832 1.246989 1.755885 0.245939 0.701066 1.167684 1.664935 0.167415 0.657756 1.140314 1.626875 0.129867 0.617545 1.131190 1.624736 0.126106 0.628066 1.095762 1.617755 0.089423 0.608911 1.087088 1.588845 0.106158 0.624975 1.138828 1.613364 0.160774 0.632289 1.147065 1.679120 0.152653 0.680295 1.205463 1.710279 0.226179 0.774654 1.261738 1.807640 0.313714 0.816201 1.333630 1.871147 0.387214 0.905133 1.401829 1.955808 0.473646 0.992109 1.548253 0.059400 0.608078 1.124267 1.624811 0.201108 0.743302 1.259208 1.790376 0.357269 0.851455 1.422882 1.936483 0.477692 1.034341 1.565645 0.106084 0.647034 1.238785 1.764056 0.297256 0.838013 1.394120 1.982813 0.504733 1.042839 1.615830 0.100689 0.684665 1.279630 1.822002 0.392042 0.940388 1.506908 0.036261 0.610190 1.171883 1.742713 0.301631 0.876367 1.446412 0.001751 0.551964 1.138759 1.686983 0.272057 0.850943 1.413876 0.001724 0.566403 1.113663 1.695126 0.295704 0.866462 1.450351 0.016525 0.596350 1.184768 1.774866 0.348423 0.942641 1.536421 0.069367 0.718987 1.260917 1.879985 0.457612 1.049059 1.630272 0.190579 0.824169 1.421383 0.003499 0.628240 1.229247 1.814920 0.405304 1.002074 1.617514 0.207136 0.804322 1.412356 0.046450 0.600317 1.227922 1.838320 0.431906 1.067997 1.665193 0.289811 0.889565 1.525340 0.119730 0.728561 1.343542 1.964071 0.587637 1.221819 1.814110 0.431015 1.064317 1.692284 0.335827 0.935555 1.580359 0.172941 0.805197 1.436494 0.076694 0.683166 1.332642 1.966559 0.600574 1.243217 1.855223 0.534880 1.157772 1.747645 0.425946 1.025573 1.697032 0.333162 0.976777 1.614413 0.259746 0.909452 1.528093 0.226885 0.833132 1.466837 0.151792 0.785636 1.473224 0.117004 0.728339 1.406741 0.057575 0.720062 1.339187 0.029895 0.719736 1.350651 0.000253 0.687920 1.347471 1.965061 0.664230 1.349830 0.003758 0.699164 1.345594 0.011716 0.666846 1.355702 0.019946 0.693519 1.342984 0.043467 0.725688 1.389619 0.066726 0.745910 1.427250 0.128665 0.788280 1.462009 0.122214 0.829137 1.518784 0.184664 0.903670 1.590666 0.253248 0.980436 1.654381 0.317580 0.998899 1.687423 0.433376 1.114830 1.827306 0.508627 1.196682 1.910609 0.625810 1.308433 -0.019202 0.692262 1.413671 0.118496 0.833227 1.519419 0.245662 0.954860 1.647614 0.361453 1.091746 1.784704 0.505859 1.256540 1.903369 0.635907 1.378219 0.083231 0.819168 1.496839 0.255361 0.955468 1.669837 0.433478 1.171485 1.853782 0.570212 1.278434 0.011381 0.792468 1.535764 0.210622 0.946243 1.703647 0.444833 1.189701 1.849416 0.625735 1.339071 0.100417 0.849313 1.564343 0.339974 1.044679 1.808439 0.568480 1.314109 0.032832 0.800539 1.542426 0.274036 1.032943 1.777407 0.542714 1.270582 0.030395 0.794798 1.517805 0.283975 1.092332 1.834470 0.571772 1.363389 0.085108 0.860419 1.625081 0.397675 1.157494 1.908790 0.687876 1.400992 0.199987 1.002089 1.773990 0.551532 1.317323 0.068364 0.831380 1.647517 0.396358 1.158074 1.994809 0.718624 1.493473 0.272828 1.060055 1.881160 0.656937 1.411179 0.214621 1.033909 1.752887 0.569748 1.376250 0.149777 0.908833 1.738552 0.526411 1.294993 0.103500 0.893371 1.686581 0.493803 1.298138 0.082702 0.870780 1.680849 0.520032 1.314491 0.059141 0.902752 1.722231 0.534013 1.314963 0.092557 0.929374 1.771071 0.545350 1.359764 0.162904 0.994633 1.800444 0.654822 1.440097 0.271629 1.100326 1.900313 0.733479 1.560958 0.358043 1.159060 0.035027 0.805574 1.648436 0.492575 1.332457 0.151432 0.981695 1.808889 0.660295 1.470496 0.311692 1.137584 1.976828 0.803543 1.642196 0.497751 1.335734 0.164465 0.990616 1.865258 0.699088 1.544703 0.384326 1.218235 0.028013 0.922653 1.732336 0.620637 1.473614 0.309235 1.146814 0.026921 0.851754 1.712224 0.584906 1.446369 0.290275 1.154728 0.016628 0.885706 1.739430 0.596112 1.444972 0.300698 1.161129 0.071959 0.887545 1.789668 0.646427 1.518850 0.388134 1.290903 0.149371 1.017139 1.906413 0.782821 1.679601 0.538908 1.427302 0.261530 1.163063 0.056126 0.930666 1.775628 0.696685 1.598897 0.448632 1.326737 0.252723 1.140212 0.029296 0.929445 1.772432 0.681129 1.584046 0.458727 1.356458 0.249291 1.170087 0.058615 0.989205 1.865610 0.767396 1.652885 0.578992 1.495288 0.379016 1.263290 0.201257 1.123549 -0.010276 0.898029 1.798772 0.752575 1.634417 0.557719 1.463667 0.370344 1.295665 0.190776 1.090704 0.050605 0.996022 1.873218 0.809295 1.746146 0.648786 1.571816 0.524141 1.422241 0.366686 1.302138 0.237033 1.184544 0.066062 0.986330 1.968148 0.919197 1.841882 0.727184 1.728271 0.614948 1.562438 0.500483 1.416599 0.381985 1.310430 0.267267 1.216908 0.114405 1.054735 0.044860 0.942126 1.918512 0.865400 1.798123 0.759456 1.746821 0.660050 1.622729 0.596491 1.556705 0.501053 1.485367 0.453849 1.393727 0.358857 1.320313 0.304365 1.241385 0.195558 1.183347 0.151935 1.107703 0.075803 1.064363 0.015231 0.975010 1.938288 0.927423 1.901169 0.841899 1.876920 0.849275 1.796356 0.781909 1.743480 0.692751 1.723710 0.708437 1.657489 0.639233 1.647097 0.614293 1.595806 0.597694 1.589533 0.585735 1.542929 0.537155 1.540039 0.504353 1.527350 0.483057 1.485483 0.511909 1.493148 0.490249 1.500196 0.492979 1.527303 0.484580 1.486738 0.490916 1.538110 0.519640 1.510746 0.563503 1.559086 0.606402 1.602406 0.604386 1.623997 0.576318 1.632332 0.604648 1.642318 0.693077 1.670034 0.703995 1.727037 0.761005 1.758022 0.812133 1.821689 0.854472 1.869189 0.949319 1.946824 0.987419 -0.782152 1.027696 0.050772 1.113195 0.099118 1.193533 0.187247 1.271506 0.279815 1.331821 0.389579 1.458743)
)
))
@@ -4897,19 +4891,7 @@
;;; 9-Nov-16: 22
;;; 20-Jul-17: 6 (370)
-<1> (load "test-phases.scm")
-test-all-phases
-<2> (test-all-phases #f)
-;all peaks... Wed 09-Nov-2016 16:29
-(0.001495737399423547 101)
-;odd peaks... Wed 09-Nov-2016 16:36
-(0.001687315629258279 125)
-;even peaks... Wed 09-Nov-2016 16:41
-(0.001467169674692848 4)
-;prime peaks... Wed 09-Nov-2016 16:45
-(0.001975582609148319 2048)
-;all done! Wed 09-Nov-2016 16:51
-
+<1> (load "test-phases.scm") ; same 27-Aug-17
<1> (test-all-phases #f)
;all peaks... Thu 20-Jul-2017 14:49
(0.00149573739942177 101)
diff --git a/profile.scm b/profile.scm
index 3e19e41..c298834 100644
--- a/profile.scm
+++ b/profile.scm
@@ -19,14 +19,19 @@
((= i n)
(newline *stderr*))
(let ((data (vect i)))
- (let ((expr (cddr data))
+ (let ((expr (caddr data))
(count (cadr data))
- (key (car data)))
+ (key (car data))
+ (func (cdddr data)))
(let ((file (profile-filename key))
(line (profile-line-number key)))
(if (> line 0)
- (format *stderr* "~A[~A]: ~A ~30T~A~%"
- file line count
+ (format *stderr* "~A:~8T~A ~24T~A[~A]: ~48T~A~%"
+ count
+ (if (string? func)
+ (format #f " ~A" func)
+ "")
+ file line
(if (> (length expr) 60)
(string-append (substring expr 0 56) " ...")
expr)))))))))))
diff --git a/repl.c b/repl.c
new file mode 100644
index 0000000..e28ae03
--- /dev/null
+++ b/repl.c
@@ -0,0 +1,25 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "s7.h"
+
+int main(int argc, char **argv)
+{
+ s7_scheme *sc;
+ sc = s7_init();
+
+ if (argc == 2)
+ {
+ fprintf(stderr, "load %s\n", argv[1]);
+ s7_load(sc, argv[1]);
+ }
+ else
+ {
+ s7_load(sc, "repl.scm");
+ s7_eval_c_string(sc, "((*repl* 'run))");
+ }
+ return(0);
+}
+
+/* gcc -o repl repl.c s7.o -Wl,-export-dynamic -lm -I. -ldl
+ */
diff --git a/repl.scm b/repl.scm
index 9059a05..913e190 100644
--- a/repl.scm
+++ b/repl.scm
@@ -241,19 +241,19 @@
(let ((documentation "this is the repl's load replacement; its default is to use the repl's top-level-let.")
(signature '(values string? let?)))
(lambda* (file (e (*repl* 'top-level-let)))
- (dynamic-wind original-hooks (lambda () (load file e)) repl-hooks))))
+ (dynamic-wind repl-hooks (lambda () (load file e)) original-hooks))))
(new-eval
(let ((documentation "this is the repl's eval replacement; its default is to use the repl's top-level-let.")
(signature '(values list? let?)))
(lambda* (form (e (*repl* 'top-level-let)))
- (dynamic-wind original-hooks (lambda () (eval form e)) repl-hooks))))
+ (dynamic-wind repl-hooks (lambda () (eval form e)) original-hooks))))
(new-eval-string
(let ((documentation "this is the repl's eval-string replacement; its default is to use the repl's top-level-let.")
(signature '(values string? let?)))
(lambda* (str (e (*repl* 'top-level-let)))
- (dynamic-wind original-hooks (lambda () (eval-string str e)) repl-hooks)))))
+ (dynamic-wind repl-hooks (lambda () (eval-string str e)) original-hooks)))))
(dynamic-wind
(lambda ()
@@ -509,7 +509,7 @@
((null? lst))
(let ((str ((car lst) c)))
(move-cursor i col)
- (format *stderr* "~C[K| ~A" #\escape (if (> (length str) col) (substring str 0 (- col 1)) str))))
+ (format *stderr* "~C[K| ~A" #\escape (if (> (length str) col) (substring str 0 (- col 1)) str))))
(move-cursor (+ 2 (length (*repl* 'helpers))) col)
(format *stderr* "+~NC" (- col 2) #\-)
@@ -1039,14 +1039,52 @@
(set! (meta-keymap-functions (char->integer #\u)) upper-case)
(set! (meta-keymap-functions (char->integer #\l)) lower-case))
- ;; -------- terminal setup --------
- (define* (run file)
- (let ((saved #f)
- (tty #t))
+ ;; -------- emacs --------
+ (define (emacs-repl)
+ ;; TODO: use the emacs language server protocol? (not our own rpc stuff or epc), for json, see json.scm
+ ;; probably will need an argument/function? for repl to open the channel or whatever
+ ;; also this does not resend the entire expression after editing
+ ;; and does not notice in-place edits
+ ;; can <cr> get entire expr?
+ (let ((buf (c-pointer->string (calloc 512 1) 512)))
+ (format *stderr* "> ")
+ (do ((b (fgets buf 512 stdin) (fgets buf 512 stdin)))
+ ((zero? (length b))
+ (#_exit))
+ (let ((len (strlen buf)))
+ (when (positive? len)
+ (do ((i 0 (+ i 1)))
+ ((or (not (char-whitespace? (buf i)))
+ (= i len))
+ (when (< i len)
+ (let ((str (substring buf 0 (- (strlen buf) 1))))
+ ;(format *stderr* "str: ~S~%" str)
+ (catch #t
+ (lambda ()
+ (do ()
+ ((= (string-length str) 0))
+ (catch 'string-read-error
+ (lambda ()
+ (with-repl-let
+ (lambda ()
+ (format *stderr* "~S~%> " (eval-string str (*repl* 'top-level-let)))
+ (set! str ""))))
+ (lambda (type info)
+ (fgets buf 512 stdin)
+ ;(format *stderr* "add str: ~S~%" (substring buf 0 (- (strlen buf) 1)))
+ (set! str (string-append str " " (substring buf 0 (- (strlen buf) 1))))))))
+ (lambda (type info)
+ (set! str "")
+ (apply format *stderr* info)
+ (format *stderr* "~%> "))))))))))))
+
+ ;; -------- rxvt et al --------
+ (define (terminal-repl file)
+ (let ((saved #f))
;; we're in libc here, so exit is libc's exit!
(define (tty-reset)
- (if tty (tcsetattr terminal-fd TCSAFLUSH saved))
+ (tcsetattr terminal-fd TCSAFLUSH saved)
(if (not (equal? input-fd terminal-fd)) (close input-fd))
(#_exit))
@@ -1056,33 +1094,7 @@
(newline *stderr*)
(tty-reset))))
- ;; check for dumb terminal
- (if (or (zero? (isatty terminal-fd)) ; not a terminal -- input from pipe probably
- (string=? (getenv "TERM") "dumb")) ; no vt100 codes -- emacs shell for example
- (let ((buf (c-pointer->string (calloc 512 1) 512)))
- (set! tty #f)
- (format *stderr* "> ")
- (do ((b (fgets buf 512 stdin) (fgets buf 512 stdin)))
- ((zero? (length b))
- (#_exit))
- (let ((len (strlen buf)))
- (when (positive? len)
- (do ((i 0 (+ i 1)))
- ((or (not (char-whitespace? (buf i)))
- (= i len))
- (when (< i len)
- (with-repl-let
- (lambda ()
- (catch #t
- (lambda ()
- (format *stderr* "~S~%" (eval-string (substring buf 0 (- (strlen buf) 1)) (*repl* 'top-level-let))))
- (lambda (type info)
- (format *stderr* "error: ")
- (apply format *stderr* info)
- (newline *stderr*)))))
- (format *stderr* "> ")))))))))
-
- ;; not a pipe or a dumb terminal -- hopefully all others accept vt100 codes
+ ;; a "normal" terminal -- hopefully it accepts vt100 codes
(let ((buf (termios.make)))
(let ((read-size 128))
(set! next-char ; this indirection is needed if user pastes the selection into the repl
@@ -1100,10 +1112,10 @@
(set! chars (read input-fd cc read-size))
(if (= chars 0)
(tty-reset))
-
+
(when (> chars (- last-col prompt-length 12))
(let ((str (substring c 0 chars)))
-
+
(when (= chars read-size)
;; concatenate buffers until we get the entire selection
(let reading ((num (read input-fd cc read-size)))
@@ -1159,17 +1171,17 @@
(display-lines)
(return #\newline)))))
;; now the pasted-in line has inserted newlines, we hope
-
+
(set! c str)
(set! cc (string->c-pointer c))
-
+
;; avoid time-consuming redisplays. We need to use a recursive call on next-char here
;; since we might have multi-char commands (embedded #\escape -> meta, etc)
;; actually, the time is not the repl's fault -- xterm seems to be waiting
;; for the window manager or someone to poke it -- if I move the mouse,
;; I get immediate output. I also get immediate output in any case in OSX.
;; valgrind and ps say we're not computing, we're just sitting there.
-
+
(catch #t
(lambda ()
(do ((ch (next-char) (next-char)))
@@ -1209,8 +1221,6 @@
(when (negative? (tcsetattr terminal-fd TCSAFLUSH buf))
(tty-reset))
-
- ;; -------- the repl --------
(display-prompt)
(cursor-bounds)
;; (debug-help)
@@ -1239,6 +1249,13 @@
(set! chars 0)
(new-prompt)))))))
+ (define* (run file)
+ ;; check for dumb terminal
+ (if (or (zero? (isatty terminal-fd)) ; not a terminal -- input from pipe probably
+ (string=? (getenv "TERM") "dumb")) ; no vt100 codes -- emacs subjob for example
+ (emacs-repl) ; TODO: restore support for the pipe case
+ (terminal-repl file)))
+
(curlet))))))
(define (save-repl)
@@ -1260,7 +1277,6 @@
(set! (*repl* 'top-level-let) (load "save.repl")))
;; I think this could be a merge rather than a reset by using (with-let top-level-let (load ...))
-
(set! keymap (repl-let 'keymap))
(set! history (repl-let 'history))
(set! history-size (repl-let 'history-size))
diff --git a/s7.c b/s7.c
index 7b885f3..fa2c6f6 100644
--- a/s7.c
+++ b/s7.c
@@ -134,6 +134,7 @@
* -ffast-math makes a mess of NaNs, and does not appear to be faster
* for timing tests, I use: -O2 -march=native -fomit-frame-pointer -funroll-loops
* according to callgrind, clang is normally about 10% slower than gcc, and vectorization either doesn't work or is much worse than gcc's
+ * also g++ appears to be slightly slower than gcc (though it takes forever to compile s7.c: gcc s7 compile time 37 secs, g++ 256!)
*/
#if (defined(__GNUC__) || defined(__clang__))
@@ -149,11 +150,13 @@
#define INITIAL_HEAP_SIZE 128000
/* the heap grows as needed, this is its initial size.
* If the initial heap is small, s7 can run in about 2.5 Mbytes of memory. There are (many) cases where a bigger heap is faster.
- * The heap size must be a multiple of 32. Each object takes about 50 bytes.
+ * The heap size must be a multiple of 32. Each object takes about 60 bytes.
*
* repl runs in 4Mb (18v) (64bit) if heap is 8192
* 11Mb (25v) if 128k heap
* snd (no gui) 15Mb (151v)
+ * snd (no gui) 17Mb (33v) (no gsl, fftw, audio)
+ * 21Mb (155v) same but with ALSA!?
* snd (motif) 12Mb (285v)
* snd (gtk) 32Mb (515v!)
*/
@@ -374,25 +377,15 @@ static int32_t float_format_precision = WRITE_REAL_PRECISION;
#endif
#define DISPLAY(Obj) s7_object_to_c_string(sc, Obj)
-#define ODISPLAY(Obj) s7_object_to_c_string(cur_sc, Obj)
#define DISPLAY_80(Obj) object_to_truncated_string(sc, Obj, 80)
-#define ODISPLAY_80(Obj) object_to_truncated_string(cur_sc, Obj, 80)
+typedef intptr_t opcode_t;
#define PRINT_NAME_PADDING 16
#if (((defined(SIZEOF_VOID_P)) && (SIZEOF_VOID_P == 4)) || ((defined(__SIZEOF_POINTER__)) && (__SIZEOF_POINTER__ == 4)))
- #define opcode_t uint32_t
- #define ptr_int uint32_t
- #define INT_FORMAT "%" PRIu32
- #define PD_U "%" PRIu32
- /* INT_FORMAT is for opcode_t and raw c_pointer printout, not s7_int values, PD_U is for pointer differences */
#define PRINT_NAME_SIZE (20 - PRINT_NAME_PADDING - 2) /* pointless */
#define POINTER_32 true
#else
- #define opcode_t uint64_t
- #define ptr_int uint64_t
- #define INT_FORMAT "%" PRIu64
- #define PD_U "%" PRIu64
#define PRINT_NAME_SIZE (40 - PRINT_NAME_PADDING - 2)
#define POINTER_32 false
#endif
@@ -458,9 +451,7 @@ static int32_t float_format_precision = WRITE_REAL_PRECISION;
#define NUM_TYPES 51
-/* T_STACK, T_SLOT, T_BAFFLE, T_DYNAMIC_WIND, T_OPTLIST, and T_COUNTER are internal
- * I tried T_CASE_SELECTOR that turned a case statement into an array, but it was slower!
- */
+/* T_STACK, T_SLOT, T_BAFFLE, T_DYNAMIC_WIND, T_OPTLIST, and T_COUNTER are internal */
typedef enum {TOKEN_EOF, TOKEN_LEFT_PAREN, TOKEN_RIGHT_PAREN, TOKEN_DOT, TOKEN_ATOM, TOKEN_QUOTE, TOKEN_DOUBLE_QUOTE,
TOKEN_BACK_QUOTE, TOKEN_COMMA, TOKEN_AT_MARK, TOKEN_SHARP_CONST,
@@ -683,7 +674,7 @@ typedef struct s7_cell {
struct { /* ports */
port_t *port;
unsigned char *data;
- uint32_t size, point; /* these limit the in-core portion of a string-port to 2^31 bytes */
+ uint32_t size, point; /* these limit the in-core portion of a string-port to 2^32-1 bytes */
uint32_t line_number, file_number;
bool is_closed;
port_type_t ptype;
@@ -699,6 +690,10 @@ typedef struct s7_cell {
struct { /* c-pointers */
void *c_pointer;
s7_pointer c_type, info;
+ /* if a gc_free function were included, the pointer could be freed (etc) via the GC-cache (sweep function), but then
+ * every possible explicit free function would need to warn the GC not to try to free the pointer.
+ * How to recognize an unfreed pointer at sweep time?
+ */
} cptr;
int32_t baffle_key; /* baffles */
@@ -719,7 +714,7 @@ typedef struct s7_cell {
s7_int length;
s7_pointer *objects;
vdims_t *dim_info;
- int32_t top;
+ int64_t top;
} stk;
struct { /* hash-tables */
@@ -727,7 +722,7 @@ typedef struct s7_cell {
hash_entry_t **elements;
hash_check_t hash_func;
hash_map_t *loc;
- s7_pointer dproc;
+ s7_pointer dproc; /* user-supplied list of hashing functions */
} hasher;
struct { /* iterators */
@@ -756,6 +751,11 @@ typedef struct s7_cell {
s7_pointer car, cdr, opt1, opt2, opt3;
} cons;
+ struct { /* pairs */
+ s7_pointer car, cdr, opt1, opt2;
+ uint8_t opt_type;
+ } cons_ext;
+
struct { /* special purpose pairs (symbol-table etc) */
s7_pointer unused_car, unused_cdr;
uint64_t hash;
@@ -776,28 +776,30 @@ typedef struct s7_cell {
struct { /* strings */
uint32_t length;
union {
- bool needs_free;
- uint32_t accessor;
- int32_t temp_len;
+ bool needs_free; /* string GC */
+ uint32_t accessor; /* symbol-access */
+ int32_t temp_len; /* temp string length (sc->tmp_strs) */
} str_ext;
char *svalue;
- uint64_t hash; /* string hash-index */
- s7_pointer initial_slot;
+ uint64_t hash; /* string hash-index */
+ s7_pointer initial_slot; /* for built-in symbols (unlet) */
union {
- char *documentation;
- s7_pointer ksym;
+ char *documentation; /* symbol help */
+ s7_pointer ksym; /* keyword->symbol */
} doc;
} string;
struct { /* symbols */
s7_pointer name, global_slot, local_slot;
int64_t id;
- uint32_t ctr, tag;
+ uint32_t ctr; /* closure_is_ok (check func only defined once) */
+ uint16_t tag; /* symbol lists (quick memq) */
+ uint8_t type;
} sym;
struct { /* syntax */
s7_pointer symbol;
- int32_t op;
+ opcode_t op;
int16_t min_args, max_args;
} syn;
@@ -807,7 +809,7 @@ typedef struct s7_cell {
struct { /* environments (frames, lets) */
s7_pointer slots, nxt;
- int64_t id; /* id of rootlet is -1 */
+ int64_t id; /* id of rootlet is -1 */
union {
struct {
s7_pointer function; /* __func__ (code) if this is a funclet */
@@ -817,8 +819,7 @@ typedef struct s7_cell {
s7_pointer dox1, dox2; /* do loop variables */
} dox;
struct { /* (catch #t ...) opts */
- s7_pointer result;
- uint32_t op_stack_loc, goto_loc;
+ uint64_t op_stack_loc, goto_loc;
} ctall;
} edat;
} envr;
@@ -834,7 +835,7 @@ typedef struct s7_cell {
struct { /* counter (internal) */
s7_pointer result, list, env, slots; /* env = counter_let (curlet after map/for-each frame created) */
- uint64_t cap; /* sc->capture_let_counter for frame reuse */
+ uint64_t cap; /* sc->capture_let_counter for frame reuse */
} ctr;
struct { /* random-state */
@@ -849,7 +850,7 @@ typedef struct s7_cell {
int32_t type;
void *value; /* the value the caller associates with the object */
s7_pointer e; /* the method list, if any (openlet) */
- s7_pointer (*ref)(s7_scheme *sc, s7_pointer obj, s7_int pos);
+ void (*mark)(void *val);
} c_obj;
struct { /* continuations */
@@ -859,17 +860,17 @@ typedef struct s7_cell {
} cwcc;
struct { /* call-with-exit */
- uint32_t goto_loc, op_stack_loc;
+ uint64_t goto_loc, op_stack_loc;
bool active;
} rexit;
struct { /* catch */
- uint32_t goto_loc, op_stack_loc;
+ uint64_t goto_loc, op_stack_loc;
s7_pointer tag;
s7_pointer handler;
} rcatch; /* C++ reserves "catch" I guess */
- struct { /* dynamic-wind */
+ struct { /* dynamic-wind */
s7_pointer in, out, body;
uint32_t state;
} winder;
@@ -889,7 +890,7 @@ typedef struct s7_cell {
typedef struct {
s7_pointer *objs;
- int32_t size, top, ref;
+ int32_t size, top, ref, size2;
bool has_hits;
int32_t *refs;
} shared_info;
@@ -919,7 +920,7 @@ static s7_pointer real_zero, real_NaN, real_pi, real_one, arity_not_set, max_ari
struct s7_scheme {
- opcode_t op; /* making this global is much slower! */
+ opcode_t cur_op; /* making this global is much slower! */
s7_pointer value;
s7_pointer args; /* arguments of current function */
s7_pointer code, cur_code; /* current code */
@@ -1045,7 +1046,11 @@ struct s7_scheme {
char ***string_lists;
int32_t *string_locs, *string_sizes, *string_max_sizes;
- uint32_t syms_tag;
+ c_object_t **c_object_types;
+ int32_t c_object_types_size;
+ int32_t num_c_object_types;
+
+ uint16_t syms_tag;
int32_t ht_iter_tag, baffle_ctr, bignum_precision;
s7_pointer default_rng;
@@ -1144,7 +1149,7 @@ struct s7_scheme {
/* optimizer symbols */
s7_pointer and_ap_symbol, and_az_symbol, and_p_symbol, and_safe_aa_symbol, and_safe_p_symbol,
- and_unchecked_symbol, begin_unchecked_symbol, case_a_symbol, case_unchecked_symbol,
+ and_unchecked_symbol, begin1_symbol, case_a_symbol, case_unchecked_symbol,
cond_all_x_2_symbol, cond_all_x_symbol, cond_all_x_z_symbol, cond_simple_symbol, cond_unchecked_symbol, cond_unchecked_z_symbol,
decrement_1_symbol, define_constant_unchecked_symbol, define_funchecked_symbol, define_star_unchecked_symbol, define_unchecked_symbol,
do_unchecked_symbol, dotimes_p_symbol, dox_symbol, cond_feed_symbol,
@@ -1160,10 +1165,11 @@ struct s7_scheme {
if_csc_p_p_symbol, if_csc_p_symbol, if_csc_r_symbol, if_csc_n_n_symbol, if_csc_n_symbol,
if_csq_p_p_symbol, if_csq_p_symbol, if_csq_r_symbol, if_csq_n_n_symbol, if_csq_n_symbol,
if_css_p_p_symbol, if_css_p_symbol, if_css_r_symbol, if_css_n_n_symbol, if_css_n_symbol,
- if_is_pair_p_p_symbol, if_is_pair_p_symbol, if_is_pair_r_symbol, if_is_pair_n_n_symbol, if_is_pair_n_symbol,
- if_is_symbol_p_p_symbol, if_is_symbol_p_symbol, if_is_symbol_r_symbol, if_is_symbol_n_n_symbol, if_is_symbol_n_symbol,
+ if_is_type_s_p_p_symbol, if_is_type_s_p_symbol, if_is_type_s_r_symbol, if_is_type_s_n_n_symbol, if_is_type_s_n_symbol,
+ if_is_type_opsq_p_p_symbol, if_is_type_opsq_p_symbol, if_is_type_opsq_r_symbol, if_is_type_opsq_n_n_symbol, if_is_type_opsq_n_symbol,
if_opsq_p_p_symbol, if_opsq_p_symbol, if_opsq_r_symbol, if_opsq_n_n_symbol, if_opsq_n_symbol,
if_and2_p_p_symbol, if_and2_p_symbol, if_and2_r_symbol, if_and2_n_n_symbol, if_and2_n_symbol,
+ if_and3_p_p_symbol, if_and3_p_symbol, if_and3_r_symbol, if_and3_n_n_symbol, if_and3_n_symbol,
if_andp_p_p_symbol, if_andp_p_symbol, if_andp_r_symbol, if_andp_n_n_symbol, if_andp_n_symbol,
if_or2_p_p_symbol, if_or2_p_symbol, if_or2_r_symbol, if_or2_n_n_symbol, if_or2_n_symbol,
if_orp_p_p_symbol, if_orp_p_symbol, if_orp_r_symbol, if_orp_n_n_symbol, if_orp_n_symbol,
@@ -1171,7 +1177,6 @@ struct s7_scheme {
if_s_opcq_p_p_symbol, if_s_opcq_p_symbol, if_s_opcq_r_symbol, if_s_opcq_n_n_symbol, if_s_opcq_n_symbol,
if_s_p_p_symbol, if_s_p_symbol, if_s_r_symbol, if_s_n_n_symbol, if_s_n_symbol,
if_z_p_p_symbol, if_z_p_symbol, if_z_r_symbol, if_z_n_n_symbol, if_z_n_symbol,
- if_is_null_p_symbol, if_is_null_p_p_symbol, if_is_null_r_symbol, if_is_null_n_symbol, if_is_null_n_n_symbol,
increment_1_symbol, increment_sa_symbol, increment_saa_symbol, increment_ss_symbol,
increment_sss_symbol, increment_sz_symbol, lambda_star_unchecked_symbol, lambda_unchecked_symbol, let_all_c_symbol,
@@ -1423,8 +1428,8 @@ static s7_scheme *cur_sc = NULL;
#if DEBUGGING
static const char *check_name(int32_t typ);
static s7_pointer check_seti(s7_scheme *sc, s7_pointer x, const char *func, int32_t line);
- static s7_pointer check_ref(s7_pointer p, int32_t expected_type, const char *func, int32_t line, const char *func1, const char *func2);
- static s7_pointer check_ref2(s7_pointer p, int32_t expected_type, int32_t other_type, const char *func, int32_t line, const char *func1, const char *func2);
+ static s7_pointer check_ref(s7_pointer p, uint8_t expected_type, const char *func, int32_t line, const char *func1, const char *func2);
+ static s7_pointer check_ref2(s7_pointer p, uint8_t expected_type, int32_t other_type, const char *func, int32_t line, const char *func1, const char *func2);
static s7_pointer check_ref3(s7_pointer p, const char *func, int32_t line);
static s7_pointer check_ref4(s7_pointer p, const char *func, int32_t line);
static s7_pointer check_ref5(s7_pointer p, const char *func, int32_t line);
@@ -1459,7 +1464,11 @@ static s7_scheme *cur_sc = NULL;
static void set_s_syn_op_1(s7_scheme *sc, s7_pointer p, uint32_t x, const char *func, int32_t line);
#define unchecked_type(p) ((p)->tf.type_field)
+#if WITH_GCC
#define type(p) ({uint8_t _t_; _t_ = (p)->tf.type_field; if (((_t_ == T_FREE)) || (_t_ >= NUM_TYPES)) print_gc_info(p, __LINE__); _t_;})
+#else
+ #define type(p) (p)->tf.type_field
+#endif
#define set_type(p, f) \
do { \
@@ -1513,7 +1522,7 @@ static s7_scheme *cur_sc = NULL;
#define _TRan(P) check_ref(P, T_RANDOM_STATE, __func__, __LINE__, NULL, NULL)
#define _TLst(P) check_ref2(P, T_PAIR, T_NIL, __func__, __LINE__, "gc", NULL)
#define _TStr(P) check_ref(P, T_STRING, __func__, __LINE__, "sweep", NULL)
- #define _TObj(P) check_ref(P, T_C_OBJECT, __func__, __LINE__, "free_object", NULL)
+ #define _TObj(P) check_ref(P, T_C_OBJECT, __func__, __LINE__, "sweep", NULL)
#define _THsh(P) check_ref(P, T_HASH_TABLE, __func__, __LINE__, "sweep", "free_hash_table")
#define _TItr(P) check_ref(P, T_ITERATOR, __func__, __LINE__, "sweep", NULL)
#define _TCon(P) check_ref(P, T_CONTINUATION, __func__, __LINE__, "sweep", NULL)
@@ -1935,8 +1944,8 @@ static s7_scheme *cur_sc = NULL;
#define T_HAS_SET_FALLBACK T_SAFE_STEPPER
#define T_HAS_REF_FALLBACK T_MUTABLE
-#define has_ref_fallback(p) ((typeflag(_TLid(p)) & T_HAS_REF_FALLBACK) != 0)
-#define has_set_fallback(p) ((typeflag(_TLid(p)) & T_HAS_SET_FALLBACK) != 0)
+#define has_ref_fallback(p) ((typeflag(_TLid(p)) & (T_HAS_REF_FALLBACK | T_HAS_METHODS)) == (T_HAS_REF_FALLBACK | T_HAS_METHODS))
+#define has_set_fallback(p) ((typeflag(_TLid(p)) & (T_HAS_SET_FALLBACK | T_HAS_METHODS)) == (T_HAS_SET_FALLBACK | T_HAS_METHODS))
#define set_has_ref_fallback(p) typeflag(_TLet(p)) |= T_HAS_REF_FALLBACK
#define set_has_set_fallback(p) typeflag(_TLet(p)) |= T_HAS_SET_FALLBACK
#define set_all_methods(p, e) typeflag(_TLet(p)) |= (typeflag(e) & (T_HAS_METHODS | T_HAS_REF_FALLBACK | T_HAS_SET_FALLBACK))
@@ -1955,33 +1964,46 @@ static s7_scheme *cur_sc = NULL;
#define is_gensym(p) ((typeflag(_TSym(p)) & T_GENSYM) != 0)
/* symbol is from gensym (GC-able etc) */
- /* gensym bit is ok for a pair */
-
#define T_FUNCLET T_GENSYM
#define is_funclet(p) ((typeflag(_TLet(p)) & T_FUNCLET) != 0)
#define set_funclet(p) typeflag(_TLet(p)) |= T_FUNCLET
/* this marks a funclet */
+#define T_HASH_CHOSEN T_GENSYM
+#define hash_chosen(p) ((typeflag(_THsh(p)) & T_HASH_CHOSEN) != 0)
+#define hash_set_chosen(p) typeflag(_THsh(p)) |= T_HASH_CHOSEN
+#define hash_clear_chosen(p) typeflag(_THsh(p)) &= (~T_HASH_CHOSEN)
+
#define T_DOCUMENTED T_GENSYM
#define is_documented(p) ((typeflag(_TStr(p)) & T_DOCUMENTED) != 0)
#define set_documented(p) typeflag(_TStr(p)) |= T_DOCUMENTED
/* this marks a symbol that has documentation (bit is set on name cell) */
+#define T_DOTTED_PAIR T_GENSYM
+#define is_dotted_pair(p) ((typeflag(_TLst(p)) & T_DOTTED_PAIR) != 0)
+#define pair_set_dotted(p) typeflag(_TPair(p)) |= T_DOTTED_PAIR
+/* reader indication that a list it just read was dotted */
+
#define T_HAS_METHODS (1 << (TYPE_BITS + 22))
#define has_methods(p) ((typeflag(_NFre(p)) & T_HAS_METHODS) != 0)
#define set_has_methods(p) typeflag(_TMet(p)) |= T_HAS_METHODS
#define clear_has_methods(p) typeflag(_TMet(p)) &= (~T_HAS_METHODS)
-/* this marks an environment or closure that is "opened" up to generic functions etc
- * don't reuse this bit if possible
+/* this marks an environment or closure that is "open" for generic functions etc
+ * don't reuse this bit
*/
+#define T_ITER_OK (1LL << (TYPE_BITS + 23))
+#define iter_ok(p) ((typeflag(_NFre(p)) & T_ITER_OK) != 0) /* not TItr(p) here because this bit is globally unique */
+#define clear_iter_ok(p) typeflag(_TItr(p)) &= (~T_ITER_OK)
+
+
#define T_GC_MARK 0x8000000000000000
#define is_marked(p) ((typeflag(p) & T_GC_MARK) != 0)
#define set_mark(p) typeflag(_NFre(p)) |= T_GC_MARK
#define clear_mark(p) typeflag(p) &= (~T_GC_MARK)
/* using bit 23 for this makes a big difference in the GC */
-static int32_t not_heap = -1;
+static int64_t not_heap = -1;
#define heap_location(p) (p)->hloc
#define not_in_heap(p) ((_NFre(p))->hloc < 0)
#define in_heap(p) ((_NFre(p))->hloc >= 0)
@@ -2133,8 +2155,8 @@ static int32_t not_heap = -1;
#define opt_slot1(P) _TSlt(opt1(P, E_SLOT))
#define set_opt_slot1(P, X) set_opt1(P, _TSlt(X), E_SLOT)
-#define opt_key(P) _NFre(opt2(P, F_KEY))
-#define set_opt_key(P, X) set_opt2(P, _NFre(X), F_KEY)
+#define opt_any2(P) _NFre(opt2(P, F_KEY))
+#define set_opt_any2(P, X) set_opt2(P, _NFre(X), F_KEY)
#define opt_slow(P) _TLst(opt2(P, F_SLOW))
#define set_opt_slow(P, X) set_opt2(P, _TPair(X), F_SLOW)
#define opt_sym2(P) _TSym(opt2(P, F_SYM))
@@ -2152,13 +2174,16 @@ static int32_t not_heap = -1;
#define set_arglist_length(P, X) set_opt3(cdr(P), _TI(X), G_ARGLEN)
#define opt_sym3(P) _TSym(opt3(P, G_SYM))
#define set_opt_sym3(P, X) set_opt3(P, _TSym(X), G_SYM)
-#define opt_and_2_test(P) _TPair(opt3(P, G_AND))
-#define set_opt_and_2_test(P, X) set_opt3(P, _TPair(X), G_AND)
-#define opt_else(P) _NFre(opt3(P, G_AND))
-#define set_opt_else(P, X) set_opt3(P, _NFre(X), G_AND)
+#define opt_pair3(P) _TPair(opt3(P, G_AND))
+#define set_opt_pair3(P, X) set_opt3(P, _TPair(X), G_AND)
+#define opt_any3(P) _NFre(opt3(P, G_AND))
+#define set_opt_any3(P, X) set_opt3(P, _NFre(X), G_AND)
#define opt_direct_x(P) opt3(P, G_DIRECT)
#define set_opt_direct_x(P, X) set_opt3(P, (s7_pointer)(X), G_DIRECT)
+#define opt_con3(P) P->object.cons_ext.opt_type
+#define set_opt_con3(P, X) P->object.cons_ext.opt_type = X
+
#define c_callee(f) ((s7_function)opt2(f, F_CALL))
#define c_call(f) ((s7_function)opt2(f, F_CALL))
#if DEBUGGING
@@ -2173,24 +2198,25 @@ static int32_t not_heap = -1;
#define set_x_call_direct(f, X) do {set_opt2(f, (s7_pointer)(X), F_CALL); set_has_all_x(f);} while (0)
-#define car(p) (_TLst(p))->object.cons.car
-#define set_car(p, Val) (_TLst(p))->object.cons.car = _NFre(Val)
-#define cdr(p) (_TLst(p))->object.cons.cdr
-#define set_cdr(p, Val) (_TLst(p))->object.cons.cdr = _NFre(Val)
+#define car(p) (_TPair(p))->object.cons.car
+#define set_car(p, Val) (_TPair(p))->object.cons.car = _NFre(Val)
+#define cdr(p) (_TPair(p))->object.cons.cdr
+#define set_cdr(p, Val) (_TPair(p))->object.cons.cdr = _NFre(Val)
#define unchecked_car(p) (_NFre(p))->object.cons.car
+#define unchecked_cdr(p) (_NFre(p))->object.cons.cdr
#define caar(p) car(car(p))
#define cadr(p) car(cdr(p))
-#define set_cadr(p, Val) (_TLst(p))->object.cons.cdr->object.cons.car = _NFre(Val)
+#define set_cadr(p, Val) (_TPair(p))->object.cons.cdr->object.cons.car = _NFre(Val)
#define cdar(p) cdr(car(p))
-#define set_cdar(p, Val) (_TLst(p))->object.cons.car->object.cons.cdr = _NFre(Val)
+#define set_cdar(p, Val) (_TPair(p))->object.cons.car->object.cons.cdr = _NFre(Val)
#define cddr(p) cdr(cdr(p))
#define caaar(p) car(car(car(p)))
#define cadar(p) car(cdr(car(p)))
#define cdadr(p) cdr(car(cdr(p)))
#define caddr(p) car(cdr(cdr(p)))
-#define set_caddr(p, Val) (_TLst(p))->object.cons.cdr->object.cons.cdr->object.cons.car = _NFre(Val)
+#define set_caddr(p, Val) (_TPair(p))->object.cons.cdr->object.cons.cdr->object.cons.car = _NFre(Val)
#define caadr(p) car(car(cdr(p)))
#define cdaar(p) cdr(car(car(p)))
#define cdddr(p) cdr(cdr(cdr(p)))
@@ -2275,6 +2301,7 @@ static int32_t not_heap = -1;
* callgrind says this is faster than an uint32_t!
*/
#define symbol_syntax_op(p) syntax_opcode(slot_value(global_slot(p)))
+#define symbol_type(p) (_TSym(p))->object.sym.type
#define global_slot(p) (_TSym(p))->object.sym.global_slot
#define set_global_slot(p, Val) (_TSym(p))->object.sym.global_slot = _TSld(Val)
@@ -2413,7 +2440,7 @@ static int32_t not_heap = -1;
#define iterator_set_current_slot(p, Val) (_TItr(p))->object.iter.lc.lcur = _TSln(Val)
#define iterator_let_cons(p) (_TItr(p))->object.iter.cur
#define iterator_next(p) (_TItr(p))->object.iter.next
-#define iterator_is_at_end(p) (iterator_next(p) == iterator_finished)
+#define iterator_is_at_end(p) ((typeflag(_TItr(p)) & T_ITER_OK) == 0)
#define ITERATOR_END eof_object
#define ITERATOR_END_NAME "#<eof>"
@@ -2560,8 +2587,6 @@ static int32_t not_heap = -1;
#define catch_all_set_goto_loc(p, L) (_TLet(p))->object.envr.edat.ctall.goto_loc = L
#define catch_all_op_loc(p) (_TLet(p))->object.envr.edat.ctall.op_stack_loc
#define catch_all_set_op_loc(p, L) (_TLet(p))->object.envr.edat.ctall.op_stack_loc = L
-#define catch_all_result(p) _NFre((_TLet(p))->object.envr.edat.ctall.result)
-#define catch_all_set_result(p, R) (_TLet(p))->object.envr.edat.ctall.result = R
enum {DWIND_INIT, DWIND_BODY, DWIND_FINISH};
#define dynamic_wind_state(p) (_TDyn(p))->object.winder.state
@@ -2574,28 +2599,23 @@ enum {DWIND_INIT, DWIND_BODY, DWIND_FINISH};
#define c_object_type(p) (_TObj(p))->object.c_obj.type
#define c_object_let(p) _TLid((_TObj(p))->object.c_obj.e)
#define c_object_set_let(p, L) (_TObj(p))->object.c_obj.e = _TLid(L)
-#define c_object_cref(p) (_TObj(p))->object.c_obj.ref
-
-static c_object_t **object_types = NULL;
-static int32_t object_types_size = 0;
-static int32_t num_object_types = 0;
-
-#define c_object_info(p) object_types[c_object_type(_TObj(p))]
-#define c_object_ref(p) c_object_info(p)->ref
-#define c_object_set(p) c_object_info(p)->set
-#define c_object_print(p) c_object_info(p)->print
-#define c_object_print_readably(p) c_object_info(p)->print_readably
-#define c_object_length(p) c_object_info(p)->length
-#define c_object_eql(p) c_object_info(p)->equal
-#define c_object_fill(p) c_object_info(p)->fill
-#define c_object_copy(p) c_object_info(p)->copy
-#define c_object_free(p) c_object_info(p)->free
-#define c_object_mark(p) c_object_info(p)->gc_mark
-#define c_object_reverse(p) c_object_info(p)->reverse
-#define c_object_direct_ref(p) c_object_info(p)->direct_ref
-#define c_object_direct_set(p) c_object_info(p)->direct_set
-#define c_object_scheme_name(p) _TStr(c_object_info(p)->scheme_name)
-/* #define c_object_outer_type(p) c_object_info(p)->outer_type */
+#define c_object_mark(p) (_TObj(p))->object.c_obj.mark
+
+#define c_object_info(Sc, p) Sc->c_object_types[c_object_type(_TObj(p))]
+#define c_object_free(Sc, p) c_object_info(Sc, p)->free
+#define c_object_ref(Sc, p) c_object_info(Sc, p)->ref
+#define c_object_set(Sc, p) c_object_info(Sc, p)->set
+#define c_object_print(Sc, p) c_object_info(Sc, p)->print
+#define c_object_print_readably(Sc, p) c_object_info(Sc, p)->print_readably
+#define c_object_len(Sc, p) c_object_info(Sc, p)->length
+#define c_object_eql(Sc, p) c_object_info(Sc, p)->equal
+#define c_object_fill(Sc, p) c_object_info(Sc, p)->fill
+#define c_object_copy(Sc, p) c_object_info(Sc, p)->copy
+#define c_object_reverse(Sc, p) c_object_info(Sc, p)->reverse
+#define c_object_direct_ref(Sc, p) c_object_info(Sc, p)->direct_ref
+#define c_object_direct_set(Sc, p) c_object_info(Sc, p)->direct_set
+#define c_object_scheme_name(Sc, p) _TStr(c_object_info(Sc, p)->scheme_name)
+/* #define c_object_outer_type(Sc, p) c_object_info(Sc, p)->outer_type */
#define raw_pointer(p) (_TPtr(p))->object.cptr.c_pointer
#define raw_pointer_type(p) (_TPtr(p))->object.cptr.c_type
@@ -2741,18 +2761,6 @@ static inline int32_t safe_strlen(const char *str)
}
-static int32_t safe_strlen5(const char *str)
-{
- /* safe_strlen but we quit counting if len>5 */
- char *tmp = (char *)str;
- char *end;
- if ((!tmp) || (!(*tmp))) return(0);
- end = (char *)(tmp + 6);
- while ((*tmp++) && (tmp < end)) {};
- return(tmp - str - 1);
-}
-
-
static char *copy_string_with_length(const char *str, int32_t len)
{
char *newstr;
@@ -2859,14 +2867,13 @@ static s7_pointer prepackaged_type_name(s7_scheme *sc, s7_pointer x);
static void s7_warn(s7_scheme *sc, int32_t len, const char *ctrl, ...);
static s7_pointer safe_reverse_in_place(s7_scheme *sc, s7_pointer list);
static s7_pointer cons_unchecked(s7_scheme *sc, s7_pointer a, s7_pointer b);
-static s7_pointer permanent_cons(s7_pointer a, s7_pointer b, uint32_t type);
+static s7_pointer permanent_cons(s7_pointer a, s7_pointer b, uint64_t type);
static s7_pointer permanent_list(s7_scheme *sc, int32_t len);
-static void free_object(s7_pointer a);
static s7_pointer make_atom(s7_scheme *sc, char *q, int32_t radix, bool want_symbol, bool with_error);
static s7_pointer apply_error(s7_scheme *sc, s7_pointer obj, s7_pointer args);
static int32_t remember_file_name(s7_scheme *sc, const char *file);
static const char *type_name(s7_scheme *sc, s7_pointer arg, int32_t article);
-static s7_pointer make_vector_1(s7_scheme *sc, s7_int len, bool filled, uint32_t typ);
+static s7_pointer make_vector_1(s7_scheme *sc, s7_int len, bool filled, uint64_t typ);
static s7_pointer make_string_uncopied_with_length(s7_scheme *sc, char *str, int32_t len);
static s7_pointer make_string_wrapper_with_length(s7_scheme *sc, const char *str, int32_t len);
static void check_for_substring_temp(s7_scheme *sc, s7_pointer expr);
@@ -2977,7 +2984,7 @@ enum {OP_NO_OP, OP_GC_PROTECT,
OP_READ_INTERNAL, OP_EVAL,
OP_EVAL_ARGS, OP_EVAL_ARGS1, OP_EVAL_ARGS2, OP_EVAL_ARGS3, OP_EVAL_ARGS4, OP_EVAL_ARGS5,
OP_APPLY, OP_EVAL_MACRO, OP_LAMBDA, OP_QUOTE, OP_MACROEXPAND,
- OP_DEFINE, OP_DEFINE1, OP_BEGIN, OP_BEGIN_UNCHECKED, OP_BEGIN1,
+ OP_DEFINE, OP_DEFINE1, OP_BEGIN, OP_BEGIN1,
OP_IF, OP_IF1, OP_WHEN, OP_WHEN1, OP_UNLESS, OP_UNLESS1, OP_SET, OP_SET1, OP_SET2,
OP_LET, OP_LET1, OP_LET_STAR, OP_LET_STAR1, OP_LET_STAR2,
OP_LETREC, OP_LETREC1, OP_LETREC_STAR, OP_LETREC_STAR1,
@@ -2997,7 +3004,8 @@ enum {OP_NO_OP, OP_GC_PROTECT,
OP_WITH_LET, OP_WITH_LET1, OP_WITH_LET_UNCHECKED, OP_WITH_LET_S,
OP_WITH_BAFFLE, OP_WITH_BAFFLE_UNCHECKED, OP_EXPANSION,
OP_FOR_EACH, OP_FOR_EACH_1, OP_FOR_EACH_2, OP_FOR_EACH_3,
- OP_MAP, OP_MAP_1, OP_MAP_GATHER, OP_MAP_GATHER_1, OP_BARRIER, OP_DEACTIVATE_GOTO,
+ OP_MAP, OP_MAP_1, OP_MAP_2, OP_MAP_GATHER, OP_MAP_GATHER_1, OP_MAP_GATHER_2, OP_MAP_GATHER_3,
+ OP_BARRIER, OP_DEACTIVATE_GOTO,
OP_DEFINE_BACRO, OP_DEFINE_BACRO_STAR,
OP_GET_OUTPUT_STRING, OP_GET_OUTPUT_STRING_1,
@@ -3040,13 +3048,13 @@ enum {OP_NO_OP, OP_GC_PROTECT,
OP_IF_CSQ_P, OP_IF_CSQ_P_P, OP_IF_CSQ_R, OP_IF_CSQ_N, OP_IF_CSQ_N_N,
OP_IF_CSS_P, OP_IF_CSS_P_P, OP_IF_CSS_R, OP_IF_CSS_N, OP_IF_CSS_N_N,
OP_IF_CSC_P, OP_IF_CSC_P_P, OP_IF_CSC_R, OP_IF_CSC_N, OP_IF_CSC_N_N,
- OP_IF_IS_PAIR_P, OP_IF_IS_PAIR_P_P, OP_IF_IS_PAIR_R, OP_IF_IS_PAIR_N, OP_IF_IS_PAIR_N_N,
- OP_IF_IS_NULL_P, OP_IF_IS_NULL_P_P, OP_IF_IS_NULL_R, OP_IF_IS_NULL_N, OP_IF_IS_NULL_N_N,
OP_IF_opSq_P, OP_IF_opSq_P_P, OP_IF_opSq_R, OP_IF_opSq_N, OP_IF_opSq_N_N,
OP_IF_S_opCq_P, OP_IF_S_opCq_P_P, OP_IF_S_opCq_R, OP_IF_S_opCq_N, OP_IF_S_opCq_N_N,
- OP_IF_IS_SYMBOL_P, OP_IF_IS_SYMBOL_P_P, OP_IF_IS_SYMBOL_R, OP_IF_IS_SYMBOL_N, OP_IF_IS_SYMBOL_N_N,
+ OP_IF_IS_TYPE_S_P, OP_IF_IS_TYPE_S_P_P, OP_IF_IS_TYPE_S_R, OP_IF_IS_TYPE_S_N, OP_IF_IS_TYPE_S_N_N,
+ OP_IF_IS_TYPE_opSq_P, OP_IF_IS_TYPE_opSq_P_P, OP_IF_IS_TYPE_opSq_R, OP_IF_IS_TYPE_opSq_N, OP_IF_IS_TYPE_opSq_N_N,
OP_IF_A_P, OP_IF_A_P_P, OP_IF_A_R, OP_IF_A_N, OP_IF_A_N_N,
OP_IF_AND2_P, OP_IF_AND2_P_P, OP_IF_AND2_R, OP_IF_AND2_N, OP_IF_AND2_N_N,
+ OP_IF_AND3_P, OP_IF_AND3_P_P, OP_IF_AND3_R, OP_IF_AND3_N, OP_IF_AND3_N_N,
OP_IF_Z_P, OP_IF_Z_P_P, OP_IF_Z_R, OP_IF_Z_N, OP_IF_Z_N_N,
OP_IF_P_P, OP_IF_P_P_P, OP_IF_P_R, OP_IF_P_N, OP_IF_P_N_N,
OP_IF_ANDP_P, OP_IF_ANDP_P_P, OP_IF_ANDP_R, OP_IF_ANDP_N, OP_IF_ANDP_N_N,
@@ -3060,20 +3068,18 @@ enum {OP_NO_OP, OP_GC_PROTECT,
OP_SIMPLE_DO, OP_SIMPLE_DO_STEP, OP_SAFE_DOTIMES, OP_SAFE_DOTIMES_STEP, OP_SAFE_DOTIMES_STEP_P, OP_SAFE_DOTIMES_STEP_O,
OP_SAFE_DO, OP_SAFE_DO_STEP, OP_DOX, OP_DOX_STEP, OP_DOX_STEP_P,
OP_DOTIMES_P, OP_DOTIMES_STEP_P,
-
OP_DO_NO_VARS, OP_DO_NO_VARS_NO_OPT, OP_DO_NO_VARS_NO_OPT_1,
OP_DOTIMES_ONE_STEP,
- OP_SAFE_C_P_1, OP_SAFE_C_PP_1, OP_SAFE_C_PP_2, OP_SAFE_C_PP_3, OP_SAFE_C_PP_4, OP_SAFE_C_PP_5, OP_SAFE_C_PP_6,
- OP_EVAL_ARGS_P_2, OP_EVAL_ARGS_P_2_MV, OP_EVAL_ARGS_P_3, OP_EVAL_ARGS_P_4, OP_EVAL_ARGS_P_3_MV, OP_EVAL_ARGS_P_4_MV,
- OP_EVAL_ARGS_SSP_1, OP_EVAL_ARGS_SSP_MV, OP_EVAL_MACRO_MV, OP_MACROEXPAND_1, OP_APPLY_LAMBDA,
+ OP_SAFE_C_P_1, OP_SAFE_C_PP_1, OP_SAFE_C_PP_3, OP_SAFE_C_PP_5, OP_SAFE_C_PP_6,
+ OP_EVAL_ARGS_P_2, OP_EVAL_ARGS_P_2_MV, OP_EVAL_ARGS_P_3, OP_EVAL_ARGS_P_4, OP_EVAL_ARGS_P_3_MV,
+ OP_EVAL_ARGS_AAP_1, OP_EVAL_ARGS_AAP_MV, OP_EVAL_MACRO_MV, OP_MACROEXPAND_1, OP_APPLY_LAMBDA,
OP_SAFE_CLOSURE_P_1, OP_CLOSURE_P_1, OP_SAFE_CLOSURE_AP_1, OP_SAFE_CLOSURE_PA_1,
-
- OP_SAFE_C_ZZ_1, OP_SAFE_C_ZZ_2, OP_SAFE_C_ZC_1, OP_SAFE_C_SZ_1, OP_SAFE_C_ZA_1, OP_INCREMENT_SZ_1, OP_SAFE_C_SZ_SZ,
- OP_SAFE_C_ZAA_1, OP_SAFE_C_AZA_1, OP_SAFE_C_AAZ_1, OP_SAFE_C_SSZ_1,
- OP_SAFE_C_ZZA_1, OP_SAFE_C_ZZA_2, OP_SAFE_C_ZAZ_1, OP_SAFE_C_ZAZ_2, OP_SAFE_C_AZZ_1, OP_SAFE_C_AZZ_2,
- OP_SAFE_C_ZZZ_1, OP_SAFE_C_ZZZ_2, OP_SAFE_C_ZZZ_3,
- OP_SAFE_C_opSq_P_1, OP_SAFE_C_opSq_P_MV, OP_C_P_1, OP_C_P_2, OP_C_AP_1, OP_C_AP_2, OP_NOT_P_1,
+ OP_SAFE_C_ZZ_1, OP_SAFE_C_ZA_1, OP_INCREMENT_SZ_1, OP_SAFE_C_SZ_SZ,
+ OP_SAFE_C_ZAA_1, OP_SAFE_C_AZA_1, OP_SAFE_C_AAZ_1,
+ OP_SAFE_C_ZZA_1, OP_SAFE_C_ZZA_2, OP_SAFE_C_ZAZ_1, OP_SAFE_C_AZZ_1, OP_SAFE_C_AZZ_2,
+ OP_SAFE_C_ZZZ_1, OP_SAFE_C_ZZZ_2,
+ OP_C_P_1, OP_C_P_2, OP_C_AP_1, OP_NOT_P_1,
OP_CLOSURE_AP_1, OP_CLOSURE_PA_1,
OP_CLOSURE_P_MV, OP_CLOSURE_AP_MV, OP_CLOSURE_PA_MV,
@@ -3135,7 +3141,7 @@ enum {OP_SAFE_C_C, HOP_SAFE_C_C,
OP_SAFE_C_CZ, HOP_SAFE_C_CZ, OP_SAFE_C_ZC, HOP_SAFE_C_ZC, OP_SAFE_C_ZQ, HOP_SAFE_C_ZQ,
OP_SAFE_C_opCq_Z, HOP_SAFE_C_opCq_Z, OP_SAFE_C_S_opSZq, HOP_SAFE_C_S_opSZq,
OP_SAFE_C_AZ, HOP_SAFE_C_AZ, OP_SAFE_C_ZA, HOP_SAFE_C_ZA,
- OP_SAFE_C_ZAA, HOP_SAFE_C_ZAA, OP_SAFE_C_AZA, HOP_SAFE_C_AZA, OP_SAFE_C_AAZ, HOP_SAFE_C_AAZ, OP_SAFE_C_SSZ, HOP_SAFE_C_SSZ,
+ OP_SAFE_C_ZAA, HOP_SAFE_C_ZAA, OP_SAFE_C_AZA, HOP_SAFE_C_AZA, OP_SAFE_C_AAZ, HOP_SAFE_C_AAZ,
OP_SAFE_C_ZZA, HOP_SAFE_C_ZZA, OP_SAFE_C_ZAZ, HOP_SAFE_C_ZAZ, OP_SAFE_C_AZZ, HOP_SAFE_C_AZZ,
OP_SAFE_C_ZZZ, HOP_SAFE_C_ZZZ,
@@ -3157,7 +3163,8 @@ enum {OP_SAFE_C_C, HOP_SAFE_C_C,
OP_SAFE_CLOSURE_S, HOP_SAFE_CLOSURE_S,
OP_SAFE_CLOSURE_C, HOP_SAFE_CLOSURE_C, OP_SAFE_CLOSURE_P, HOP_SAFE_CLOSURE_P,
- OP_SAFE_CLOSURE_SS, HOP_SAFE_CLOSURE_SS, OP_SAFE_CLOSURE_SC, HOP_SAFE_CLOSURE_SC, OP_SAFE_CLOSURE_CS, HOP_SAFE_CLOSURE_CS,
+ OP_SAFE_CLOSURE_SS, HOP_SAFE_CLOSURE_SS, OP_SAFE_CLOSURE_SS_B, HOP_SAFE_CLOSURE_SS_B,
+ OP_SAFE_CLOSURE_SC, HOP_SAFE_CLOSURE_SC, OP_SAFE_CLOSURE_CS, HOP_SAFE_CLOSURE_CS,
OP_SAFE_CLOSURE_A, HOP_SAFE_CLOSURE_A, OP_SAFE_LCLOSURE_A, HOP_SAFE_LCLOSURE_A, OP_SAFE_LCLOSURE_A_P, HOP_SAFE_LCLOSURE_A_P,
OP_SAFE_CLOSURE_SA, HOP_SAFE_CLOSURE_SA,
OP_SAFE_CLOSURE_S_P, HOP_SAFE_CLOSURE_S_P, OP_SAFE_LCLOSURE_L_P, HOP_SAFE_LCLOSURE_L_P,
@@ -3176,7 +3183,7 @@ enum {OP_SAFE_C_C, HOP_SAFE_C_C,
OP_C_S_opSq, HOP_C_S_opSq, OP_C_S_opCq, HOP_C_S_opCq, OP_C_SS, HOP_C_SS,
OP_C_S, HOP_C_S, OP_READ_S, HOP_READ_S, OP_C_P, HOP_C_P, OP_C_Z, HOP_C_Z, OP_C_AP, HOP_C_AP, OP_NOT_P, HOP_NOT_P,
OP_C_A, HOP_C_A, OP_C_SCS, HOP_C_SCS,
- OP_C_FA, HOP_C_FA, OP_C_AA, HOP_C_AA,
+ OP_C_FA, HOP_C_FA, OP_C_AA, HOP_C_AA, OP_C_FA_1, HOP_C_FA_1,
OP_GOTO, HOP_GOTO, OP_GOTO_C, HOP_GOTO_C, OP_GOTO_S, HOP_GOTO_S, OP_GOTO_A, HOP_GOTO_A,
OP_ITERATE, HOP_ITERATE,
@@ -3193,7 +3200,7 @@ enum {OP_SAFE_C_C, HOP_SAFE_C_C,
OP_SAFE_C_opSq_P, HOP_SAFE_C_opSq_P,
OP_SAFE_C_SP, HOP_SAFE_C_SP, OP_SAFE_C_CP, HOP_SAFE_C_CP, OP_SAFE_C_QP, HOP_SAFE_C_QP, OP_SAFE_C_AP, HOP_SAFE_C_AP,
OP_SAFE_C_PS, HOP_SAFE_C_PS, OP_SAFE_C_PC, HOP_SAFE_C_PC, OP_SAFE_C_PQ, HOP_SAFE_C_PQ,
- OP_SAFE_C_SSP, HOP_SAFE_C_SSP,
+ OP_SAFE_C_AAP, HOP_SAFE_C_AAP,
OP_S, HOP_S, OP_S_S, HOP_S_S, OP_S_C, HOP_S_C, OP_S_A, HOP_S_A,
OPT_MAX_DEFINED
@@ -3206,7 +3213,7 @@ static const char *op_names[OP_MAX_DEFINED_1] = {
"read_internal", "eval",
"eval_args", "eval_args1", "eval_args2", "eval_args3", "eval_args4", "eval_args5",
"apply", "eval_macro", "lambda", "quote", "macroexpand",
- "define", "define1", "begin", "begin_unchecked", "begin1",
+ "define", "define1", "begin", "begin1",
"if", "if1", "when", "when1", "unless", "unless1", "set", "set1", "set2",
"let", "let1", "let*", "let*1", "let*2",
"letrec", "letrec1", "letrec*", "letrec*1",
@@ -3225,7 +3232,8 @@ static const char *op_names[OP_MAX_DEFINED_1] = {
"with_let", "with_let1", "with_let_unchecked", "with_let_s",
"with_baffle", "with_baffle_unchecked", "expansion",
"for_each", "for_each_1", "for_each_2", "for_each_3",
- "map", "map_1", "map_gather", "map_gather_1", "barrier", "deactivate_goto",
+ "map", "map_1", "map_2", "map_gather", "map_gather_1", "map_gather_2", "map_gather_3",
+ "barrier", "deactivate_goto",
"define_bacro", "define_bacro*",
"get_output_string", "get_output_string_1",
@@ -3269,13 +3277,13 @@ static const char *op_names[OP_MAX_DEFINED_1] = {
"if_csq_p", "if_csq_p_p", "if_csq_r", "if_csq_n", "if_csq_n_n",
"if_css_p", "if_css_p_p", "if_css_r","if_css_n", "if_css_n_n",
"if_csc_p", "if_csc_p_p", "if_csc_r", "if_csc_n", "if_csc_n_n",
- "if_is_pair_p", "if_is_pair_p_p", "if_is_pair_r", "if_is_pair_n", "if_is_pair_n_n",
- "if_is_null_p", "if_is_null_p_p", "if_is_null_r", "if_is_null_n", "if_is_null_n_n",
"if_opsq_p", "if_opsq_p_p", "if_opsq_r", "if_opsq_n", "if_opsq_n_n",
"if_s_opcq_p", "if_s_opcq_p_p", "if_s_opcq_r","if_s_opcq_n", "if_s_opcq_n_n",
- "if_is_symbol_p", "if_is_symbol_p_p", "if_is_symbol_r", "if_is_symbol_n", "if_is_symbol_n_n",
+ "if_is_type_s_p", "if_is_type_s_p_p", "if_is_type_s_r", "if_is_type_s_n", "if_is_type_s_n_n",
+ "if_is_type_opsq_p", "if_is_type_opsq_p_p", "if_is_type_opsq_r", "if_is_type_opsq_n", "if_is_type_opsq_n_n",
"if_a_p", "if_a_p_p", "if_a_r", "if_a_n", "if_a_n_n",
"if_and2_p", "if_and2_p_p", "if_and2_r","if_and2_n", "if_and2_n_n",
+ "if_and3_p", "if_and3_p_p", "if_and3_r","if_and3_n", "if_and3_n_n",
"if_z_p", "if_z_p_p", "if_z_r", "if_z_n", "if_z_n_n",
"if_p_p", "if_p_p_p", "if_p_r", "if_p_n", "if_p_n_n",
"if_andp_p", "if_andp_p_p", "if_andp_r", "if_andp_n", "if_andp_n_n",
@@ -3289,21 +3297,18 @@ static const char *op_names[OP_MAX_DEFINED_1] = {
"simple_do", "simple_do_step", "safe_dotimes", "safe_dotimes_step", "safe_dotimes_step_p", "safe_dotimes_step_o",
"safe_do", "safe_do_step", "dox", "dox_step", "dox_step_p",
"dotimes_p", "dotimes_step_p",
-
"do_no_vars", "do_no_vars_no_opt", "do_no_vars_no_opt_1",
"dotimes_one_step",
- "safe_c_p_1", "safe_c_pp_1", "safe_c_pp_2", "safe_c_pp_3", "safe_c_pp_4", "safe_c_pp_5", "safe_c_pp_6",
- "eval_args_p_2", "eval_args_p_2_mv", "eval_args_p_3", "eval_args_p_4", "eval_args_p_3_mv", "eval_args_p_4_mv",
- "eval_args_ssp_1", "eval_args_ssp_mv", "eval_macro_mv", "macroexpand_1", "apply_lambda",
+ "safe_c_p_1", "safe_c_pp_1", "safe_c_pp_3", "safe_c_pp_5", "safe_c_pp_6",
+ "eval_args_p_2", "eval_args_p_2_mv", "eval_args_p_3", "eval_args_p_4", "eval_args_p_3_mv",
+ "eval_args_aap_1", "eval_args_aap_mv", "eval_macro_mv", "macroexpand_1", "apply_lambda",
"safe_closure_p_1", "closure_p_1", "safe_closure_ap_1", "safe_closure_pa_1",
-
- "safe_c_zz_1", "safe_c_zz_2", "safe_c_zc_1", "safe_c_sz_1", "safe_c_za_1", "increment_sz_1", "safe_c_sz_sz",
- "safe_c_zaa_1", "safe_c_aza_1", "safe_c_aaz_1", "safe_c_ssz_1",
- "safe_c_zza_1", "safe_c_zza_2", "safe_c_zaz_1", "safe_c_zaz_2", "safe_c_azz_1", "safe_c_azz_2",
- "safe_c_zzz_1", "safe_c_zzz_2", "safe_c_zzz_3",
-
- "safe_c_opsq_p_1", "safe_c_opsq_p_mv", "c_p_1", "c_p_2", "c_ap_1", "c_ap_2", "not_1",
+ "safe_c_zz_1", "safe_c_za_1", "increment_sz_1", "safe_c_sz_sz",
+ "safe_c_zaa_1", "safe_c_aza_1", "safe_c_aaz_1",
+ "safe_c_zza_1", "safe_c_zza_2", "safe_c_zaz_1", "safe_c_azz_1", "safe_c_azz_2",
+ "safe_c_zzz_1", "safe_c_zzz_2",
+ "c_p_1", "c_p_2", "c_ap_1", "not_1",
"closure_ap_1", "closure_pa_1",
"closure_p_mv", "closure_ap_mv", "closure_pa_mv",
@@ -3362,7 +3367,7 @@ static const char* opt_names[OPT_MAX_DEFINED] =
"safe_c_cz", "h_safe_c_cz", "safe_c_zc", "h_safe_c_zc", "safe_c_zq", "h_safe_c_zq",
"safe_c_opcq_z", "h_safe_c_opcq_z", "safe_c_s_opszq", "h_safe_c_s_opszq",
"safe_c_az", "h_safe_c_az", "safe_c_za", "h_safe_c_za",
- "safe_c_zaa", "h_safe_c_zaa", "safe_c_aza", "h_safe_c_aza", "safe_c_aaz", "h_safe_c_aaz", "safe_c_ssz", "h_safe_c_ssz",
+ "safe_c_zaa", "h_safe_c_zaa", "safe_c_aza", "h_safe_c_aza", "safe_c_aaz", "h_safe_c_aaz",
"safe_c_zza", "h_safe_c_zza", "safe_c_zaz", "h_safe_c_zaz", "safe_c_azz", "h_safe_c_azz",
"safe_c_zzz", "h_safe_c_zzz",
@@ -3383,7 +3388,8 @@ static const char* opt_names[OPT_MAX_DEFINED] =
"safe_thunk_p", "h_safe_thunk_p", "safe_lthunk", "h_safe_lthunk",
"safe_closure_s", "h_safe_closure_s",
"safe_closure_c", "h_safe_closure_c", "safe_closure_p", "h_safe_closure_p",
- "safe_closure_ss", "h_safe_closure_ss", "safe_closure_sc", "h_safe_closure_sc", "safe_closure_cs", "h_safe_closure_cs",
+ "safe_closure_ss", "h_safe_closure_ss", "safe_closure_ss_b", "h_safe_closure_ss_b",
+ "safe_closure_sc", "h_safe_closure_sc", "safe_closure_cs", "h_safe_closure_cs",
"safe_closure_a", "h_safe_closure_a", "safe_lclosure_a", "h_safe_lclosure_a", "safe_lclosure_a_p", "h_safe_lclosure_a_p",
"safe_closure_sa", "h_safe_closure_sa",
"safe_closure_s_p", "h_safe_closure_s_p", "safe_lclosure_l_p", "h_safe_lclosure_l_p",
@@ -3401,7 +3407,7 @@ static const char* opt_names[OPT_MAX_DEFINED] =
"c_s_opsq", "h_c_s_opsq", "c_s_opcq", "h_c_s_opcq", "c_ss", "h_c_ss",
"c_s", "h_c_s", "read_s", "h_read_s", "c_p", "h_c_p", "c_z", "h_c_z", "c_ap", "h_c_ap", "c_not", "h_c_not",
"c_a", "h_c_a", "c_scs", "h_c_scs",
- "c_fa", "h_c_fa", "c_aa", "h_c_aa",
+ "c_fa", "h_c_fa", "c_aa", "h_c_aa", "c_fa_1", "h_c_fa_1",
"goto", "h_goto", "goto_c", "h_goto_c", "goto_s", "h_goto_s", "goto_a", "h_goto_a",
"iterate", "h_iterate",
@@ -3418,13 +3424,13 @@ static const char* opt_names[OPT_MAX_DEFINED] =
"safe_c_opsq_p", "h_safe_c_opsq_p",
"safe_c_sp", "h_safe_c_sp", "safe_c_cp", "h_safe_c_cp", "safe_c_qp", "h_safe_c_qp", "safe_c_ap", "h_safe_c_ap",
"safe_c_ps", "h_safe_c_ps", "safe_c_pc", "h_safe_c_pc", "safe_c_pq", "h_safe_c_pq",
- "safe_c_ssp", "h_safe_c_ssp",
+ "safe_c_aap", "h_safe_c_aap",
"s", "h_s", "s_s", "h_s_s", "s_c", "h_s_c", "s_a", "h_s_a",
};
#endif
-#define in_reader(Sc) ((Sc->op >= OP_READ_LIST) && (Sc->op <= OP_READ_DONE) && (is_input_port(Sc->input_port)))
+#define in_reader(Sc) ((sc->cur_op >= OP_READ_LIST) && (sc->cur_op <= OP_READ_DONE) && (is_input_port(Sc->input_port)))
#define is_safe_c_op(op) (op < OP_THUNK)
#define is_unknown_op(op) ((op >= OP_UNKNOWN) && (op < OP_SAFE_C_PP))
@@ -3466,6 +3472,8 @@ s7_pointer s7_method(s7_scheme *sc, s7_pointer obj, s7_pointer method)
return(s7_apply_function(Sc, func, Args)); \
}
+#define apply_known_method(Sc, Let, Method, Args) return(s7_apply_function(Sc, find_method(Sc, Let, Method), Args))
+
#define check_two_methods(Sc, Obj, Method1, Method2, Args) \
if (has_methods(Obj)) \
{ \
@@ -3926,9 +3934,9 @@ static void init_string_free_lists(s7_scheme *sc)
{
int32_t i;
sc->string_lists = (char ***)calloc(STRING_LISTS, sizeof(char **));
- sc->string_locs = (int32_t *)calloc(STRING_LISTS, sizeof(int));
- sc->string_sizes = (int32_t *)malloc(STRING_LISTS * sizeof(int));
- sc->string_max_sizes = (int32_t *)malloc(STRING_LISTS * sizeof(int));
+ sc->string_locs = (int32_t *)calloc(STRING_LISTS, sizeof(int32_t));
+ sc->string_sizes = (int32_t *)malloc(STRING_LISTS * sizeof(int32_t));
+ sc->string_max_sizes = (int32_t *)malloc(STRING_LISTS * sizeof(int32_t));
for (i = 0; i < STRING_LISTS; i++)
{
sc->string_lists[i] = (char **)calloc(STRING_LIST_INIT_SIZE, sizeof(char *));
@@ -4050,7 +4058,7 @@ static void sweep(s7_scheme *sc)
{
s1 = gp->list[i];
if (is_free_and_clear(s1))
- free_object(s1);
+ (*(c_object_free(sc, s1)))(c_object_value(s1));
else gp->list[j++] = s1;
}
gp->loc = j;
@@ -4664,7 +4672,7 @@ static void mark_rootlet(s7_scheme *sc)
S7_MARK(slot_value(*tmp++));
}
-void s7_mark_object(s7_pointer p)
+void s7_mark_c_object(s7_pointer p)
{
S7_MARK(p);
}
@@ -4838,8 +4846,8 @@ static int32_t gc(s7_scheme *sc)
if (sc->fdats[i])
S7_MARK(sc->fdats[i]->curly_arg);
}
- S7_MARK(sc->protected_objects);
- S7_MARK(sc->protected_accessors);
+ mark_vector(sc->protected_objects);
+ mark_vector(sc->protected_accessors);
/* now protect recent allocations using the free_heap cells above the current free_heap_top (if any).
*
@@ -4944,7 +4952,7 @@ static int32_t gc(s7_scheme *sc)
}
unmark_permanent_objects(sc);
- sc->gc_freed = (int)(sc->free_heap_top - old_free_heap_top);
+ sc->gc_freed = (int64_t)(sc->free_heap_top - old_free_heap_top);
if (show_gc_stats(sc))
{
@@ -4953,7 +4961,7 @@ static int32_t gc(s7_scheme *sc)
double secs;
gettimeofday(&t0, &z0);
secs = (t0.tv_sec - start_time.tv_sec) + 0.000001 * (t0.tv_usec - start_time.tv_usec);
- fprintf(stdout, "freed %" PRId64 "/%" PRId64 " (free: " PD_U "), time: %f\n", sc->gc_freed, sc->heap_size, (ptr_int)(sc->free_heap_top - sc->free_heap), secs);
+ fprintf(stdout, "freed %" PRId64 "/%" PRId64 " (free: %" PRIdPTR "), time: %f\n", sc->gc_freed, sc->heap_size, (intptr_t)(sc->free_heap_top - sc->free_heap), secs);
#else
fprintf(stdout, "freed %" PRId64 "/%" PRId64 "\n", sc->gc_freed, sc->heap_size);
#endif
@@ -5028,7 +5036,7 @@ static bool for_any_other_reason(s7_scheme *sc, int32_t line)
#endif
-static void resize_heap_to(s7_scheme *sc, uint32_t size)
+static void resize_heap_to(s7_scheme *sc, int64_t size)
{
/* alloc more heap */
int64_t old_size, old_free, k;
@@ -5200,12 +5208,12 @@ static void free_vlist(s7_scheme *sc, s7_pointer lst)
if (is_pair(lst))
{
s7_pointer p, np;
- for (p = lst, np = cdr(lst); is_pair(p); p = np, np = cdr(np))
+ for (p = lst, np = cdr(lst); is_pair(p); p = np, np = unchecked_cdr(np))
free_cell(sc, p);
}
}
-static inline s7_pointer petrify(s7_scheme *sc, s7_pointer x, int32_t loc)
+static inline s7_pointer petrify(s7_scheme *sc, s7_pointer x, int64_t loc)
{
s7_pointer p;
p = alloc_pointer();
@@ -5218,7 +5226,7 @@ static inline s7_pointer petrify(s7_scheme *sc, s7_pointer x, int32_t loc)
static void s7_remove_from_heap(s7_scheme *sc, s7_pointer x)
{
- int32_t loc;
+ int64_t loc;
/* global functions are very rarely redefined, so we can remove the function body from
* the heap when it is defined. If redefined, we currently lose the memory held by the
* old definition. (It is not trivial to recover this memory because it is allocated
@@ -5374,7 +5382,7 @@ static void initialize_op_stack(s7_scheme *sc)
static void resize_op_stack(s7_scheme *sc)
{
int32_t i, loc, new_size;
- loc = (int)(sc->op_stack_now - sc->op_stack);
+ loc = (int32_t)(sc->op_stack_now - sc->op_stack);
new_size = sc->op_stack_size * 2;
sc->op_stack = (s7_pointer *)realloc((void *)(sc->op_stack), new_size * sizeof(s7_pointer));
for (i = sc->op_stack_size; i < new_size; i++)
@@ -5406,10 +5414,10 @@ static void pop_stack(s7_scheme *sc)
sc->code = _NFre(sc->stack_end[0]);
sc->envir = _TLid(sc->stack_end[1]);
sc->args = _NFre(sc->stack_end[2]);
- sc->op = (opcode_t)(sc->stack_end[3]);
- if (sc->op > OP_MAX_DEFINED)
+ sc->cur_op = (opcode_t)(sc->stack_end[3]);
+ if (sc->cur_op > OP_MAX_DEFINED)
{
- fprintf(stderr, "%spop_stack[%d] invalid opcode: " INT_FORMAT "%s\n", BOLD_TEXT, __LINE__, sc->op, UNBOLD_TEXT);
+ fprintf(stderr, "%spop_stack[%d] invalid opcode: %" PRIdPTR " %s\n", BOLD_TEXT, __LINE__, sc->cur_op, UNBOLD_TEXT);
if (stop_at_error) abort();
}
}
@@ -5436,7 +5444,7 @@ static void push_stack(s7_scheme *sc, opcode_t op, s7_pointer args, s7_pointer c
}
if (op > OP_MAX_DEFINED)
{
- fprintf(stderr, "%spush_stack[%d] invalid opcode: " INT_FORMAT "%s\n", BOLD_TEXT, __LINE__, sc->op, UNBOLD_TEXT);
+ fprintf(stderr, "%spush_stack[%d] invalid opcode: %" PRIdPTR " %s\n", BOLD_TEXT, __LINE__, sc->cur_op, UNBOLD_TEXT);
if (stop_at_error) abort();
}
if (code) sc->stack_end[0] = _NFre(code);
@@ -5446,15 +5454,18 @@ static void push_stack(s7_scheme *sc, opcode_t op, s7_pointer args, s7_pointer c
sc->stack_end += 4;
}
-#define push_stack_no_code(Sc, Op, Args) push_stack(Sc, Op, Args, Sc->gc_nil)
+#define push_stack_no_let_no_code(Sc, Op, Args) push_stack(Sc, Op, Args, Sc->gc_nil)
#define push_stack_no_args(Sc, Op, Code) push_stack(Sc, Op, Sc->gc_nil, Code)
-/* in the non-debugging case, the sc->F's here are not set, so we can (later) pop free cells */
+#define push_stack_no_let(Sc, Op, Args, Code) push_stack(Sc, Op, Args, Code)
+#define push_stack_op(Sc, Op) push_stack(Sc, Op, Sc->gc_nil, Sc->gc_nil)
+#define push_stack_op_let(Sc, Op) push_stack(Sc, Op, Sc->gc_nil, Sc->gc_nil)
+/* in the non-debugging case, the sc->gc_nil's here are not set, so we can (later) pop free cells */
#else
/* these macros are faster than the equivalent simple function calls. If the s7_scheme struct is set up to reflect the
* stack order [code envir args op], we can use memcpy here:
* #define pop_stack(Sc) do {Sc->stack_end -= 4; memcpy((void *)Sc, (void *)(Sc->stack_end), 4 * sizeof(s7_pointer));} while (0)
- * but it is only slightly faster (.2% at best)!
+ * but it is not any faster (nor are other similar explicit cases)
*/
#define pop_stack(Sc) \
@@ -5463,7 +5474,7 @@ static void push_stack(s7_scheme *sc, opcode_t op, s7_pointer args, s7_pointer c
Sc->code = Sc->stack_end[0]; \
Sc->envir = Sc->stack_end[1]; \
Sc->args = Sc->stack_end[2]; \
- Sc->op = (opcode_t)(Sc->stack_end[3]); \
+ sc->cur_op = (opcode_t)(Sc->stack_end[3]); \
} while (0)
#define pop_stack_no_op(Sc) \
@@ -5483,7 +5494,7 @@ static void push_stack(s7_scheme *sc, opcode_t op, s7_pointer args, s7_pointer c
Sc->stack_end += 4; \
} while (0)
-#define push_stack_no_code(Sc, Op, Args) \
+#define push_stack_no_let_no_code(Sc, Op, Args) \
do { \
Sc->stack_end[2] = Args; \
Sc->stack_end[3] = (s7_pointer)Op; \
@@ -5497,6 +5508,25 @@ static void push_stack(s7_scheme *sc, opcode_t op, s7_pointer args, s7_pointer c
Sc->stack_end[3] = (s7_pointer)Op; \
Sc->stack_end += 4; \
} while (0)
+#define push_stack_no_let(Sc, Op, Args, Code) \
+ do { \
+ Sc->stack_end[0] = Code; \
+ Sc->stack_end[2] = Args; \
+ Sc->stack_end[3] = (s7_pointer)Op; \
+ Sc->stack_end += 4; \
+ } while (0)
+#define push_stack_op(Sc, Op) \
+ do { \
+ Sc->stack_end[3] = (s7_pointer)Op; \
+ Sc->stack_end += 4; \
+ } while (0)
+#define push_stack_op_let(Sc, Op) \
+ do { \
+ Sc->stack_end[1] = Sc->envir; \
+ Sc->stack_end[3] = (s7_pointer)Op; \
+ Sc->stack_end += 4; \
+ } while (0)
+
#endif
/* since we don't GC mark the stack past the stack_top, push_stack_no_args and friends can cause pop_stack to set
* sc->code and sc->args to currently free objects.
@@ -5517,8 +5547,8 @@ static void push_stack(s7_scheme *sc, opcode_t op, s7_pointer args, s7_pointer c
static void stack_reset(s7_scheme *sc)
{
sc->stack_end = sc->stack_start;
- push_stack(sc, OP_EVAL_DONE, sc->nil, sc->nil);
- push_stack(sc, OP_BARRIER, sc->nil, sc->nil);
+ push_stack_op(sc, OP_EVAL_DONE);
+ push_stack_op(sc, OP_BARRIER);
}
@@ -5590,7 +5620,7 @@ static inline uint64_t raw_string_hash(const unsigned char *key, uint32_t len)
}
-static s7_pointer make_symbol_with_length(s7_scheme *sc, const char *name, uint32_t len);
+static inline s7_pointer make_symbol_with_length(s7_scheme *sc, const char *name, uint32_t len);
static s7_pointer new_symbol(s7_scheme *sc, const char *name, uint32_t len, uint64_t hash, uint32_t location)
{
@@ -5625,6 +5655,7 @@ static s7_pointer new_symbol(s7_scheme *sc, const char *name, uint32_t len, uint
symbol_set_local(x, 0LL, sc->nil);
symbol_set_tag(x, 0);
symbol_set_ctr(x, 0);
+ symbol_type(x) = 0;
if (symbol_name_length(x) > 1) /* not 0, otherwise : is a keyword */
{
@@ -5644,7 +5675,7 @@ static s7_pointer new_symbol(s7_scheme *sc, const char *name, uint32_t len, uint
char *kstr;
uint32_t klen;
klen = symbol_name_length(x) - 1;
- /* can't used tmpbuf_* here (or not safely I think) because name is already using tmpbuf */
+ /* can't use tmpbuf_* here (or not safely I think) because name is already using tmpbuf */
kstr = (char *)malloc((klen + 1) * sizeof(char));
memcpy((void *)kstr, (void *)name, klen);
kstr[klen] = 0;
@@ -5668,7 +5699,7 @@ static s7_pointer new_symbol(s7_scheme *sc, const char *name, uint32_t len, uint
return(x);
}
-static s7_pointer make_symbol_with_length(s7_scheme *sc, const char *name, uint32_t len)
+static inline s7_pointer make_symbol_with_length(s7_scheme *sc, const char *name, uint32_t len)
{
s7_pointer x;
uint64_t hash;
@@ -6323,6 +6354,10 @@ static s7_pointer find_let(s7_scheme *sc, s7_pointer obj)
case T_C_OBJECT:
return(c_object_let(obj));
+
+ case T_C_POINTER:
+ if (is_let(raw_pointer_info(obj)))
+ return(raw_pointer_info(obj));
}
return(sc->nil);
}
@@ -6399,7 +6434,7 @@ static int32_t let_length(s7_scheme *sc, s7_pointer e)
{
p = s7_apply_function(sc, length_func, list_1(sc, e));
if (s7_is_integer(p))
- return((int)s7_integer(p));
+ return((int32_t)s7_integer(p));
return(-1); /* ?? */
}
}
@@ -6512,7 +6547,7 @@ static void remove_function_from_heap(s7_scheme *sc, s7_pointer value)
s7_pointer s7_make_slot(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value)
{
if ((!is_let(env)) ||
- (env == sc->rootlet)) /* TODO: what about shadow-rootlet for repl? */
+ (env == sc->rootlet))
{
s7_pointer ge, slot;
if ((sc->safety == NO_SAFETY) &&
@@ -6723,7 +6758,8 @@ static s7_pointer g_openlet(s7_scheme *sc, s7_pointer args)
if ((is_let(e)) ||
(has_closure_let(e)) ||
- ((is_c_object(e)) && (c_object_let(e) != sc->nil)))
+ ((is_c_object(e)) && (c_object_let(e) != sc->nil)) ||
+ ((is_c_pointer(e)) && (is_let(raw_pointer_info(e)))))
{
set_has_methods(e);
return(e);
@@ -6745,13 +6781,14 @@ static s7_pointer g_coverlet(s7_scheme *sc, s7_pointer args)
e = car(args);
sc->temp3 = e;
check_method(sc, e, sc->coverlet_symbol, list_1(sc, e));
-
+ sc->temp3 = sc->nil;
if (e == sc->rootlet)
s7_error(sc, sc->error_symbol, set_elist_1(sc, s7_make_string(sc, "can't coverlet rootlet")));
if ((is_let(e)) ||
(has_closure_let(e)) ||
- ((is_c_object(e)) && (c_object_let(e) != sc->nil)))
+ ((is_c_object(e)) && (c_object_let(e) != sc->nil)) ||
+ ((is_c_pointer(e)) && (is_let(raw_pointer_info(e)))))
{
clear_has_methods(e);
return(e);
@@ -6825,9 +6862,11 @@ static s7_pointer g_varlet(s7_scheme *sc, s7_pointer args)
{
#define H_varlet "(varlet env ...) adds its arguments (an environment, a cons: symbol . value, or a pair of arguments, the symbol and its value) \
to the environment env, and returns the environment."
- #define Q_varlet s7_make_circular_signature(sc, 2, 3, sc->is_let_symbol, sc->is_let_symbol, sc->T)
+ #define Q_varlet s7_make_circular_signature(sc, 2, 4, sc->is_let_symbol, \
+ s7_make_signature(sc, 2, sc->is_let_symbol, sc->is_null_symbol), \
+ s7_make_signature(sc, 3, sc->is_pair_symbol, sc->is_symbol_symbol, sc->is_let_symbol), \
+ sc->T)
/* varlet = with-let + define */
-
s7_pointer x, e, sym, val, p;
e = car(args);
@@ -7052,8 +7091,7 @@ static s7_pointer g_sublet(s7_scheme *sc, s7_pointer args)
#define H_sublet "(sublet env ...) adds its \
arguments (each an environment or a cons: symbol . value) to the environment env, and returns the \
new environment."
- #define Q_sublet s7_make_circular_signature(sc, 2, 3, sc->is_let_symbol, s7_make_signature(sc, 2, sc->is_let_symbol, sc->is_null_symbol), sc->T)
-
+ #define Q_sublet Q_varlet
s7_pointer e;
e = car(args);
@@ -7211,6 +7249,11 @@ static s7_pointer g_let_to_list(s7_scheme *sc, s7_pointer args)
{
if (is_c_object(env))
env = c_object_let(env);
+ else
+ {
+ if (is_c_pointer(env))
+ env = raw_pointer_info(env);
+ }
if (!is_let(env))
return(simple_wrong_type_argument_with_type(sc, sc->let_to_list_symbol, env, a_let_string));
}
@@ -7268,15 +7311,19 @@ static s7_pointer g_let_ref(s7_scheme *sc, s7_pointer args)
* versus keys), and we can't just try again here because that makes it too easy to
* get into infinite recursion. So, 'let-ref-fallback...
*/
- if (has_ref_fallback(env))
- check_method(sc, env, sc->let_ref_fallback_symbol, args);
- /* why did this ignore a global value? Changed 24-May-16 to check rootlet if no methods --
- * apparently I was using #<undefined> here (pre-rootlet-check) to indicate that an
- * open let did not have a particular method (locally). This seems inconsistent now,
- * but it was far worse before. At least (let () ((curlet) 'pi)) is pi!
- */
- if (!has_methods(env))
+ if (has_methods(env))
+ {
+ if (has_ref_fallback(env))
+ apply_known_method(sc, env, sc->let_ref_fallback_symbol, args);
+
+ /* why did this ignore a global value? Changed 24-May-16 to check rootlet if no methods --
+ * apparently I was using #<undefined> here (pre-rootlet-check) to indicate that an
+ * open let did not have a particular method (locally). This seems inconsistent now,
+ * but it was far worse before. At least (let () ((curlet) 'pi)) is pi!
+ */
+ }
+ else
{
y = global_slot(symbol);
if (is_slot(y))
@@ -7290,21 +7337,17 @@ static s7_pointer g_let_ref(s7_scheme *sc, s7_pointer args)
static s7_pointer lint_let_ref_1(s7_scheme *sc, s7_pointer lt, s7_pointer sym)
{
s7_pointer x, y;
-
- lt = (is_pair(lt)) ? cdr(lt) : g_cdr(sc, set_plist_1(sc, lt));
-
for (x = lt; is_let(x); x = outlet(x))
for (y = let_slots(x); is_slot(y); y = next_slot(y))
if (slot_symbol(y) == sym)
return(slot_value(y));
- if (!is_let(lt))
- return(wrong_type_argument_with_type(sc, sc->let_ref_symbol, 1, lt, a_let_string));
-
- if (has_ref_fallback(lt))
- check_method(sc, lt, sc->let_ref_fallback_symbol, set_plist_2(sc, lt, sym));
-
- if (!has_methods(lt))
+ if (has_methods(lt))
+ {
+ if (has_ref_fallback(lt))
+ apply_known_method(sc, lt, sc->let_ref_fallback_symbol, set_plist_2(sc, lt, sym));
+ }
+ else
{
y = global_slot(sym);
if (is_slot(y))
@@ -7319,13 +7362,45 @@ static s7_pointer let_ref_p_pp(s7_pointer p1, s7_pointer p2) {return(g_let_ref(c
static s7_pointer lint_let_ref;
static s7_pointer g_lint_let_ref(s7_scheme *sc, s7_pointer args)
{
- return(lint_let_ref_1(sc, find_symbol_unchecked(sc, cadar(args)), cadadr(args)));
+ s7_pointer lt;
+ lt = find_symbol_unchecked(sc, opt_sym2(args)); /* cadar */
+ if (is_pair(lt))
+ {
+ lt = cdr(lt);
+ if (is_let(lt))
+ {
+ s7_pointer y, sym;
+ sym = opt_sym3(args); /* cadadr */
+ for (y = let_slots(lt); is_slot(y); y = next_slot(y))
+ if (slot_symbol(y) == sym)
+ return(slot_value(y));
+ return(lint_let_ref_1(sc, outlet(lt), sym));
+ }
+ return(wrong_type_argument_with_type(sc, sc->let_ref_symbol, 1, lt, a_let_string));
+ }
+ return(simple_wrong_type_argument(sc, sc->cdr_symbol, lt, T_PAIR));
}
static s7_pointer local_lint_let_ref;
static s7_pointer g_local_lint_let_ref(s7_scheme *sc, s7_pointer args)
{
- return(lint_let_ref_1(sc, local_symbol_value(cadar(args)), cadadr(args)));
+ s7_pointer lt;
+ lt = local_symbol_value(opt_sym2(args));
+ if (is_pair(lt))
+ {
+ lt = cdr(lt);
+ if (is_let(lt))
+ {
+ s7_pointer y, sym;
+ sym = opt_sym3(args);
+ for (y = let_slots(lt); is_slot(y); y = next_slot(y))
+ if (slot_symbol(y) == sym)
+ return(slot_value(y));
+ return(lint_let_ref_1(sc, outlet(lt), sym));
+ }
+ return(wrong_type_argument_with_type(sc, sc->let_ref_symbol, 1, lt, a_let_string));
+ }
+ return(simple_wrong_type_argument(sc, sc->cdr_symbol, lt, T_PAIR));
}
@@ -7347,6 +7422,8 @@ static s7_pointer let_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_
(!is_immutable_symbol(cadr(arg2))))
{
set_optimize_op(expr, HOP_SAFE_C_C);
+ set_opt_sym2(cdr(expr), cadr(arg1));
+ set_opt_sym3(cdr(expr), cadr(arg2));
if (is_local_symbol(cdr(arg1)))
return(local_lint_let_ref);
return(lint_let_ref);
@@ -7424,10 +7501,12 @@ static s7_pointer let_set_1(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7
return(slot_value(y));
}
- if (has_set_fallback(env))
- check_method(sc, env, sc->let_set_fallback_symbol, sc->w = list_3(sc, env, symbol, value));
-
- if (!has_methods(env))
+ if (has_methods(env))
+ {
+ if (has_set_fallback(env))
+ apply_known_method(sc, env, sc->let_set_fallback_symbol, sc->w = list_3(sc, env, symbol, value));
+ }
+ else
{
y = global_slot(symbol);
if (is_slot(y))
@@ -7454,7 +7533,7 @@ s7_pointer s7_let_set(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_point
{
check_method(sc, env, sc->let_set_symbol, sc->w = list_3(sc, env, symbol, value));
if (has_set_fallback(env))
- check_method(sc, env, sc->let_set_fallback_symbol, sc->w = list_3(sc, env, symbol, value));
+ apply_known_method(sc, env, sc->let_set_fallback_symbol, sc->w = list_3(sc, env, symbol, value));
return(wrong_type_argument_with_type(sc, sc->let_set_symbol, 2, symbol, a_symbol_string));
}
@@ -7506,10 +7585,12 @@ static s7_pointer g_lint_let_set_1(s7_scheme *sc, s7_pointer lt1, s7_pointer sym
return(slot_value(y));
}
- if (has_set_fallback(lt))
- check_method(sc, lt, sc->let_set_fallback_symbol, sc->w = list_3(sc, lt, sym, val));
-
- if (!has_methods(lt))
+ if (has_methods(lt))
+ {
+ if (has_set_fallback(lt))
+ apply_known_method(sc, lt, sc->let_set_fallback_symbol, sc->w = list_3(sc, lt, sym, val));
+ }
+ else
{
y = global_slot(sym);
if (is_slot(y))
@@ -7526,12 +7607,12 @@ static s7_pointer g_lint_let_set_1(s7_scheme *sc, s7_pointer lt1, s7_pointer sym
static s7_pointer g_lint_let_set(s7_scheme *sc, s7_pointer args)
{
- return(g_lint_let_set_1(sc, find_symbol_checked(sc, cadar(args)), cadadr(args), find_symbol_unchecked(sc, caddr(args))));
+ return(g_lint_let_set_1(sc, find_symbol_checked(sc, opt_sym2(args)), opt_sym3(args), find_symbol_unchecked(sc, caddr(args))));
}
static s7_pointer g_local_lint_let_set(s7_scheme *sc, s7_pointer args)
{
- return(g_lint_let_set_1(sc, local_symbol_value(cadar(args)), cadadr(args), local_symbol_value(caddr(args))));
+ return(g_lint_let_set_1(sc, local_symbol_value(opt_sym2(args)), opt_sym3(args), local_symbol_value(caddr(args))));
}
@@ -7556,6 +7637,8 @@ static s7_pointer let_set_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_
(!is_immutable_symbol(arg3)))
{
set_optimize_op(expr, HOP_SAFE_C_C);
+ set_opt_sym2(cdr(expr), cadr(arg1));
+ set_opt_sym3(cdr(expr), cadr(arg2));
if ((is_local_symbol(cdr(arg1))) &&
(is_local_symbol(cdddr(expr))))
return(local_lint_let_set);
@@ -7964,8 +8047,7 @@ static s7_pointer g_symbol_to_dynamic_value(s7_scheme *sc, s7_pointer args)
#define Q_symbol_to_dynamic_value s7_make_signature(sc, 2, sc->T, sc->is_symbol_symbol)
s7_pointer sym, val;
- int64_t top_id;
- int32_t i;
+ int64_t i, top_id;
sym = car(args);
if (!is_symbol(sym))
@@ -8103,28 +8185,28 @@ static void clear_all_optimizations(s7_scheme *sc, s7_pointer p)
}
-static s7_pointer make_macro(s7_scheme *sc)
+static s7_pointer make_macro(s7_scheme *sc, opcode_t op)
{
s7_pointer cx, mac;
- uint32_t typ;
+ uint64_t typ;
- if (sc->op == OP_DEFINE_MACRO)
+ if (op == OP_DEFINE_MACRO)
typ = T_MACRO | T_DONT_EVAL_ARGS | T_COPY_ARGS;
else
{
- if (sc->op == OP_DEFINE_MACRO_STAR)
+ if (op == OP_DEFINE_MACRO_STAR)
typ = T_MACRO_STAR | T_DONT_EVAL_ARGS | T_COPY_ARGS;
else
{
- if (sc->op == OP_DEFINE_BACRO)
+ if (op == OP_DEFINE_BACRO)
typ = T_BACRO | T_DONT_EVAL_ARGS | T_COPY_ARGS;
else
{
- if (sc->op == OP_DEFINE_BACRO_STAR)
+ if (op == OP_DEFINE_BACRO_STAR)
typ = T_BACRO_STAR | T_DONT_EVAL_ARGS | T_COPY_ARGS;
else
{
- if ((sc->op == OP_DEFINE_EXPANSION) &&
+ if ((op == OP_DEFINE_EXPANSION) &&
(!is_let(sc->envir))) /* local expansions are just normal macros */
typ = T_MACRO | T_EXPANSION | T_DONT_EVAL_ARGS | T_COPY_ARGS;
else typ = T_MACRO | T_DONT_EVAL_ARGS | T_COPY_ARGS;
@@ -8143,7 +8225,7 @@ static s7_pointer make_macro(s7_scheme *sc)
sc->capture_let_counter++;
sc->code = caar(sc->code);
- if ((sc->op == OP_DEFINE_EXPANSION) &&
+ if ((op == OP_DEFINE_EXPANSION) &&
(!is_let(sc->envir)))
set_type(sc->code, T_EXPANSION | T_SYMBOL); /* see comment under READ_TOK */
/* symbol? macro name has already been checked, find name in environment, and define it */
@@ -8161,63 +8243,31 @@ static s7_pointer make_macro(s7_scheme *sc)
}
-static s7_pointer make_closure(s7_scheme *sc, s7_pointer args, s7_pointer code, int32_t type)
+static s7_pointer make_closure(s7_scheme *sc, s7_pointer args, s7_pointer code, uint64_t type, int32_t arity)
{
/* this is called every time a lambda form is evaluated, or during letrec, etc */
-
s7_pointer x;
- uint32_t typ;
-
- if (type == T_CLOSURE)
- typ = T_CLOSURE | T_COPY_ARGS;
- else typ = T_CLOSURE_STAR;
- if (is_safe_closure(code))
- typ |= T_SAFE_CLOSURE;
-
- new_cell(sc, x, typ);
+ new_cell(sc, x, type);
closure_set_args(x, args);
closure_set_body(x, code);
closure_set_setter(x, sc->F);
- if (is_null(args))
- closure_arity(x) = 0;
- else closure_arity(x) = CLOSURE_ARITY_NOT_SET;
+ closure_arity(x) = arity;
closure_set_let(x, sc->envir);
sc->capture_let_counter++;
return(x);
}
-
-#define make_closure_with_let(Sc, X, Args, Code, Env) \
+#define make_closure_with_let(Sc, X, Args, Code, Env, Arity) \
do { \
- uint32_t _T_; \
- if (is_safe_closure(Code)) \
- _T_ = T_CLOSURE | T_SAFE_CLOSURE | T_COPY_ARGS; \
- else _T_ = T_CLOSURE | T_COPY_ARGS; \
- new_cell(Sc, X, _T_); \
+ new_cell(Sc, X, T_CLOSURE | T_COPY_ARGS | ((is_safe_closure(Code)) ? T_SAFE_CLOSURE : 0)); \
closure_set_args(X, Args); \
closure_set_body(X, Code); \
closure_set_setter(X, sc->F); \
- if (is_null(Args)) closure_arity(X) = 0; else closure_arity(X) = CLOSURE_ARITY_NOT_SET; \
- closure_set_let(X, Env); \
+ closure_arity(X) = Arity; \
+ closure_set_let(X, Env); \
sc->capture_let_counter++; \
} while (0)
-
-#define make_closure_without_capture(Sc, X, Args, Code, Env) \
- do { \
- uint32_t _T_; \
- if (is_safe_closure(Code)) \
- _T_ = T_CLOSURE | T_SAFE_CLOSURE | T_COPY_ARGS; \
- else _T_ = T_CLOSURE | T_COPY_ARGS; \
- new_cell(Sc, X, _T_); \
- closure_set_args(X, Args); \
- closure_set_body(X, Code); \
- closure_set_setter(X, sc->F); \
- if (is_null(Args)) closure_arity(X) = 0; else closure_arity(X) = CLOSURE_ARITY_NOT_SET; \
- closure_set_let(X, Env); \
- } while (0)
-
-
static int32_t closure_length(s7_scheme *sc, s7_pointer e)
{
/* we can't use let_length(sc, closure_let(e)) because the closure_let(closure)
@@ -8226,7 +8276,7 @@ static int32_t closure_length(s7_scheme *sc, s7_pointer e)
s7_pointer length_func;
length_func = find_method(sc, closure_let(e), sc->length_symbol);
if (length_func != sc->undefined)
- return((int)s7_integer(s7_apply_function(sc, length_func, list_1(sc, e))));
+ return((int32_t)s7_integer(s7_apply_function(sc, length_func, list_1(sc, e))));
/* there are cases where this should raise a wrong-type-arg error, but for now... */
return(-1);
@@ -8628,12 +8678,12 @@ static s7_pointer g_c_pointer(s7_scheme *sc, s7_pointer args)
#define Q_c_pointer s7_make_signature(sc, 4, sc->is_c_pointer_symbol, sc->is_integer_symbol, sc->T, sc->T)
s7_pointer arg, type, info;
- ptr_int p;
+ intptr_t p;
arg = car(args);
if (!s7_is_integer(arg))
method_or_bust(sc, arg, sc->c_pointer_symbol, list_1(sc, arg), T_INTEGER, 1);
- p = (ptr_int)s7_integer(arg); /* (c-pointer (bignum "1234")) */
+ p = (intptr_t)s7_integer(arg); /* (c-pointer (bignum "1234")) */
info = sc->F;
if (is_pair(cdr(args)))
{
@@ -8740,10 +8790,10 @@ static s7_pointer copy_counter(s7_scheme *sc, s7_pointer obj)
}
-static s7_pointer copy_stack(s7_scheme *sc, s7_pointer old_v, int32_t top)
+static s7_pointer copy_stack(s7_scheme *sc, s7_pointer old_v, int64_t top)
{
#define CC_INITIAL_STACK_SIZE 256 /* 128 is too small here */
- int32_t i, len;
+ int64_t i, len;
s7_pointer new_v;
s7_pointer *nv, *ov;
@@ -8801,7 +8851,7 @@ static s7_pointer make_goto(s7_scheme *sc)
s7_pointer x;
new_cell(sc, x, T_GOTO);
call_exit_goto_loc(x) = s7_stack_top(sc);
- call_exit_op_loc(x) = (int)(sc->op_stack_now - sc->op_stack);
+ call_exit_op_loc(x) = (int32_t)(sc->op_stack_now - sc->op_stack);
call_exit_active(x) = true;
return(x);
}
@@ -8812,7 +8862,7 @@ static s7_pointer *copy_op_stack(s7_scheme *sc)
int32_t len;
s7_pointer *ops;
ops = (s7_pointer *)malloc(sc->op_stack_size * sizeof(s7_pointer));
- len = (int)(sc->op_stack_now - sc->op_stack);
+ len = (int32_t)(sc->op_stack_now - sc->op_stack);
if (len > 0)
memcpy((void *)ops, (void *)(sc->op_stack), len * sizeof(s7_pointer));
return(ops);
@@ -8881,7 +8931,7 @@ static int32_t find_any_baffle(s7_scheme *sc)
s7_pointer s7_make_continuation(s7_scheme *sc)
{
s7_pointer x, stack;
- int32_t loc;
+ int64_t loc;
loc = s7_stack_top(sc);
stack = copy_stack(sc, sc->stack, loc);
@@ -8894,7 +8944,7 @@ s7_pointer s7_make_continuation(s7_scheme *sc)
continuation_stack_start(x) = vector_elements(continuation_stack(x));
continuation_stack_end(x) = (s7_pointer *)(continuation_stack_start(x) + loc);
continuation_op_stack(x) = copy_op_stack(sc); /* no heap allocation here */
- continuation_op_loc(x) = (int)(sc->op_stack_now - sc->op_stack);
+ continuation_op_loc(x) = (int32_t)(sc->op_stack_now - sc->op_stack);
continuation_op_size(x) = sc->op_stack_size;
continuation_key(x) = find_any_baffle(sc);
sc->temp8 = sc->nil;
@@ -8914,7 +8964,7 @@ static void let_temp_done(s7_scheme *sc, s7_pointer args, s7_pointer code)
static bool check_for_dynamic_winds(s7_scheme *sc, s7_pointer c)
{
- int32_t i, s_base = 0, c_base = -1;
+ int64_t i, s_base = 0, c_base = -1;
opcode_t op;
for (i = s7_stack_top(sc) - 1; i > 0; i -= 4)
@@ -8926,7 +8976,7 @@ static bool check_for_dynamic_winds(s7_scheme *sc, s7_pointer c)
case OP_LET_TEMP_DONE:
{
s7_pointer x;
- int32_t j;
+ int64_t j;
x = stack_code(sc->stack, i);
for (j = 3; j < continuation_stack_top(c); j += 4)
if (((stack_op(continuation_stack(c), j) == OP_DYNAMIC_WIND) ||
@@ -9055,7 +9105,7 @@ static bool call_with_current_continuation(s7_scheme *sc)
static void call_with_exit(s7_scheme *sc)
{
- int32_t i, new_stack_top, quit = 0;
+ int64_t i, new_stack_top, quit = 0;
if (!call_exit_active(sc->code))
{
@@ -9158,7 +9208,7 @@ static void call_with_exit(s7_scheme *sc)
longjmp(sc->goto_start, CALL_WITH_EXIT_JUMP);
}
for (i = 0; i < quit; i++)
- push_stack(sc, OP_EVAL_DONE, sc->nil, sc->nil);
+ push_stack_op_let(sc, OP_EVAL_DONE);
}
}
@@ -10534,7 +10584,7 @@ static char *number_to_string_with_radix(s7_scheme *sc, s7_pointer obj, int32_t
s7_pointer r;
len = 0;
- ep = (int)floor(log(x) / log((double)radix));
+ ep = (int32_t)floor(log(x) / log((double)radix));
r = make_real(sc, x / pow((double)radix, (double)ep)); /* divide it down to one digit, then the fractional part */
p1 = number_to_string_with_radix(sc, r, radix, width, precision, float_choice, &len);
p = (char *)malloc((len + 8) * sizeof(char));
@@ -10790,7 +10840,7 @@ static void init_ctables(void)
for (i = 0; i < CTABLE_SIZE; i++)
symbol_slashify_table[i] = ((slashify_table[i]) || (!char_ok_in_a_name[i]));
- digits = (int32_t *)calloc(CTABLE_SIZE, sizeof(int));
+ digits = (int32_t *)calloc(CTABLE_SIZE, sizeof(int32_t));
for (i = 0; i < CTABLE_SIZE; i++)
digits[i] = 256;
@@ -10948,7 +10998,6 @@ static s7_pointer unknown_sharp_constant(s7_scheme *sc, char *name)
static s7_pointer make_sharp_constant(s7_scheme *sc, char *name, int32_t radix, bool with_error)
{
/* name is the stuff after the '#', return sc->nil if not a recognized #... entity */
- int32_t len;
s7_pointer x;
if ((name[0] == 't') &&
@@ -10966,8 +11015,7 @@ static s7_pointer make_sharp_constant(s7_scheme *sc, char *name, int32_t radix,
return(x);
}
- len = safe_strlen5(name); /* just count up to 5 */
- if (len < 2)
+ if ((name[0] == '\0') || name[1] == '\0')
return(unknown_sharp_constant(sc, name));
switch (name[0])
@@ -11071,18 +11119,10 @@ static s7_pointer make_sharp_constant(s7_scheme *sc, char *name, int32_t radix,
break;
case 'x':
- /* #\x is just x, but apparently #\x<num> is int->char? #\x65 -> #\e -- Guile doesn't have this
- *
- * r7rs has 2/3/4-byte "characters" of the form #\xcebb but this is not compatible with
- * make-string, string-length, and so on. We'd either have to have 2-byte chars
- * so (string-length (make-string 3 #\xcebb)) = 3, or accept 6 here for number of chars.
- * Then substring and string-set! and so on have to use utf8 encoding throughout or
- * risk changing the string length unexpectedly.
- */
+ /* #\x is just x, but apparently #\x<num> is int->char? #\x65 -> #\e, and #\xcebb is lambda? */
{
/* sscanf here misses errors like #\x1.4, but make_atom misses #\x6/3,
- * #\x#b0, #\x#e0.0, #\x-0, #\x#e0e100 etc, so we have to do it at
- * an even lower level.
+ * #\x#b0, #\x#e0.0, #\x-0, #\x#e0e100 etc, so we have to do it at an even lower level.
* another problem: #\xbdca2cbec overflows so lval is -593310740 -> segfault unless caught
*/
bool happy = true;
@@ -11093,7 +11133,7 @@ static s7_pointer make_sharp_constant(s7_scheme *sc, char *name, int32_t radix,
while ((*tmp) && (happy) && (lval >= 0))
{
int32_t dig;
- dig = digits[(int)(*tmp++)];
+ dig = digits[(int32_t)(*tmp++)];
if (dig < 16)
lval = dig + (lval * 16);
else happy = false;
@@ -11241,12 +11281,12 @@ static s7_double string_to_double_with_radix(const char *ur_str, int32_t radix,
while (*str == '0') {str++;};
ipart = str;
- while (digits[(int)(*str)] < radix) str++;
+ while (digits[(int32_t)(*str)] < radix) str++;
int_len = str - ipart;
if (*str == '.') str++;
fpart = str;
- while (digits[(int)(*str)] < radix) str++;
+ while (digits[(int32_t)(*str)] < radix) str++;
frac_len = str - fpart;
if ((*str) && (exponent_table[(unsigned char)(*str)]))
@@ -11263,7 +11303,7 @@ static s7_double string_to_double_with_radix(const char *ur_str, int32_t radix,
exp_negative = true;
}
}
- while ((dig = digits[(int)(*str++)]) < 10) /* exponent itself is always base 10 */
+ while ((dig = digits[(int32_t)(*str++)]) < 10) /* exponent itself is always base 10 */
{
#if HAVE_OVERFLOW_CHECKS
if ((int_multiply_overflow(exponent, 10, &exponent)) ||
@@ -11325,7 +11365,7 @@ static s7_double string_to_double_with_radix(const char *ur_str, int32_t radix,
for (i = 0; i < max_len; i++)
{
- dig = digits[(int)(*str++)];
+ dig = digits[(int32_t)(*str++)];
if (dig < radix)
int_part = dig + (int_part * radix);
else break;
@@ -11341,7 +11381,7 @@ static s7_double string_to_double_with_radix(const char *ur_str, int32_t radix,
return(0.0);
str = fpart;
- while ((dig = digits[(int)(*str++)]) < radix)
+ while ((dig = digits[(int32_t)(*str++)]) < radix)
frac_part = dig + (frac_part * radix);
if (frac_part == 0)
return(0.0);
@@ -11381,7 +11421,7 @@ static s7_double string_to_double_with_radix(const char *ur_str, int32_t radix,
frac_part = 0;
for (i = 0; i < flen; i++)
- frac_part = digits[(int)(*str++)] + (frac_part * radix);
+ frac_part = digits[(int32_t)(*str++)] + (frac_part * radix);
if (frac_part != 0) /* same pow->NaN problem as above can occur here */
dval += frac_part * ipow(radix, exponent - flen - k);
@@ -11399,7 +11439,7 @@ static s7_double string_to_double_with_radix(const char *ur_str, int32_t radix,
ilen = max_len;
for (i = 0; i < ilen; i++)
- frac_part = digits[(int)(*str++)] + (frac_part * radix);
+ frac_part = digits[(int32_t)(*str++)] + (frac_part * radix);
dval += frac_part * ipow(radix, exponent - ilen);
}
@@ -11431,7 +11471,7 @@ static s7_double string_to_double_with_radix(const char *ur_str, int32_t radix,
while ((*iend == '0') && (iend != str)) {iend--; int_exponent++;}
while (str <= iend)
- int_part = digits[(int)(*str++)] + (int_part * radix);
+ int_part = digits[(int32_t)(*str++)] + (int_part * radix);
}
if (int_exponent != 0)
dval = int_part * ipow(radix, int_exponent);
@@ -11450,14 +11490,14 @@ static s7_double string_to_double_with_radix(const char *ur_str, int32_t radix,
len = int_len + exponent;
for (i = 0; i < len; i++)
- int_part = digits[(int)(*str++)] + (int_part * radix);
+ int_part = digits[(int32_t)(*str++)] + (int_part * radix);
flen = -exponent;
if (flen > max_len)
flen = max_len;
for (i = 0; i < flen; i++)
- frpart = digits[(int)(*str++)] + (frpart * radix);
+ frpart = digits[(int32_t)(*str++)] + (frpart * radix);
if (len <= 0)
dval = int_part + frpart * ipow(radix, len - flen);
@@ -11477,7 +11517,7 @@ static s7_double string_to_double_with_radix(const char *ur_str, int32_t radix,
while ((*fend == '0') && (fend != str)) {fend--; frac_len--;} /* (= .6 0.6000) */
while (str <= fend)
- frac_part = digits[(int)(*str++)] + (frac_part * radix);
+ frac_part = digits[(int32_t)(*str++)] + (frac_part * radix);
dval += frac_part * ipow(radix, exponent - frac_len);
/* fprintf(stderr, "frac: %" PRId64 ", exp: (%d %d) %.20f, val: %.20f\n", frac_part, exponent, frac_len, ipow(radix, exponent - frac_len), dval);
@@ -11500,7 +11540,7 @@ static s7_double string_to_double_with_radix(const char *ur_str, int32_t radix,
if (exponent <= 0)
{
for (i = 0; i < max_len; i++)
- frac_part = digits[(int)(*str++)] + (frac_part * radix);
+ frac_part = digits[(int32_t)(*str++)] + (frac_part * radix);
dval += frac_part * ipow(radix, exponent - max_len);
}
@@ -11516,14 +11556,14 @@ static s7_double string_to_double_with_radix(const char *ur_str, int32_t radix,
int_part = 0;
for (i = 0; i < exponent; i++)
- int_part = digits[(int)(*str++)] + (int_part * radix);
+ int_part = digits[(int32_t)(*str++)] + (int_part * radix);
frac_len -= exponent;
if (frac_len > max_len)
frac_len = max_len;
for (i = 0; i < frac_len; i++)
- frac_part = digits[(int)(*str++)] + (frac_part * radix);
+ frac_part = digits[(int32_t)(*str++)] + (frac_part * radix);
dval += int_part + frac_part * ipow(radix, -frac_len);
}
@@ -14692,7 +14732,7 @@ static s7_pointer g_add(s7_scheme *sc, s7_pointer args)
goto ADD_COMPLEX;
default:
- method_or_bust_with_type(sc, x, sc->add_symbol, cons(sc, s7_make_integer(sc, num_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->add_symbol, cons_unchecked(sc, s7_make_integer(sc, num_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
break;
@@ -14792,7 +14832,7 @@ static s7_pointer g_add(s7_scheme *sc, s7_pointer args)
goto ADD_COMPLEX;
default:
- method_or_bust_with_type(sc, x, sc->add_symbol, cons(sc, s7_make_ratio(sc, num_a, den_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->add_symbol, cons_unchecked(sc, s7_make_ratio(sc, num_a, den_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
break;
@@ -14827,7 +14867,7 @@ static s7_pointer g_add(s7_scheme *sc, s7_pointer args)
goto ADD_COMPLEX;
default:
- method_or_bust_with_type(sc, x, sc->add_symbol, cons(sc, make_real(sc, rl_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->add_symbol, cons_unchecked(sc, make_real(sc, rl_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
break;
@@ -14865,7 +14905,7 @@ static s7_pointer g_add(s7_scheme *sc, s7_pointer args)
goto ADD_COMPLEX;
default:
- method_or_bust_with_type(sc, x, sc->add_symbol, cons(sc, s7_make_complex(sc, rl_a, im_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->add_symbol, cons_unchecked(sc, s7_make_complex(sc, rl_a, im_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
break;
@@ -15290,7 +15330,7 @@ static s7_pointer g_subtract(s7_scheme *sc, s7_pointer args)
goto SUBTRACT_COMPLEX;
default:
- method_or_bust_with_type(sc, x, sc->subtract_symbol, cons(sc, s7_make_integer(sc, num_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->subtract_symbol, cons_unchecked(sc, s7_make_integer(sc, num_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
break;
@@ -15382,7 +15422,7 @@ static s7_pointer g_subtract(s7_scheme *sc, s7_pointer args)
goto SUBTRACT_COMPLEX;
default:
- method_or_bust_with_type(sc, x, sc->subtract_symbol, cons(sc, s7_make_ratio(sc, num_a, den_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->subtract_symbol, cons_unchecked(sc, s7_make_ratio(sc, num_a, den_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
break;
@@ -15417,7 +15457,7 @@ static s7_pointer g_subtract(s7_scheme *sc, s7_pointer args)
goto SUBTRACT_COMPLEX;
default:
- method_or_bust_with_type(sc, x, sc->subtract_symbol, cons(sc, make_real(sc, rl_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->subtract_symbol, cons_unchecked(sc, make_real(sc, rl_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
break;
@@ -15455,7 +15495,7 @@ static s7_pointer g_subtract(s7_scheme *sc, s7_pointer args)
goto SUBTRACT_COMPLEX;
default:
- method_or_bust_with_type(sc, x, sc->subtract_symbol, cons(sc, s7_make_complex(sc, rl_a, im_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->subtract_symbol, cons_unchecked(sc, s7_make_complex(sc, rl_a, im_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
break;
@@ -15862,7 +15902,7 @@ static s7_pointer g_multiply(s7_scheme *sc, s7_pointer args)
goto MULTIPLY_COMPLEX;
default:
- method_or_bust_with_type(sc, x, sc->multiply_symbol, cons(sc, s7_make_integer(sc, num_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->multiply_symbol, cons_unchecked(sc, s7_make_integer(sc, num_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
break;
@@ -15959,7 +15999,7 @@ static s7_pointer g_multiply(s7_scheme *sc, s7_pointer args)
}
default:
- method_or_bust_with_type(sc, x, sc->multiply_symbol, cons(sc, s7_make_ratio(sc, num_a, den_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->multiply_symbol, cons_unchecked(sc, s7_make_ratio(sc, num_a, den_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
break;
@@ -15994,7 +16034,7 @@ static s7_pointer g_multiply(s7_scheme *sc, s7_pointer args)
goto MULTIPLY_COMPLEX;
default:
- method_or_bust_with_type(sc, x, sc->multiply_symbol, cons(sc, make_real(sc, rl_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->multiply_symbol, cons_unchecked(sc, make_real(sc, rl_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
break;
@@ -16047,7 +16087,7 @@ static s7_pointer g_multiply(s7_scheme *sc, s7_pointer args)
}
default:
- method_or_bust_with_type(sc, x, sc->multiply_symbol, cons(sc, s7_make_complex(sc, rl_a, im_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->multiply_symbol, cons_unchecked(sc, s7_make_complex(sc, rl_a, im_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
break;
@@ -16490,7 +16530,7 @@ static s7_pointer g_divide(s7_scheme *sc, s7_pointer args)
}
default:
- method_or_bust_with_type(sc, x, sc->divide_symbol, cons(sc, s7_make_integer(sc, num_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->divide_symbol, cons_unchecked(sc, s7_make_integer(sc, num_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
break;
@@ -16597,7 +16637,7 @@ static s7_pointer g_divide(s7_scheme *sc, s7_pointer args)
}
default:
- method_or_bust_with_type(sc, x, sc->divide_symbol, cons(sc, s7_make_ratio(sc, num_a, den_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->divide_symbol, cons_unchecked(sc, s7_make_ratio(sc, num_a, den_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
break;
@@ -16666,7 +16706,7 @@ static s7_pointer g_divide(s7_scheme *sc, s7_pointer args)
}
default:
- method_or_bust_with_type(sc, x, sc->divide_symbol, cons(sc, make_real(sc, rl_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->divide_symbol, cons_unchecked(sc, make_real(sc, rl_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
break;
@@ -16730,7 +16770,7 @@ static s7_pointer g_divide(s7_scheme *sc, s7_pointer args)
}
default:
- method_or_bust_with_type(sc, x, sc->divide_symbol, cons(sc, s7_make_complex(sc, rl_a, im_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->divide_symbol, cons_unchecked(sc, s7_make_complex(sc, rl_a, im_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
break;
@@ -16886,7 +16926,7 @@ static s7_pointer g_max(s7_scheme *sc, s7_pointer args)
goto MAX_INTEGERS;
default:
- method_or_bust(sc, y, sc->max_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ method_or_bust(sc, y, sc->max_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
@@ -16994,7 +17034,7 @@ static s7_pointer g_max(s7_scheme *sc, s7_pointer args)
goto MAX_RATIOS;
default:
- method_or_bust(sc, y, sc->max_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ method_or_bust(sc, y, sc->max_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
@@ -17042,7 +17082,7 @@ static s7_pointer g_max(s7_scheme *sc, s7_pointer args)
goto MAX_REALS;
default:
- method_or_bust(sc, y, sc->max_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ method_or_bust(sc, y, sc->max_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
default:
@@ -17101,7 +17141,7 @@ static s7_pointer g_min(s7_scheme *sc, s7_pointer args)
goto MIN_INTEGERS;
default:
- method_or_bust(sc, y, sc->min_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ method_or_bust(sc, y, sc->min_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
@@ -17187,7 +17227,7 @@ static s7_pointer g_min(s7_scheme *sc, s7_pointer args)
goto MIN_RATIOS;
default:
- method_or_bust(sc, y, sc->min_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ method_or_bust(sc, y, sc->min_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
@@ -17235,7 +17275,7 @@ static s7_pointer g_min(s7_scheme *sc, s7_pointer args)
goto MIN_REALS;
default:
- method_or_bust(sc, y, sc->min_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ method_or_bust(sc, y, sc->min_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
default:
@@ -17283,7 +17323,7 @@ static s7_pointer g_equal(s7_scheme *sc, s7_pointer args)
break;
default:
- method_or_bust_with_type(sc, x, sc->eq_symbol, cons(sc, make_integer(sc, num_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->eq_symbol, cons_unchecked(sc, make_integer(sc, num_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
if (is_null(p))
return(sc->T);
@@ -17314,7 +17354,7 @@ static s7_pointer g_equal(s7_scheme *sc, s7_pointer args)
break;
default:
- method_or_bust_with_type(sc, x, sc->eq_symbol, cons(sc, s7_make_ratio(sc, num_a, den_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->eq_symbol, cons_unchecked(sc, s7_make_ratio(sc, num_a, den_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
if (is_null(p))
return(sc->T);
@@ -17348,7 +17388,7 @@ static s7_pointer g_equal(s7_scheme *sc, s7_pointer args)
goto NOT_EQUAL;
default:
- method_or_bust_with_type(sc, x, sc->eq_symbol, cons(sc, make_real(sc, rl_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->eq_symbol, cons_unchecked(sc, make_real(sc, rl_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
if (is_null(p))
return(sc->T);
@@ -17375,7 +17415,7 @@ static s7_pointer g_equal(s7_scheme *sc, s7_pointer args)
break;
default:
- method_or_bust_with_type(sc, x, sc->eq_symbol, cons(sc, s7_make_complex(sc, rl_a, im_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
+ method_or_bust_with_type(sc, x, sc->eq_symbol, cons_unchecked(sc, s7_make_complex(sc, rl_a, im_a), cons(sc, x, p)), a_number_string, position_of(p, args) - 1);
}
if (is_null(p))
return(sc->T);
@@ -17394,7 +17434,7 @@ static s7_pointer g_equal(s7_scheme *sc, s7_pointer args)
}
-static s7_int object_length_to_int(s7_scheme *sc, s7_pointer obj);
+static s7_int c_object_length_to_int(s7_scheme *sc, s7_pointer obj);
#if (!WITH_GMP)
static s7_pointer equal_s_ic;
@@ -17437,7 +17477,7 @@ static s7_pointer g_equal_length_ic(s7_scheme *sc, s7_pointer args)
case T_STRING: return(make_boolean(sc, string_length(val) == ilen));
case T_HASH_TABLE: return(make_boolean(sc, (hash_table_mask(val) + 1) == ilen));
case T_ITERATOR: return(make_boolean(sc, iterator_length(val) == ilen));
- case T_C_OBJECT: return(make_boolean(sc, object_length_to_int(sc, val) == ilen));
+ case T_C_OBJECT: return(make_boolean(sc, c_object_length_to_int(sc, val) == ilen));
case T_LET: return(make_boolean(sc, let_length(sc, val) == ilen));
case T_INT_VECTOR:
case T_FLOAT_VECTOR:
@@ -17561,7 +17601,6 @@ static s7_pointer equal_p_pi(s7_pointer p1, s7_int p2)
return(cur_sc->F);
return(wrong_type_argument_with_type(cur_sc, cur_sc->eq_symbol, 1, p1, a_number_string));
}
-/* TODO: all the rest of the 2-arg cases */
static s7_pointer equal_p_dd(s7_double x1, s7_double x2) {return(make_boolean(cur_sc, x1 == x2));}
static s7_pointer gt_p_dd(s7_double x1, s7_double x2) {return(make_boolean(cur_sc, x1 > x2));}
@@ -17636,7 +17675,7 @@ static s7_pointer g_less(s7_scheme *sc, s7_pointer args)
goto REAL_LESS;
default:
- method_or_bust(sc, y, sc->lt_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ method_or_bust(sc, y, sc->lt_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
@@ -17709,7 +17748,7 @@ static s7_pointer g_less(s7_scheme *sc, s7_pointer args)
goto REAL_LESS;
default:
- method_or_bust(sc, y, sc->lt_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ method_or_bust(sc, y, sc->lt_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
@@ -17741,7 +17780,7 @@ static s7_pointer g_less(s7_scheme *sc, s7_pointer args)
goto REAL_LESS;
default:
- method_or_bust(sc, y, sc->lt_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ method_or_bust(sc, y, sc->lt_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
default:
@@ -17813,7 +17852,7 @@ static s7_pointer g_less_or_equal(s7_scheme *sc, s7_pointer args)
goto REAL_LEQ;
default:
- method_or_bust(sc, y, sc->leq_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ method_or_bust(sc, y, sc->leq_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
@@ -17885,7 +17924,7 @@ static s7_pointer g_less_or_equal(s7_scheme *sc, s7_pointer args)
goto REAL_LEQ;
default:
- method_or_bust(sc, y, sc->leq_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ method_or_bust(sc, y, sc->leq_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
@@ -17917,7 +17956,7 @@ static s7_pointer g_less_or_equal(s7_scheme *sc, s7_pointer args)
goto REAL_LEQ;
default:
- method_or_bust(sc, y, sc->leq_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ method_or_bust(sc, y, sc->leq_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
default:
@@ -17988,7 +18027,7 @@ static s7_pointer g_greater(s7_scheme *sc, s7_pointer args)
goto REAL_GREATER;
default:
- method_or_bust(sc, y, sc->gt_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ method_or_bust(sc, y, sc->gt_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
@@ -18060,7 +18099,7 @@ static s7_pointer g_greater(s7_scheme *sc, s7_pointer args)
goto REAL_GREATER;
default:
- method_or_bust(sc, y, sc->gt_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ method_or_bust(sc, y, sc->gt_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
@@ -18092,7 +18131,7 @@ static s7_pointer g_greater(s7_scheme *sc, s7_pointer args)
goto REAL_GREATER;
default:
- method_or_bust(sc, y, sc->gt_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ method_or_bust(sc, y, sc->gt_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
default:
@@ -18164,7 +18203,7 @@ static s7_pointer g_greater_or_equal(s7_scheme *sc, s7_pointer args)
goto REAL_GEQ;
default:
- method_or_bust(sc, y, sc->geq_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ method_or_bust(sc, y, sc->geq_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
@@ -18236,7 +18275,7 @@ static s7_pointer g_greater_or_equal(s7_scheme *sc, s7_pointer args)
goto REAL_GEQ;
default:
- method_or_bust(sc, y, sc->geq_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ method_or_bust(sc, y, sc->geq_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
@@ -18268,7 +18307,7 @@ static s7_pointer g_greater_or_equal(s7_scheme *sc, s7_pointer args)
goto REAL_GEQ;
default:
- method_or_bust(sc, y, sc->geq_symbol, cons(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
+ method_or_bust(sc, y, sc->geq_symbol, cons_unchecked(sc, x, cons(sc, y, p)), T_REAL, position_of(p, args) - 1);
}
default:
@@ -18341,7 +18380,7 @@ static s7_pointer g_less_length_ic(s7_scheme *sc, s7_pointer args)
case T_STRING: return(make_boolean(sc, string_length(val) < ilen));
case T_HASH_TABLE: return(make_boolean(sc, (hash_table_mask(val) + 1) < ilen)); /* was <=? -- changed 15-Dec-15, then again 6-Jan-17: mask is len-1 */
case T_ITERATOR: return(make_boolean(sc, iterator_length(val) < ilen));
- case T_C_OBJECT: return(make_boolean(sc, object_length_to_int(sc, val) < ilen));
+ case T_C_OBJECT: return(make_boolean(sc, c_object_length_to_int(sc, val) < ilen));
case T_LET: return(make_boolean(sc, let_length(sc, val) < ilen)); /* this works because let_length handles the length method itself! */
case T_INT_VECTOR:
case T_FLOAT_VECTOR:
@@ -20996,7 +21035,7 @@ static s7_pointer g_make_string(s7_scheme *sc, s7_pointer args)
method_or_bust(sc, cadr(args), sc->make_string_symbol, args, T_CHARACTER, 2);
fill = s7_character(cadr(args));
}
- n = make_empty_string(sc, (int)len, fill);
+ n = make_empty_string(sc, (int32_t)len, fill);
if (fill == '\0')
memset((void *)string_value(n), 0, (int)len);
return(n);
@@ -21035,17 +21074,19 @@ static s7_pointer g_string_downcase(s7_scheme *sc, s7_pointer args)
unsigned char *nstr, *ostr;
p = car(args);
- sc->temp3 = p;
if (!is_string(p))
- method_or_bust_one_arg(sc, p, sc->string_downcase_symbol, list_1(sc, p), T_STRING);
-
+ {
+ sc->temp3 = p;
+ method_or_bust_one_arg(sc, p, sc->string_downcase_symbol, list_1(sc, p), T_STRING);
+ sc->temp3 = sc->nil;
+ }
len = string_length(p);
newstr = make_empty_string(sc, len, 0);
ostr = (unsigned char *)string_value(p);
nstr = (unsigned char *)string_value(newstr);
for (i = 0; i < len; i++)
- nstr[i] = lowers[(int)ostr[i]];
+ nstr[i] = lowers[(int32_t)ostr[i]];
return(newstr);
}
@@ -21060,17 +21101,19 @@ static s7_pointer g_string_upcase(s7_scheme *sc, s7_pointer args)
unsigned char *nstr, *ostr;
p = car(args);
- sc->temp3 = p;
if (!is_string(p))
- method_or_bust_one_arg(sc, p, sc->string_upcase_symbol, list_1(sc, p), T_STRING);
-
+ {
+ sc->temp3 = p;
+ method_or_bust_one_arg(sc, p, sc->string_upcase_symbol, list_1(sc, p), T_STRING);
+ sc->temp3 = sc->nil;
+ }
len = string_length(p);
newstr = make_empty_string(sc, len, 0);
ostr = (unsigned char *)string_value(p);
nstr = (unsigned char *)string_value(newstr);
for (i = 0; i < len; i++)
- nstr[i] = uppers[(int)ostr[i]];
+ nstr[i] = uppers[(int32_t)ostr[i]];
return(newstr);
}
@@ -21458,7 +21501,7 @@ end: (substring \"01234\" 1 2) -> \"1\""
if (x != sc->gc_nil) return(x);
}
s = string_value(str);
- len = (int)(end - start);
+ len = (int32_t)(end - start);
x = s7_make_string_with_length(sc, (char *)(s + start), len);
string_value(x)[len] = 0;
return(x);
@@ -21482,7 +21525,7 @@ static s7_pointer g_substring_to_temp(s7_scheme *sc, s7_pointer args)
x = start_and_end(sc, sc->substring_symbol, NULL, cdr(args), args, 2, &start, &end);
if (x != sc->gc_nil) return(x);
}
- return(make_temporary_string(sc, (const char *)(string_value(str) + start), (int)(end - start)));
+ return(make_temporary_string(sc, (const char *)(string_value(str) + start), (int32_t)(end - start)));
}
@@ -21807,11 +21850,11 @@ static int32_t scheme_strcasecmp(s7_pointer s1, s7_pointer s2)
str2 = (unsigned char *)string_value(s2);
for (i = 0; i < len; i++)
- if (uppers[(int)str1[i]] < uppers[(int)str2[i]])
+ if (uppers[(int32_t)str1[i]] < uppers[(int32_t)str2[i]])
return(-1);
else
{
- if (uppers[(int)str1[i]] > uppers[(int)str2[i]])
+ if (uppers[(int32_t)str1[i]] > uppers[(int32_t)str2[i]])
return(1);
}
@@ -21838,7 +21881,7 @@ static bool scheme_strequal_ci(s7_pointer s1, s7_pointer s2)
str2 = (unsigned char *)string_value(s2);
for (i = 0; i < len; i++)
- if (uppers[(int)str1[i]] != uppers[(int)str2[i]])
+ if (uppers[(int32_t)str1[i]] != uppers[(int32_t)str2[i]])
return(false);
return(true);
}
@@ -22101,7 +22144,7 @@ static s7_pointer g_list_to_string(s7_scheme *sc, s7_pointer args)
if (is_null(car(args)))
return(s7_make_string_with_length(sc, "", 0));
- if (!s7_is_proper_list(sc, car(args)))
+ if (!s7_is_proper_list(sc, car(args)))
method_or_bust_with_type_one_arg(sc, car(args), sc->list_to_string_symbol, args, s7_make_string_wrapper(sc, "a (proper, non-circular) list of characters"));
return(g_string_1(sc, car(args), sc->list_to_string_symbol));
}
@@ -22182,8 +22225,6 @@ static s7_pointer g_is_byte_vector(s7_scheme *sc, s7_pointer args)
check_boolean_method(sc, s7_is_byte_vector, sc->is_byte_vector_symbol, args);
}
-
-/* TODO: string->byte-vector should copy its arg, and bv/strs should never be equal */
static s7_pointer g_string_to_byte_vector(s7_scheme *sc, s7_pointer args)
{
#define H_string_to_byte_vector "(string->byte-vector obj) turns a string into a byte-vector."
@@ -22307,7 +22348,7 @@ static s7_pointer byte_vector_to_list(s7_scheme *sc, const char *str, int32_t le
static s7_pointer g_is_port_closed(s7_scheme *sc, s7_pointer args)
{
#define H_is_port_closed "(port-closed? p) returns #t if the port p is closed."
- #define Q_is_port_closed pl_bt
+ #define Q_is_port_closed s7_make_signature(sc, 2, sc->is_boolean_symbol, s7_make_signature(sc, 2, sc->is_input_port_symbol, sc->is_output_port_symbol))
s7_pointer x;
x = car(args);
@@ -22404,7 +22445,7 @@ static s7_pointer c_port_filename(s7_scheme *sc, s7_pointer x)
static s7_pointer g_port_filename(s7_scheme *sc, s7_pointer args)
{
#define H_port_filename "(port-filename file-port) returns the filename associated with port"
- #define Q_port_filename s7_make_signature(sc, 2, sc->is_string_symbol, sc->T)
+ #define Q_port_filename s7_make_signature(sc, 2, sc->is_string_symbol, s7_make_signature(sc, 2, sc->is_input_port_symbol, sc->is_output_port_symbol))
if (is_null(args))
return(c_port_filename(sc, sc->input_port));
@@ -22945,13 +22986,7 @@ static void resize_port_data(s7_pointer pt, uint32_t new_size)
{
uint32_t loc;
loc = port_data_size(pt);
- if (new_size < loc)
- {
-#if DEBUGGING
- fprintf(stderr, "%s[%d], old: %u, new: %u\n", __func__, __LINE__, loc, new_size);
-#endif
- return;
- }
+ if (new_size < loc) return;
port_data_size(pt) = new_size;
port_data(pt) = (unsigned char *)realloc(port_data(pt), new_size * sizeof(unsigned char));
memclr((void *)(port_data(pt) + loc), new_size - loc);
@@ -23178,7 +23213,7 @@ static s7_pointer g_write_string(s7_scheme *sc, s7_pointer args)
int32_t len;
if ((start == 0) && (end == string_length(str)))
return(str);
- len = (int)(end - start);
+ len = (int32_t)(end - start);
x = s7_make_string_with_length(sc, (char *)(string_value(str) + start), len);
string_value(x)[len] = 0;
return(x);
@@ -23238,8 +23273,7 @@ static int32_t terminated_string_read_white_space(s7_scheme *sc, s7_pointer pt)
{
const unsigned char *str;
unsigned char c;
- /* here we know we have null termination and white_space[#\null] is false.
- */
+ /* here we know we have null termination and white_space[#\null] is false. */
str = (const unsigned char *)(port_data(pt) + port_position(pt));
while (white_space[c = *str++]) /* (let ((a 1)) a) -- 255 is not -1 = EOF */
@@ -23248,7 +23282,7 @@ static int32_t terminated_string_read_white_space(s7_scheme *sc, s7_pointer pt)
if (c)
port_position(pt) = str - port_data(pt);
else port_position(pt) = port_data_size(pt);
- return((int)c);
+ return((int32_t)c);
}
@@ -23482,8 +23516,8 @@ static s7_pointer read_file(s7_scheme *sc, FILE *fp, const char *name, int64_t m
/* pseudo files (under /proc for example) have size=0, but we can read them, so don't assume a 0 length file is empty
*/
- if ((size > 0) && /* if (size != 0) we get (open-input-file "/dev/tty") -> (open "/dev/tty") read 0 bytes of an expected -1? */
- ((max_size < 0) || (size < max_size)))
+ if ((size > 0) && /* if (size != 0) we get (open-input-file "/dev/tty") -> (open "/dev/tty") read 0 bytes of an expected -1? */
+ ((max_size < 0) || (size < max_size))) /* load uses max_size = -1 */
{
size_t bytes;
unsigned char *content;
@@ -24219,7 +24253,7 @@ static s7_pointer g_write_byte(s7_scheme *sc, s7_pointer args)
method_or_bust_with_type_one_arg(sc, port, sc->write_byte_symbol, args, an_output_port_string);
}
- s7_write_char(sc, (int)val, port);
+ s7_write_char(sc, (int32_t)val, port);
return(b);
}
@@ -24359,11 +24393,11 @@ s7_pointer s7_read(s7_scheme *sc, s7_pointer port)
if (jump_loc != NO_JUMP)
{
if (jump_loc != ERROR_JUMP)
- eval(sc, sc->op);
+ eval(sc, sc->cur_op);
}
else
{
- push_stack(sc, OP_BARRIER, port, sc->nil);
+ push_stack_no_let_no_code(sc, OP_BARRIER, port);
push_stack(sc, OP_EVAL_DONE, sc->args, sc->code);
eval(sc, OP_READ_INTERNAL);
@@ -24371,7 +24405,7 @@ s7_pointer s7_read(s7_scheme *sc, s7_pointer port)
if (sc->tok == TOKEN_EOF)
sc->value = sc->eof_object;
- if ((sc->op == OP_EVAL_DONE) &&
+ if ((sc->cur_op == OP_EVAL_DONE) &&
(stack_op(sc->stack, s7_stack_top(sc) - 1) == OP_BARRIER))
pop_stack(sc);
}
@@ -24419,8 +24453,8 @@ static s7_pointer g_read(s7_scheme *sc, s7_pointer args)
return(sc->eof_object);
push_input_port(sc, port);
- push_stack(sc, OP_READ_DONE, sc->nil, sc->nil); /* this stops the internal read process so we only get one form */
- push_stack(sc, OP_READ_INTERNAL, sc->nil, sc->nil);
+ push_stack_op_let(sc, OP_READ_DONE); /* this stops the internal read process so we only get one form */
+ push_stack_op_let(sc, OP_READ_INTERNAL);
return(port);
}
@@ -24521,7 +24555,7 @@ s7_pointer s7_load_with_environment(s7_scheme *sc, const char *filename, s7_poin
if (jump_loc != NO_JUMP)
{
if (jump_loc != ERROR_JUMP)
- eval(sc, sc->op);
+ eval(sc, sc->cur_op);
}
else eval(sc, OP_READ_INTERNAL);
@@ -24610,7 +24644,7 @@ defaults to the rootlet. To load into the current environment instead, pass (cu
{
s7_pointer init;
- init = g_let_ref(sc, set_plist_2(sc, sc->envir, s7_make_symbol(sc, "init_func")));
+ init = g_let_ref(sc, set_plist_2(sc, (is_null(sc->envir)) ? sc->rootlet : sc->envir, s7_make_symbol(sc, "init_func")));
if (is_symbol(init))
{
void *library;
@@ -24687,8 +24721,8 @@ defaults to the rootlet. To load into the current environment instead, pass (cu
push_input_port(sc, port);
sc->temp6 = sc->nil;
- push_stack(sc, OP_LOAD_CLOSE_AND_POP_IF_EOF, sc->nil, sc->nil); /* was pushing args and code, but I don't think they're used later */
- push_stack(sc, OP_READ_INTERNAL, sc->nil, sc->nil);
+ push_stack_op_let(sc, OP_LOAD_CLOSE_AND_POP_IF_EOF); /* was pushing args and code, but I don't think they're used later */
+ push_stack_op_let(sc, OP_READ_INTERNAL);
/* now we've opened and moved to the file to be loaded, and set up the stack to return
* to where we were. Call *load-hook* if it is a procedure.
@@ -24784,7 +24818,7 @@ void s7_autoload_set_names(s7_scheme *sc, const char **names, int32_t size)
if (!sc->autoload_names)
{
sc->autoload_names = (const char ***)calloc(INITIAL_AUTOLOAD_NAMES_SIZE, sizeof(const char **));
- sc->autoload_names_sizes = (int32_t *)calloc(INITIAL_AUTOLOAD_NAMES_SIZE, sizeof(int));
+ sc->autoload_names_sizes = (int32_t *)calloc(INITIAL_AUTOLOAD_NAMES_SIZE, sizeof(int32_t));
sc->autoloaded_already = (bool **)calloc(INITIAL_AUTOLOAD_NAMES_SIZE, sizeof(bool *));
sc->autoload_names_top = INITIAL_AUTOLOAD_NAMES_SIZE;
sc->autoload_names_loc = 0;
@@ -24796,7 +24830,7 @@ void s7_autoload_set_names(s7_scheme *sc, const char **names, int32_t size)
int32_t i;
sc->autoload_names_top *= 2;
sc->autoload_names = (const char ***)realloc(sc->autoload_names, sc->autoload_names_top * sizeof(const char **));
- sc->autoload_names_sizes = (int32_t *)realloc(sc->autoload_names_sizes, sc->autoload_names_top * sizeof(int));
+ sc->autoload_names_sizes = (int32_t *)realloc(sc->autoload_names_sizes, sc->autoload_names_top * sizeof(int32_t));
sc->autoloaded_already = (bool **)realloc(sc->autoloaded_already, sc->autoload_names_top * sizeof(bool *));
for (i = sc->autoload_names_loc; i < sc->autoload_names_top; i++)
{
@@ -24927,11 +24961,11 @@ static s7_pointer g_autoloader(s7_scheme *sc, s7_pointer args)
static s7_pointer g_require(s7_scheme *sc, s7_pointer args)
{
#define H_require "(require . symbols) loads each file associated with each symbol if it has not been loaded already.\
-The symbols refer to the argument to \"provide\"."
+The symbols refer to the argument to \"provide\". (require lint.scm)"
#define Q_require s7_make_circular_signature(sc, 1, 2, sc->T, sc->is_symbol_symbol)
s7_pointer p;
- sc->temp5 = cons(sc, args, sc->temp5);
+ push_stack_no_let_no_code(sc, OP_GC_PROTECT, args);
for (p = args; is_pair(p); p = cdr(p))
{
s7_pointer sym;
@@ -24944,6 +24978,7 @@ The symbols refer to the argument to \"provide\"."
sym = cadar(p);
else return(s7_error(sc, sc->wrong_type_arg_symbol, set_elist_2(sc, s7_make_string_wrapper(sc, "require: ~S is not a symbol"), car(p))));
}
+
if ((!is_slot(find_symbol(sc, sym))) &&
(sc->is_autoloading))
{
@@ -24959,7 +24994,7 @@ The symbols refer to the argument to \"provide\"."
}
}
}
- sc->temp5 = cdr(sc->temp5); /* in-coming value */
+ sc->stack_end -= 4;
return(sc->T);
}
@@ -25008,7 +25043,7 @@ static s7_pointer g_eval_string(s7_scheme *sc, s7_pointer args)
sc->temp3 = sc->args;
push_stack(sc, OP_EVAL_STRING_1, args, sc->code);
- push_stack(sc, OP_READ_INTERNAL, sc->nil, sc->nil);
+ push_stack_op_let(sc, OP_READ_INTERNAL);
return(sc->F);
}
@@ -25159,7 +25194,7 @@ static s7_pointer iterator_copy(s7_scheme *sc, s7_pointer p)
{
/* fields are obj cur [loc|lcur] [len|slow|hcur] next */
s7_pointer iter;
- new_cell(sc, iter, T_ITERATOR | T_SAFE_PROCEDURE);
+ new_cell(sc, iter, T_ITERATOR | T_SAFE_PROCEDURE | (iter_ok(p) ? T_ITER_OK : 0));
iterator_sequence(iter) = iterator_sequence(p); /* obj */
iterator_position(iter) = iterator_position(p); /* loc|lcur (loc is s7_int) */
iterator_length(iter) = iterator_length(p); /* len|slow|hcur (len is s7_int) */
@@ -25192,6 +25227,7 @@ static s7_pointer let_iterate(s7_scheme *sc, s7_pointer iterator)
return(cons(sc, slot_symbol(slot), slot_value(slot)));
}
iterator_next(iterator) = iterator_finished;
+ clear_iter_ok(iterator);
return(sc->ITERATOR_END);
}
@@ -25210,6 +25246,7 @@ static s7_pointer rootlet_iterate(s7_scheme *sc, s7_pointer iterator)
return(cons(sc, slot_symbol(slot), slot_value(slot)));
}
iterator_next(iterator) = iterator_finished;
+ clear_iter_ok(iterator);
return(sc->ITERATOR_END);
}
@@ -25259,6 +25296,7 @@ static s7_pointer hash_table_iterate(s7_scheme *sc, s7_pointer iterator)
}
}
iterator_next(iterator) = iterator_finished;
+ clear_iter_ok(iterator);
return(sc->ITERATOR_END);
}
@@ -25267,6 +25305,7 @@ static s7_pointer string_iterate(s7_scheme *sc, s7_pointer obj)
if (iterator_position(obj) < iterator_length(obj))
return(s7_make_character(sc, (unsigned char)(string_value(iterator_sequence(obj))[iterator_position(obj)++])));
iterator_next(obj) = iterator_finished;
+ clear_iter_ok(obj);
return(sc->ITERATOR_END);
}
@@ -25275,6 +25314,7 @@ static s7_pointer byte_vector_iterate(s7_scheme *sc, s7_pointer obj)
if (iterator_position(obj) < iterator_length(obj))
return(small_int((unsigned char)(string_value(iterator_sequence(obj))[iterator_position(obj)++])));
iterator_next(obj) = iterator_finished;
+ clear_iter_ok(obj);
return(sc->ITERATOR_END);
}
@@ -25283,6 +25323,7 @@ static s7_pointer float_vector_iterate(s7_scheme *sc, s7_pointer obj)
if (iterator_position(obj) < iterator_length(obj))
return(make_real(sc, float_vector_element(iterator_sequence(obj), iterator_position(obj)++)));
iterator_next(obj) = iterator_finished;
+ clear_iter_ok(obj);
return(sc->ITERATOR_END);
}
@@ -25291,6 +25332,7 @@ static s7_pointer int_vector_iterate(s7_scheme *sc, s7_pointer obj)
if (iterator_position(obj) < iterator_length(obj))
return(make_integer(sc, int_vector_element(iterator_sequence(obj), iterator_position(obj)++)));
iterator_next(obj) = iterator_finished;
+ clear_iter_ok(obj);
return(sc->ITERATOR_END);
}
@@ -25299,6 +25341,7 @@ static s7_pointer vector_iterate(s7_scheme *sc, s7_pointer obj)
if (iterator_position(obj) < iterator_length(obj))
return(vector_element(iterator_sequence(obj), iterator_position(obj)++));
iterator_next(obj) = iterator_finished;
+ clear_iter_ok(obj);
return(sc->ITERATOR_END);
}
@@ -25307,7 +25350,10 @@ static s7_pointer closure_iterate(s7_scheme *sc, s7_pointer obj)
s7_pointer result;
result = s7_apply_function(sc, iterator_sequence(obj), sc->nil);
if (result == sc->ITERATOR_END)
- iterator_next(obj) = iterator_finished;
+ {
+ iterator_next(obj) = iterator_finished;
+ clear_iter_ok(obj);
+ }
return(result);
}
@@ -25317,13 +25363,17 @@ static s7_pointer c_object_direct_iterate(s7_scheme *sc, s7_pointer obj)
{
s7_pointer result, p;
p = iterator_sequence(obj);
- result = c_object_cref(p)(sc, p, iterator_position(obj));
+ result = c_object_direct_ref(sc, p)(sc, p, iterator_position(obj));
iterator_position(obj)++;
if (result == sc->ITERATOR_END)
- iterator_next(obj) = iterator_finished;
+ {
+ iterator_next(obj) = iterator_finished;
+ clear_iter_ok(obj);
+ }
return(result);
}
iterator_next(obj) = iterator_finished;
+ clear_iter_ok(obj);
return(sc->ITERATOR_END);
}
@@ -25337,15 +25387,19 @@ static s7_pointer c_object_iterate(s7_scheme *sc, s7_pointer obj)
set_car(sc->z2_1, sc->x);
set_car(sc->z2_2, sc->z); /* is this necessary? */
set_car(cur, make_integer(sc, iterator_position(obj)));
- result = (*(c_object_ref(p)))(sc, p, cur);
+ result = (*(c_object_ref(sc, p)))(sc, p, cur);
sc->x = car(sc->z2_1);
sc->z = car(sc->z2_2);
iterator_position(obj)++;
if (result == sc->ITERATOR_END)
- iterator_next(obj) = iterator_finished;
+ {
+ iterator_next(obj) = iterator_finished;
+ clear_iter_ok(obj);
+ }
return(result);
}
iterator_next(obj) = iterator_finished;
+ clear_iter_ok(obj);
return(sc->ITERATOR_END);
}
@@ -25361,12 +25415,14 @@ static s7_pointer pair_iterate(s7_scheme *sc, s7_pointer obj)
if (iterator_current(obj) == iterator_slow(obj))
{
iterator_next(obj) = iterator_finished;
+ clear_iter_ok(obj);
return(result);
}
iterator_next(obj) = pair_iterate_1;
return(result);
}
iterator_next(obj) = iterator_finished;
+ clear_iter_ok(obj);
return(sc->ITERATOR_END);
}
@@ -25380,6 +25436,7 @@ static s7_pointer pair_iterate_1(s7_scheme *sc, s7_pointer obj)
if (iterator_current(obj) == iterator_slow(obj))
{
iterator_next(obj) = iterator_finished;
+ clear_iter_ok(obj);
return(result);
}
iterator_set_slow(obj, cdr(iterator_slow(obj)));
@@ -25387,6 +25444,7 @@ static s7_pointer pair_iterate_1(s7_scheme *sc, s7_pointer obj)
return(result);
}
iterator_next(obj) = iterator_finished;
+ clear_iter_ok(obj);
return(sc->ITERATOR_END);
}
@@ -25409,7 +25467,7 @@ s7_pointer s7_make_iterator(s7_scheme *sc, s7_pointer e)
{
s7_pointer iter;
- new_cell(sc, iter, T_ITERATOR | T_SAFE_PROCEDURE);
+ new_cell(sc, iter, T_ITERATOR | T_SAFE_PROCEDURE | T_ITER_OK);
iterator_sequence(iter) = e;
iterator_position(iter) = 0;
@@ -25494,12 +25552,9 @@ s7_pointer s7_make_iterator(s7_scheme *sc, s7_pointer e)
break;
case T_C_OBJECT:
- iterator_length(iter) = object_length_to_int(sc, e);
- if (c_object_direct_ref(e))
- {
- iterator_next(iter) = c_object_direct_iterate;
- c_object_cref(e) = c_object_direct_ref(e);
- }
+ iterator_length(iter) = c_object_length_to_int(sc, e);
+ if (c_object_direct_ref(sc, e))
+ iterator_next(iter) = c_object_direct_iterate;
else
{
s7_pointer f;
@@ -25581,42 +25636,48 @@ static bool is_iterator_b(s7_pointer obj) {return(g_is_iterator(cur_sc, set_plis
bool s7_iterator_is_at_end(s7_scheme *sc, s7_pointer obj)
{
+ if (iter_ok(obj))
+ return(false);
if (!is_iterator(obj))
simple_wrong_type_argument(sc, sc->iterator_is_at_end_symbol, obj, T_ITERATOR);
- return(iterator_is_at_end(obj));
+ return(true);
}
bool iterator_is_at_end_b(s7_pointer obj)
{
+ if (iter_ok(obj))
+ return(false);
if (!is_iterator(obj))
simple_wrong_type_argument(cur_sc, cur_sc->iterator_is_at_end_symbol, obj, T_ITERATOR);
- return(iterator_is_at_end(obj));
+ return(true);
}
-
-static s7_pointer g_iterator_sequence(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_iterator_is_at_end(s7_scheme *sc, s7_pointer args)
{
- #define H_iterator_sequence "(iterator-sequence iterator) returns the sequence that iterator is traversing."
- #define Q_iterator_sequence s7_make_signature(sc, 2, sc->is_sequence_symbol, sc->is_iterator_symbol)
-
+ #define H_iterator_is_at_end "(iterator-at-end? iter) returns #t if the iterator has reached the end of its sequence."
+ #define Q_iterator_is_at_end s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_iterator_symbol)
s7_pointer iter;
iter = car(args);
+ if (iter_ok(iter))
+ return(sc->F);
if (!is_iterator(iter))
- return(simple_wrong_type_argument(sc, sc->iterator_sequence_symbol, iter, T_ITERATOR));
- return(iterator_sequence(iter));
+ return(simple_wrong_type_argument(sc, sc->iterator_is_at_end_symbol, iter, T_ITERATOR));
+ return(sc->T);
}
-static s7_pointer g_iterator_is_at_end(s7_scheme *sc, s7_pointer args)
+
+static s7_pointer g_iterator_sequence(s7_scheme *sc, s7_pointer args)
{
- #define H_iterator_is_at_end "(iterator-at-end? iter) returns #t if the iterator has reached the end of its sequence."
- #define Q_iterator_is_at_end s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_iterator_symbol)
+ #define H_iterator_sequence "(iterator-sequence iterator) returns the sequence that iterator is traversing."
+ #define Q_iterator_sequence s7_make_signature(sc, 2, sc->is_sequence_symbol, sc->is_iterator_symbol)
+
s7_pointer iter;
iter = car(args);
if (!is_iterator(iter))
- return(simple_wrong_type_argument(sc, sc->iterator_is_at_end_symbol, iter, T_ITERATOR));
- return(make_boolean(sc, iterator_is_at_end(iter)));
+ return(simple_wrong_type_argument(sc, sc->iterator_sequence_symbol, iter, T_ITERATOR));
+ return(iterator_sequence(iter));
}
@@ -25665,8 +25726,9 @@ static void enlarge_shared_info(shared_info *ci)
{
int32_t i;
ci->size *= 2;
+ ci->size2 = ci->size - 2;
ci->objs = (s7_pointer *)realloc(ci->objs, ci->size * sizeof(s7_pointer));
- ci->refs = (int32_t *)realloc(ci->refs, ci->size * sizeof(int));
+ ci->refs = (int32_t *)realloc(ci->refs, ci->size * sizeof(int32_t));
for (i = ci->top; i < ci->size; i++)
{
ci->refs[i] = 0;
@@ -25674,7 +25736,6 @@ static void enlarge_shared_info(shared_info *ci)
}
}
-
static void add_shared_ref(shared_info *ci, s7_pointer x, int32_t ref_x)
{
/* called only in equality check, not printer */
@@ -25711,6 +25772,24 @@ static bool collect_vector_info(s7_scheme *sc, shared_info *ci, s7_pointer top,
return(cyclic);
}
+static bool check_collected(s7_pointer top, shared_info *ci)
+{
+ s7_pointer *p, *objs_end;
+ int32_t i;
+ objs_end = (s7_pointer *)(ci->objs + ci->top);
+ for (p = ci->objs; p < objs_end; p++)
+ if ((*p) == top)
+ {
+ i = (int32_t)(p - ci->objs);
+ if (ci->refs[i] == 0)
+ {
+ ci->has_hits = true;
+ ci->refs[i] = ++ci->ref; /* if found, set the ref number */
+ }
+ break;
+ }
+ return(true);
+}
static bool collect_shared_info(s7_scheme *sc, shared_info *ci, s7_pointer top, bool stop_at_print_length)
{
@@ -25720,27 +25799,12 @@ static bool collect_shared_info(s7_scheme *sc, shared_info *ci, s7_pointer top,
* encounter an object with that bit on, we've seen it before so we have a possible cycle.
* Once the collection pass is done, we run through our list, and clear all these bits.
*/
- bool top_cyclic = false;
+ bool top_cyclic;
if (is_collected_or_shared(top))
{
- s7_pointer *p, *objs_end;
- int32_t i;
if (is_shared(top))
return(false);
-
- objs_end = (s7_pointer *)(ci->objs + ci->top);
- for (p = ci->objs; p < objs_end; p++)
- if ((*p) == top)
- {
- i = (int)(p - ci->objs);
- if (ci->refs[i] == 0)
- {
- ci->has_hits = true;
- ci->refs[i] = ++ci->ref; /* if found, set the ref number */
- }
- break;
- }
- return(true);
+ return(check_collected(top, ci));
}
/* top not seen before -- add it to the list */
@@ -25750,16 +25814,53 @@ static bool collect_shared_info(s7_scheme *sc, shared_info *ci, s7_pointer top,
enlarge_shared_info(ci);
ci->objs[ci->top++] = top;
+ top_cyclic = false;
/* now search the rest of this structure */
switch (type(top))
{
case T_PAIR:
+#if 0
+ /* old form: simple understandable slow */
if ((has_structure(car(top))) &&
(collect_shared_info(sc, ci, car(top), stop_at_print_length)))
top_cyclic = true;
if ((has_structure(cdr(top))) &&
(collect_shared_info(sc, ci, cdr(top), stop_at_print_length)))
top_cyclic = true;
+#endif
+ {
+ s7_pointer p, cp;
+ if ((has_structure(car(top))) &&
+ (collect_shared_info(sc, ci, car(top), stop_at_print_length)))
+ top_cyclic = true;
+ for (p = cdr(top); is_pair(p); p = cdr(p))
+ {
+ if (is_collected_or_shared(p))
+ {
+ if (is_shared(p))
+ {
+ if (!top_cyclic)
+ for (cp = top; cp != p; cp = cdr(cp)) set_shared(cp);
+ return(top_cyclic);
+ }
+ return(check_collected(p, ci));
+ }
+ set_collected(p);
+ if (ci->top == ci->size)
+ enlarge_shared_info(ci);
+ ci->objs[ci->top++] = p;
+ if ((has_structure(car(p))) &&
+ (collect_shared_info(sc, ci, car(p), stop_at_print_length)))
+ top_cyclic = true;
+ }
+ if ((has_structure(p)) &&
+ (collect_shared_info(sc, ci, p, stop_at_print_length)))
+ return(true);
+
+ if (!top_cyclic)
+ for (cp = top; is_pair(cp); cp = cdr(cp)) set_shared(cp);
+ return(top_cyclic);
+ }
break;
case T_VECTOR:
@@ -25779,8 +25880,7 @@ static bool collect_shared_info(s7_scheme *sc, shared_info *ci, s7_pointer top,
hash_entry_t **entries;
bool keys_safe;
- keys_safe = ((hash_table_checker(top) != hash_equal) &&
- (!hash_table_checker_locked(top)));
+ keys_safe = ((hash_table_checker(top) != hash_equal) && (!hash_table_checker_locked(top)));
entries = hash_table_elements(top);
len = hash_table_mask(top) + 1;
for (i = 0; i < len; i++)
@@ -25827,33 +25927,31 @@ static bool collect_shared_info(s7_scheme *sc, shared_info *ci, s7_pointer top,
return(top_cyclic);
}
+static shared_info *init_circle_info(void)
+{
+ shared_info *ci;
+ ci = (shared_info *)calloc(1, sizeof(shared_info));
+ ci->size = INITIAL_SHARED_INFO_SIZE;
+ ci->size2 = ci->size - 2;
+ ci->objs = (s7_pointer *)malloc(ci->size * sizeof(s7_pointer));
+ ci->refs = (int32_t *)calloc(ci->size, sizeof(int32_t)); /* finder expects 0 = unseen previously */
+ return(ci);
+}
static shared_info *new_shared_info(s7_scheme *sc)
{
shared_info *ci;
- if (!sc->circle_info)
- {
- ci = (shared_info *)calloc(1, sizeof(shared_info));
- ci->size = INITIAL_SHARED_INFO_SIZE;
- ci->objs = (s7_pointer *)malloc(ci->size * sizeof(s7_pointer));
- ci->refs = (int32_t *)calloc(ci->size, sizeof(int)); /* finder expects 0 = unseen previously */
- sc->circle_info = ci;
- }
- else
- {
- int32_t i;
- ci = sc->circle_info;
- memclr((void *)(ci->refs), ci->top * sizeof(int));
- for (i = 0; i < ci->top; i++)
- clear_collected_and_shared(ci->objs[i]);
- }
+ int32_t i;
+ ci = sc->circle_info;
+ memclr((void *)(ci->refs), ci->top * sizeof(int32_t));
+ for (i = 0; i < ci->top; i++)
+ clear_collected_and_shared(ci->objs[i]);
ci->top = 0;
ci->ref = 0;
ci->has_hits = false;
return(ci);
}
-
static shared_info *make_shared_info(s7_scheme *sc, s7_pointer top, bool stop_at_print_length)
{
/* for the printer */
@@ -25989,6 +26087,7 @@ static shared_info *make_shared_info(s7_scheme *sc, s7_pointer top, bool stop_at
return(ci);
}
+
/* -------------------------------- cyclic-sequences -------------------------------- */
static s7_pointer cyclic_sequences(s7_scheme *sc, s7_pointer obj, bool return_list)
@@ -26066,7 +26165,7 @@ static char *slashify_string(s7_scheme *sc, const char *p, int32_t len, bool quo
unsigned char *pcur, *pend;
pend = (unsigned char *)(p + len);
- size = len + 256;
+ size = len * 4 + 256;
if (size > sc->slash_str_size)
{
if (sc->slash_str) free(sc->slash_str);
@@ -26102,15 +26201,17 @@ static char *slashify_string(s7_scheme *sc, const char *p, int32_t len, bool quo
s[j++] = '\\';
switch (*pcur)
{
- case '"':
- s[j++] = '"';
- break;
-
- case '\\':
- s[j++] = '\\';
- break;
-
- default: /* this is the "\x01" stuff */
+ case '"': s[j++] = '"'; break;
+ case '\\': s[j++] = '\\'; break;
+ case '\'': s[j++] = '\''; break;
+ case '\t': s[j++] = 't'; break;
+ case '\r': s[j++] = 'r'; break;
+ case '\b': s[j++] = 'b'; break;
+ /* case '\v': s[j++] = 'v'; break; */
+ case '\f': s[j++] = 'f'; break;
+ case '\?': s[j++] = '?'; break;
+ case 'x': s[j++] = 'x'; break;
+ default:
{
uint32_t n;
static char dignum[] = "0123456789abcdef";
@@ -26120,20 +26221,19 @@ static char *slashify_string(s7_scheme *sc, const char *p, int32_t len, bool quo
s[j++] = '0';
else s[j++] = dignum[(n / 16) % 16];
s[j++] = dignum[n % 16];
+ s[j++] = ';';
}
break;
}
}
else s[j++] = *pcur;
- if (j >= cur_size) /* even with 256 extra, we can overflow (for example, inordinately many tabs in ALSA output) */
+ if (j >= cur_size)
{
- /* int32_t k; */
size *= 2;
sc->slash_str = (char *)realloc(sc->slash_str, size * sizeof(char));
sc->slash_str_size = size;
- cur_size = size - 2;
+ cur_size = size - 4;
s = sc->slash_str;
- /* for (k = j; k < size; k++) s[k] = 0; */
}
}
if (quoted) s[j++] = '"';
@@ -26346,7 +26446,7 @@ static void string_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use_w
{
int32_t nlen;
s7_pointer c;
- c = chars[(int)buf[0]];
+ c = chars[(int32_t)buf[0]];
nlen = snprintf(buf, 128, "(make-string %u ", string_length(obj));
port_write_string(port)(sc, buf, nlen, port);
port_write_string(port)(sc, character_name(c), character_name_length(c), port);
@@ -26877,10 +26977,10 @@ static void byte_vector_to_port(s7_scheme *sc, s7_pointer vect, s7_pointer port,
port_write_string(port)(sc, "#u8(", 4, port);
for (i = 0; i < len - 1; i++)
{
- p = pos_int_to_str((int)((unsigned char)string_value(vect)[i]), &nlen, ' ');
+ p = pos_int_to_str((int32_t)((unsigned char)string_value(vect)[i]), &nlen, ' ');
port_write_string(port)(sc, p, nlen - 1, port);
}
- p = pos_int_to_str((int)((unsigned char)string_value(vect)[i]), &nlen, (too_long) ? '\0' : ')');
+ p = pos_int_to_str((int32_t)((unsigned char)string_value(vect)[i]), &nlen, (too_long) ? '\0' : ')');
port_write_string(port)(sc, p, nlen - 1, port);
if (too_long)
@@ -27458,8 +27558,7 @@ static void write_closure_name(s7_scheme *sc, s7_pointer closure, s7_pointer por
static s7_pointer closure_name(s7_scheme *sc, s7_pointer closure)
{
- /* this is used by the error handlers to get the current function name
- */
+ /* this is used by the error handlers to get the current function name */
s7_pointer x;
x = find_closure(sc, closure, sc->envir);
@@ -27609,7 +27708,7 @@ static char *describe_type_bits(s7_scheme *sc, s7_pointer obj)
full_typ = typeflag(obj);
/* if debugging all of these bits are being watched, so we need to access them directly */
- snprintf(buf, 512, "type: %d (%s), flags: #x%" PRIx64 "%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s",
+ snprintf(buf, 512, "type: %d (%s), flags: #x%" PRIx64 "%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s",
typ,
type_name(sc, obj, NO_ARTICLE),
full_typ,
@@ -27695,10 +27794,14 @@ static char *describe_type_bits(s7_scheme *sc, s7_pointer obj)
((full_typ & T_GENSYM) != 0) ? ((is_let(obj)) ? " funclet" :
((is_symbol(obj)) ? " gensym" :
((is_string(obj)) ? " documented-symbol" :
- " ?21?"))) : "",
+ ((is_hash_table(obj)) ? " hash-chosen" :
+ ((is_pair(obj)) ? " dotted" :
+ " ?21?"))))) : "",
/* bit 22 */
((full_typ & T_HAS_METHODS) != 0) ? " has-methods" : "",
/* bit 23 */
+ ((full_typ & T_ITER_OK) != 0) ? " iter-ok" : "",
+ /* bit 55 */
(((full_typ & T_GC_MARK) != 0) && (in_heap(obj))) ? " gc-marked" : "");
return(buf);
}
@@ -27756,7 +27859,7 @@ static s7_pointer check_seti(s7_scheme *sc, s7_pointer x, const char *func, int3
static char *safe_object_to_string(s7_pointer p)
{
- int32_t typ;
+ uint8_t typ;
char *buf;
typ = unchecked_type(p);
if ((typ > T_FREE) && (typ < NUM_TYPES))
@@ -27766,13 +27869,13 @@ static char *safe_object_to_string(s7_pointer p)
return(buf);
}
-static s7_pointer check_ref(s7_pointer p, int32_t expected_type, const char *func, int32_t line, const char *func1, const char *func2)
+static s7_pointer check_ref(s7_pointer p, uint8_t expected_type, const char *func, int32_t line, const char *func1, const char *func2)
{
if (!p)
fprintf(stderr, "%s[%d]: null pointer passed to check_ref\n", func, line);
else
{
- int32_t typ;
+ uint8_t typ;
typ = unchecked_type(p);
if (typ != expected_type)
{
@@ -27798,13 +27901,13 @@ static s7_pointer check_ref(s7_pointer p, int32_t expected_type, const char *fun
return(p);
}
-static s7_pointer check_ref2(s7_pointer p, int32_t expected_type, int32_t other_type, const char *func, int32_t line, const char *func1, const char *func2)
+static s7_pointer check_ref2(s7_pointer p, uint8_t expected_type, int32_t other_type, const char *func, int32_t line, const char *func1, const char *func2)
{
if (!p)
fprintf(stderr, "%s[%d]: null pointer passed to check_ref2\n", func, line);
else
{
- int32_t typ;
+ uint8_t typ;
typ = unchecked_type(p);
if ((typ != expected_type) && (typ != other_type))
return(check_ref(p, expected_type, func, line, func1, func2));
@@ -27814,7 +27917,7 @@ static s7_pointer check_ref2(s7_pointer p, int32_t expected_type, int32_t other_
static s7_pointer check_ref3(s7_pointer p, const char *func, int32_t line)
{
- int32_t typ;
+ uint8_t typ;
typ = unchecked_type(p);
if ((typ != T_INPUT_PORT) && (typ != T_OUTPUT_PORT) && (typ != T_FREE))
{
@@ -27829,7 +27932,7 @@ static s7_pointer check_ref3(s7_pointer p, const char *func, int32_t line)
static s7_pointer check_ref4(s7_pointer p, const char *func, int32_t line)
{
- int32_t typ;
+ uint8_t typ;
typ = unchecked_type(p);
if ((typ != T_VECTOR) && (typ != T_FLOAT_VECTOR) && (typ != T_INT_VECTOR) && (typ != T_FREE))
{
@@ -27844,7 +27947,7 @@ static s7_pointer check_ref4(s7_pointer p, const char *func, int32_t line)
static s7_pointer check_ref5(s7_pointer p, const char *func, int32_t line)
{
- int32_t typ;
+ uint8_t typ;
typ = unchecked_type(p);
if (!t_has_closure_let[typ])
{
@@ -27859,7 +27962,7 @@ static s7_pointer check_ref5(s7_pointer p, const char *func, int32_t line)
static s7_pointer check_ref6(s7_pointer p, const char *func, int32_t line)
{
- int32_t typ;
+ uint8_t typ;
typ = unchecked_type(p);
if ((typ < T_C_FUNCTION_STAR) && (typ != T_C_MACRO))
{
@@ -27876,7 +27979,7 @@ static s7_pointer check_ref7(s7_pointer p, const char *func, int32_t line)
{
if ((!func) || (strcmp(func, "decribe_type_bits") != 0))
{
- int32_t typ;
+ uint8_t typ;
typ = unchecked_type(p);
if ((typ < T_INTEGER) || (typ > T_COMPLEX))
{
@@ -27892,7 +27995,7 @@ static s7_pointer check_ref7(s7_pointer p, const char *func, int32_t line)
static s7_pointer check_ref8(s7_pointer p, const char *func, int32_t line)
{
- int32_t typ;
+ uint8_t typ;
typ = unchecked_type(p);
if ((!t_sequence_p[typ]) && (!t_structure_p[typ]) && (!is_any_closure(p))) /* closure calling itself an iterator?? */
{
@@ -27907,9 +28010,9 @@ static s7_pointer check_ref8(s7_pointer p, const char *func, int32_t line)
static s7_pointer check_ref9(s7_pointer p, const char *func, int32_t line)
{
- int32_t typ;
+ uint8_t typ;
typ = unchecked_type(p);
- if ((typ != T_LET) && (typ != T_C_OBJECT) && (!is_any_closure(p)) && (!is_any_macro(p)))
+ if ((typ != T_LET) && (typ != T_C_OBJECT) && (!is_any_closure(p)) && (!is_any_macro(p)) && (typ != T_C_POINTER))
{
fprintf(stderr, "%s%s[%d]: not a possible method holder, but %s (%s)%s\n",
BOLD_TEXT,
@@ -27922,7 +28025,7 @@ static s7_pointer check_ref9(s7_pointer p, const char *func, int32_t line)
static s7_pointer check_ref10(s7_pointer p, const char *func, int32_t line)
{
- int32_t typ;
+ uint8_t typ;
typ = unchecked_type(p);
if ((typ != T_PAIR) && (typ != T_NIL) && (typ != T_SYMBOL))
{
@@ -27937,9 +28040,9 @@ static s7_pointer check_ref10(s7_pointer p, const char *func, int32_t line)
static s7_pointer check_ref11(s7_pointer p, const char *func, int32_t line)
{
- int32_t typ;
+ uint8_t typ;
typ = unchecked_type(p);
- if ((typ < T_CLOSURE) && (typ != T_BOOLEAN)) /* actually #t is an error here */
+ if ((typ < T_CLOSURE) && (typ != T_BOOLEAN) && (typ != T_PAIR)) /* actually #t is an error here */
{
fprintf(stderr, "%s%s[%d]: setter is %s (%s)%s?\n",
BOLD_TEXT,
@@ -27973,7 +28076,7 @@ static s7_pointer check_sym(s7_scheme *sc, s7_pointer sym)
static s7_pointer check_cell(s7_pointer p, const char *func, int32_t line)
{
- int32_t typ;
+ uint8_t typ;
if (!p)
{
fprintf(stderr, "%s%s[%d]: null pointer!%s\n", BOLD_TEXT, func, line, UNBOLD_TEXT);
@@ -27990,7 +28093,7 @@ static s7_pointer check_cell(s7_pointer p, const char *func, int32_t line)
static s7_pointer check_nref(s7_pointer p, const char *func, int32_t line)
{
- int32_t typ;
+ uint8_t typ;
check_cell(p, func, line);
typ = unchecked_type(p);
if (typ == T_FREE)
@@ -28042,7 +28145,7 @@ static const char *opt1_role_name(int32_t role)
static const char *opt2_role_name(int32_t role)
{
if (role == F_CALL) return("c_call(ee)");
- if (role == F_KEY) return("opt_key");
+ if (role == F_KEY) return("opt_any2");
if (role == F_SLOW) return("opt_slow");
if (role == F_SYM) return("opt_sym2");
if (role == F_PAIR) return("opt_pair2");
@@ -28055,7 +28158,7 @@ static const char *opt3_role_name(int32_t role)
{
if (role == G_ARGLEN) return("arglist_length");
if (role == G_SYM) return("opt_sym3");
- if (role == G_AND) return("opt_and_2_test or opt_else");
+ if (role == G_AND) return("opt_pair3 or opt_any3");
if (role == G_DIRECT) return("direct_opt3");
if (role == S_OP) return("s_op");
if (role == S_SYNOP) return("s_synop");
@@ -28083,7 +28186,7 @@ static char* show_debugger_bits(uint32_t bits)
((bits & E_ANY) != 0) ? " opt_any1" : "",
((bits & E_SLOT) != 0) ? " opt_slot1" : "",
((bits & F_SET) != 0) ? " f-set" : "",
- ((bits & F_KEY) != 0) ? " opt_key" : "",
+ ((bits & F_KEY) != 0) ? " opt_any2" : "",
((bits & F_SLOW) != 0) ? " opt_slow" : "",
((bits & F_SYM) != 0) ? " opt_sym2" : "",
((bits & F_PAIR) != 0) ? " opt_pair2" : "",
@@ -28093,7 +28196,7 @@ static char* show_debugger_bits(uint32_t bits)
((bits & G_SET) != 0) ? " g-set" : "",
((bits & G_ARGLEN) != 0) ? " arglist_length" : "",
((bits & G_SYM) != 0) ? " opt_sym3" : "",
- ((bits & G_AND) != 0) ? " opt_and_2_test or opt_else " : "",
+ ((bits & G_AND) != 0) ? " opt_pair3 or opt_any3 " : "",
((bits & G_DIRECT) != 0) ? " opt_direct_x3" : "",
((bits & S_NAME) != 0) ? " raw-name" : "",
((bits & S_HASH) != 0) ? " raw-hash" : "",
@@ -28392,7 +28495,7 @@ static s7_pointer check_null_sym(s7_scheme *sc, s7_pointer p, s7_pointer sym, in
/* these are bits usable on (say) let code without colliding with other pair-wise uses */
/* we need has_all_x = T_SETTER currently
* T_MUTABLE and T_SAFE_STEPPER are let_ref|set fallback bits
- * T_IMMUTABLE is hard to predict, T_GENSYM marks list_in_use and other pair-wise stuff
+ * T_IMMUTABLE is hard to predict,
* maybe T_SAFE_STEPPER for unsafe_locals
*/
static void check_pair_bits(s7_scheme *sc, s7_pointer p)
@@ -28467,7 +28570,7 @@ static void c_pointer_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, us
if (use_write == USE_READABLE_WRITE)
{
- nlen = snprintf(buf, 128, "(c-pointer " INT_FORMAT, (ptr_int)raw_pointer(obj));
+ nlen = snprintf(buf, 128, "(c-pointer %" PRIdPTR, (intptr_t)raw_pointer(obj));
port_write_string(port)(sc, buf, nlen, port);
if ((raw_pointer_type(obj) != sc->F) ||
(raw_pointer_info(obj) != sc->F))
@@ -28685,8 +28788,8 @@ static void c_object_to_port(s7_scheme *sc, s7_pointer obj, s7_pointer port, use
{
char *str;
if (use_write == USE_READABLE_WRITE)
- str = ((*(c_object_print_readably(obj)))(sc, c_object_value(obj)));
- else str = ((*(c_object_print(obj)))(sc, c_object_value(obj)));
+ str = ((*(c_object_print_readably(sc, obj)))(sc, c_object_value(obj)));
+ else str = ((*(c_object_print(sc, obj)))(sc, c_object_value(obj)));
port_display(port)(sc, str, port);
free(str);
}
@@ -28999,11 +29102,19 @@ static s7_pointer g_write(s7_scheme *sc, s7_pointer args)
return(object_out(sc, car(args), port, USE_WRITE));
}
-static s7_pointer write_p_p(s7_pointer x) {return(object_out(cur_sc, x, cur_sc->output_port, USE_WRITE));}
+static s7_pointer write_p_p(s7_pointer x)
+{
+ if (cur_sc->output_port == cur_sc->F) return(x);
+ return(object_out(cur_sc, x, cur_sc->output_port, USE_WRITE));
+}
static s7_pointer write_p_pp(s7_pointer x, s7_pointer port)
{
if (port == cur_sc->F)
return(x);
+ if ((!is_output_port(port)) ||
+ (port_is_closed(port)))
+ s7_wrong_type_arg_error(cur_sc, "write", 2, port, "an open output port");
+ if (port == cur_sc->F) return(x);
return(object_out(cur_sc, x, port, USE_WRITE));
}
@@ -29038,11 +29149,19 @@ static s7_pointer g_display(s7_scheme *sc, s7_pointer args)
return(object_out(sc, car(args), port, USE_DISPLAY));
}
-static s7_pointer display_p_p(s7_pointer x) {return(object_out(cur_sc, x, cur_sc->output_port, USE_DISPLAY));}
+static s7_pointer display_p_p(s7_pointer x)
+{
+ if (cur_sc->output_port == cur_sc->F) return(x);
+ return(object_out(cur_sc, x, cur_sc->output_port, USE_DISPLAY));
+}
static s7_pointer display_p_pp(s7_pointer x, s7_pointer port)
{
if (port == cur_sc->F)
return(x);
+ if ((!is_output_port(port)) ||
+ (port_is_closed(port)))
+ s7_wrong_type_arg_error(cur_sc, "display", 2, port, "an open output port");
+ if (port == cur_sc->F) return(x);
return(object_out(cur_sc, x, port, USE_DISPLAY));
}
@@ -29064,7 +29183,7 @@ static s7_pointer g_call_with_output_string(s7_scheme *sc, s7_pointer args)
return(wrong_type_argument_with_type(sc, sc->call_with_output_string_symbol, 1, proc, a_normal_procedure_string));
port = s7_open_output_string(sc);
- push_stack(sc, OP_GET_OUTPUT_STRING_1, sc->F, port);
+ push_stack(sc, OP_GET_OUTPUT_STRING_1, sc->F, port); /* args checked in call_with_exit */
push_stack(sc, OP_APPLY, list_1(sc, port), proc);
return(sc->F);
}
@@ -29111,7 +29230,6 @@ static s7_pointer g_with_output_to_string(s7_scheme *sc, s7_pointer args)
old_output_port = sc->output_port;
sc->output_port = s7_open_output_string(sc);
push_stack(sc, OP_GET_OUTPUT_STRING_1, old_output_port, sc->output_port);
-
push_stack(sc, OP_APPLY, sc->nil, p);
return(sc->F);
}
@@ -29139,7 +29257,6 @@ static s7_pointer g_with_output_to_file(s7_scheme *sc, s7_pointer args)
old_output_port = sc->output_port;
sc->output_port = s7_open_output_file(sc, string_value(file), "w");
push_stack(sc, OP_UNWIND_OUTPUT, old_output_port, sc->output_port);
-
push_stack(sc, OP_APPLY, sc->nil, proc);
return(sc->F);
}
@@ -29374,7 +29491,7 @@ static int32_t format_n_arg(s7_scheme *sc, const char *str, int32_t str_len, for
just_format_error(sc, "~~N: missing argument", str, args, fdat);
if (!s7_is_integer(car(fdat->args)))
just_format_error(sc, "~~N: integer argument required", str, args, fdat);
- n = (int)s7_integer(car(fdat->args));
+ n = (int32_t)s7_integer(car(fdat->args));
if (n < 0)
just_format_error(sc, "~~N value is negative?", str, args, fdat);
@@ -29563,6 +29680,8 @@ static s7_pointer format_to_port_1(s7_scheme *sc, s7_pointer port, const char *s
i += 2;
if ((str[i] != 'P') && (str[i] != 'p'))
format_error(sc, "unknown '@' directive", str, args, fdat);
+ if (!is_pair(fdat->args))
+ format_error(sc, "'@' directive argument missing", str, args, fdat);
if (!s7_is_real(car(fdat->args))) /* CL accepts non numbers here */
format_error(sc, "'@P' directive argument is not a real number", str, args, fdat);
@@ -29574,6 +29693,8 @@ static s7_pointer format_to_port_1(s7_scheme *sc, s7_pointer port, const char *s
break;
case 'P': case 'p': /* -------- plural in 's' -------- */
+ if (!is_pair(fdat->args))
+ format_error(sc, "'P' directive argument missing", str, args, fdat);
if (!s7_is_real(car(fdat->args)))
format_error(sc, "'P' directive argument is not a real number", str, args, fdat);
if (!s7_is_one_or_big_one(car(fdat->args)))
@@ -29603,6 +29724,7 @@ static s7_pointer format_to_port_1(s7_scheme *sc, s7_pointer port, const char *s
if (is_not_null(car(fdat->args))) /* (format #f "~{~A ~}" ()) -> "" */
{
s7_pointer curly_arg;
+ /* perhaps use an iterator here -- rootlet->list is expensive! */
curly_arg = object_to_list(sc, car(fdat->args)); /* if a pair, this simply returns the original */
if (is_not_null(curly_arg)) /* (format #f "~{~A ~}" #()) -> "" */
{
@@ -29731,7 +29853,7 @@ static s7_pointer format_to_port_1(s7_scheme *sc, s7_pointer port, const char *s
char pad = ' ';
i++; /* str[i] == '~' */
- if (isdigit((int)(str[i])))
+ if (isdigit((int32_t)(str[i])))
width = format_numeric_arg(sc, str, str_len, fdat, args, &i);
else
{
@@ -29744,7 +29866,7 @@ static s7_pointer format_to_port_1(s7_scheme *sc, s7_pointer port, const char *s
if (str[i] == ',')
{
i++; /* is (format #f "~12,12D" 1) an error? The precision has no use here. */
- if (isdigit((int)(str[i])))
+ if (isdigit((int32_t)(str[i])))
precision = format_numeric_arg(sc, str, str_len, fdat, args, &i);
else
{
@@ -29785,7 +29907,7 @@ static s7_pointer format_to_port_1(s7_scheme *sc, s7_pointer port, const char *s
if (precision > 0)
{
int32_t mult;
- mult = (int)(ceil((s7_double)(sc->format_column + 1 - width) / (s7_double)precision)); /* CLtL2 ("least positive int") */
+ mult = (int32_t)(ceil((s7_double)(sc->format_column + 1 - width) / (s7_double)precision)); /* CLtL2 ("least positive int") */
if (mult < 1) mult = 1;
width += (precision * mult);
}
@@ -29930,7 +30052,7 @@ static s7_pointer format_to_port_1(s7_scheme *sc, s7_pointer port, const char *s
p = (char *)strchr((const char *)(str + i + 1), (int)'~');
if (!p)
j = str_len;
- else j = (int)(p - str);
+ else j = (int32_t)(p - str);
new_len = j - i;
if ((port_data(port)) &&
@@ -30034,6 +30156,8 @@ static s7_pointer g_format_1(s7_scheme *sc, s7_pointer args)
(!port_is_closed(pt)))))
method_or_bust_with_type(sc, pt, sc->format_symbol, args, an_output_port_string, 1);
+ if (!is_pair(cdr(args))) /* (format #f) */
+ return(s7_error(sc, sc->format_error_symbol, set_elist_2(sc, s7_make_string_with_length(sc, "format has no control string: ~S", 32), args)));
str = cadr(args);
if (!is_string(str))
method_or_bust(sc, str, sc->format_symbol, args, T_STRING, 2);
@@ -30169,9 +30293,9 @@ static s7_pointer g_getenv(s7_scheme *sc, s7_pointer args)
static s7_pointer g_system(s7_scheme *sc, s7_pointer args)
{
- #define H_system "(system command) executes the command. If the optional second it is #t, \
+ #define H_system "(system command) executes the command. If the optional second argument is #t, \
system captures the output as a string and returns it."
- #define Q_system s7_make_signature(sc, 3, sc->T, sc->is_string_symbol, sc->is_boolean_symbol)
+ #define Q_system s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->is_integer_symbol, sc->is_string_symbol), sc->is_string_symbol, sc->is_boolean_symbol)
s7_pointer name;
name = car(args);
@@ -30291,7 +30415,7 @@ static s7_pointer cons_unchecked(s7_scheme *sc, s7_pointer a, s7_pointer b)
}
-static s7_pointer permanent_cons(s7_pointer a, s7_pointer b, uint32_t type)
+static s7_pointer permanent_cons(s7_pointer a, s7_pointer b, uint64_t type)
{
/* for the symbol table which is never GC'd (and its contents aren't marked) */
s7_pointer x;
@@ -30414,14 +30538,14 @@ s7_pointer s7_cddaar(s7_pointer p) {return(cddaar(p));}
s7_pointer s7_set_car(s7_pointer p, s7_pointer q)
{
set_car(p, q);
- return(p);
+ return(q); /* was p? 5-Aug-17 */
}
s7_pointer s7_set_cdr(s7_pointer p, s7_pointer q)
{
set_cdr(p, q);
- return(p);
+ return(q); /* was p? 5-Aug-17 */
}
/* -------------------------------------------------------------------------------- */
@@ -30764,16 +30888,17 @@ static bool symbol_is_in_arg_list(s7_pointer sym, s7_pointer lst)
return(sym == x);
}
-
static s7_int tree_len_1(s7_scheme *sc, s7_pointer p)
{
s7_int sum;
- if ((!is_pair(p)) ||
- (car(p) == sc->quote_symbol))
- return(1);
for (sum = 0; is_pair(p); p = cdr(p))
- sum += tree_len_1(sc, car(p));
- if (!is_null(p)) sum++;
+ {
+ if ((!is_pair(car(p))) ||
+ (caar(p) == sc->quote_symbol))
+ sum++;
+ else sum += tree_len_1(sc, car(p));
+ }
+ if (!is_null(p)) return(sum + 1);
return(sum);
}
@@ -30781,13 +30906,13 @@ static s7_int tree_len(s7_scheme *sc, s7_pointer p)
{
if (is_null(p))
return(0);
+ if ((!is_pair(p)) ||
+ (car(p) == sc->quote_symbol))
+ return(1);
return(tree_len_1(sc, p));
}
-static s7_int tree_leaves_i(s7_pointer p)
-{
- return(tree_len(cur_sc, p));
-}
+static s7_int tree_leaves_i(s7_pointer p) {return(tree_len(cur_sc, p));}
static s7_pointer g_tree_leaves(s7_scheme *sc, s7_pointer args)
{
@@ -30808,13 +30933,12 @@ bool s7_tree_memq(s7_scheme *sc, s7_pointer sym, s7_pointer tree)
return(sym == cadr(tree));
}
do {
- if ((sym == cdr(tree)) ||
+ if ((sym == cdr(tree)) || /* "sym" need not be a symbol */
(s7_tree_memq(sc, sym, car(tree))))
return(true);
tree = cdr(tree);
} while (is_pair(tree));
- return((!is_null(tree)) &&
- (sym == tree));
+ return(false);
}
static s7_pointer g_tree_memq(s7_scheme *sc, s7_pointer args)
@@ -30835,14 +30959,11 @@ static bool tree_set_memq(s7_scheme *sc, s7_pointer tree)
(car(tree) == sc->quote_symbol))
return(false);
do {
- if (is_symbol(cdr(tree)))
- return(symbol_is_in_list(sc, cdr(tree)));
if (tree_set_memq(sc, car(tree)))
return(true);
tree = cdr(tree);
} while (is_pair(tree));
- return((is_symbol(tree)) &&
- (symbol_is_in_list(sc, tree)));
+ return((is_symbol(tree)) && (symbol_is_in_list(sc, tree)));
}
static s7_pointer g_tree_set_memq(s7_scheme *sc, s7_pointer args)
@@ -31052,9 +31173,6 @@ static s7_pointer safe_reverse_in_place(s7_scheme *sc, s7_pointer list) /* "safe
}
-/* is this correct? (let ((x (list 1 2))) (eq? x (append () x))) -> #t
- */
-
s7_pointer s7_append(s7_scheme *sc, s7_pointer a, s7_pointer b)
{
s7_pointer p, tp, np;
@@ -31131,7 +31249,6 @@ static int32_t safe_list_length(s7_scheme *sc, s7_pointer a)
return(i);
}
-
int s7_list_length(s7_scheme *sc, s7_pointer a)
{
/* returns -len if list is dotted, 0 if it's (directly) circular */
@@ -31292,7 +31409,7 @@ static s7_pointer g_make_list(s7_scheme *sc, s7_pointer args)
if (is_pair(cdr(args)))
init = cadr(args);
else init = sc->F;
- return(make_list(sc, (int)len, init));
+ return(make_list(sc, (int32_t)len, init));
}
@@ -32491,7 +32608,17 @@ static s7_pointer g_memq(s7_scheme *sc, s7_pointer args)
/* if memq's list is a quoted list, it won't be changing, so we can tell ahead of time that it is
* a proper list, and what its length is.
*/
-static s7_pointer memq_3, memq_4, memq_any;
+static s7_pointer memq_2, memq_3, memq_4, memq_any;
+
+static s7_pointer g_memq_2(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x, obj;
+ x = cadr(args);
+ obj = car(args);
+ if (obj == car(x)) return(x);
+ if (obj == cadr(x)) return(cdr(x));
+ return(sc->F);
+}
static s7_pointer g_memq_3(s7_scheme *sc, s7_pointer args)
{
@@ -32559,23 +32686,16 @@ static s7_pointer g_memq_any(s7_scheme *sc, s7_pointer args)
}
-static s7_pointer memq_car;
+static s7_pointer memq_car, memq_car_2;
static s7_pointer g_memq_car(s7_scheme *sc, s7_pointer args)
{
s7_pointer x, obj;
- obj = find_symbol_unchecked(sc, cadar(args));
- if (!is_pair(obj))
- {
- s7_pointer func;
- if ((has_methods(obj)) &&
- ((func = find_method(sc, find_let(sc, obj), sc->car_symbol)) != sc->undefined))
- obj = s7_apply_function(sc, func, list_1(sc, obj));
- if (!is_pair(obj))
- return(simple_wrong_type_argument(sc, sc->car_symbol, obj, T_PAIR));
- }
- obj = car(obj);
- x = cadadr(args);
+ obj = find_symbol_unchecked(sc, opt_sym2(args));
+ if (is_pair(obj))
+ obj = car(obj);
+ else obj = g_car(sc, set_plist_1(sc, obj));
+ x = opt_pair3(args);
while (true)
{
@@ -32590,23 +32710,43 @@ static s7_pointer g_memq_car(s7_scheme *sc, s7_pointer args)
return(sc->F);
}
+static s7_pointer g_memq_car_2(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer x, obj;
+
+ obj = find_symbol_unchecked(sc, opt_sym2(args));
+ if (is_pair(obj))
+ obj = car(obj);
+ else obj = g_car(sc, set_plist_1(sc, obj));
+ x = opt_pair3(args);
+ if (obj == car(x)) return(x);
+ if (obj == cadr(x)) return(cdr(x));
+ return(sc->F);
+}
+
static s7_pointer memq_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops)
{
if ((is_proper_quote(sc, caddr(expr))) &&
(is_pair(cadr(caddr(expr)))))
{
int32_t len;
+ len = s7_list_length(sc, cadr(caddr(expr)));
if ((ops) && (is_h_safe_c_s(cadr(expr))) &&
(c_callee(cadr(expr)) == g_car))
{
set_optimize_op(expr, HOP_SAFE_C_C);
+ set_opt_sym2(cdr(expr), cadadr(expr));
+ set_opt_pair3(cdr(expr), cadr(caddr(expr)));
+ if (len == 2)
+ return(memq_car_2);
return(memq_car);
}
- len = s7_list_length(sc, cadr(caddr(expr)));
if (len > 0)
{
+ if (len == 2)
+ return(memq_2);
if ((len % 4) == 0)
return(memq_4);
if ((len % 3) == 0)
@@ -33075,12 +33215,21 @@ static s7_pointer g_features_set(s7_scheme *sc, s7_pointer args)
return(sc->error_symbol);
}
-
static s7_pointer g_list(s7_scheme *sc, s7_pointer args)
{
#define H_list "(list ...) returns its arguments in a list"
#define Q_list s7_make_circular_signature(sc, 1, 2, sc->is_proper_list_symbol, sc->T)
- return(copy_list(sc, args));
+
+ if (is_pair(args))
+ {
+ if (is_null(cdr(args)))
+ return(cons(sc, car(args), sc->nil));
+ if (is_null(cddr(args)))
+ return(list_2(sc, car(args), cadr(args)));
+
+ return(copy_list(sc, args));
+ }
+ return(sc->nil);
}
static void check_list_validity(s7_scheme *sc, const char *caller, s7_pointer lst)
@@ -33314,7 +33463,7 @@ static s7_pointer make_simple_float_vector(s7_scheme *sc, s7_int len) /* len >=
return(x);
}
-static s7_pointer make_vector_1(s7_scheme *sc, s7_int len, bool filled, uint32_t typ)
+static s7_pointer make_vector_1(s7_scheme *sc, s7_int len, bool filled, uint64_t typ)
{
s7_pointer x;
if (len < 0)
@@ -33534,7 +33683,7 @@ static void vector_fill(s7_scheme *sc, s7_pointer vec, s7_pointer obj)
case T_INT_VECTOR:
if (!s7_is_integer(obj)) /* possibly a bignum */
- s7_wrong_type_arg_error(sc, "(int) vector-fill!", 2, obj, "an integer");
+ s7_wrong_type_arg_error(sc, "int-vector fill!", 2, obj, "an integer");
else
{
s7_int k;
@@ -33625,7 +33774,7 @@ static s7_pointer g_vector_fill(s7_scheme *sc, s7_pointer args)
if (!s7_is_integer(fill))
{
check_two_methods(sc, fill, sc->vector_fill_symbol, sc->fill_symbol, args);
- s7_wrong_type_arg_error(sc, "(int) vector-fill!", 2, fill, "an integer");
+ s7_wrong_type_arg_error(sc, "int-vector fill!", 2, fill, "an integer");
}
}
}
@@ -33748,7 +33897,7 @@ s7_int *s7_vector_offsets(s7_pointer vec)
#if (!WITH_PURE_S7)
-static s7_pointer vector_append(s7_scheme *sc, s7_pointer args, int32_t typ);
+static s7_pointer vector_append(s7_scheme *sc, s7_pointer args, uint8_t typ);
static s7_pointer g_vector_append(s7_scheme *sc, s7_pointer args)
{
@@ -34420,37 +34569,6 @@ static s7_pointer g_vector_ref_ic_2(s7_scheme *sc, s7_pointer args) {return(g_ve
static s7_pointer vector_ref_ic_3;
static s7_pointer g_vector_ref_ic_3(s7_scheme *sc, s7_pointer args) {return(g_vector_ref_ic_n(sc, args, 3));}
-static s7_pointer vector_ref_add1;
-static s7_pointer g_vector_ref_add1(s7_scheme *sc, s7_pointer args)
-{
- /* (vector-ref v (+ s 1)) I think */
- s7_pointer vec, x;
- s7_int index;
-
- vec = find_symbol_unchecked(sc, car(args));
- x = find_symbol_unchecked(sc, cadadr(args));
-
- if (!s7_is_integer(x))
- method_or_bust(sc, x, sc->vector_ref_symbol, list_2(sc, vec, x), T_INTEGER, 2);
- index = s7_integer(x) + 1;
-
- if (!s7_is_vector(vec))
- method_or_bust(sc, vec, sc->vector_ref_symbol, list_2(sc, vec, s7_make_integer(sc, index)), T_VECTOR, 1);
-
- if ((index < 0) ||
- (index >= vector_length(vec)))
- return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), cadr(args), (index < 0) ? its_negative_string : its_too_large_string));
-
- if (vector_rank(vec) > 1)
- {
- if (index >= vector_dimension(vec, 0))
- return(out_of_range(sc, sc->vector_ref_symbol, small_int(2), cadr(args), its_too_large_string));
- return(make_shared_vector(sc, vec, 1, index * vector_offset(vec, 0)));
- }
- return(vector_getter(vec)(sc, vec, index));
-}
-
-
static s7_pointer vector_ref_2;
static s7_pointer g_vector_ref_2(s7_scheme *sc, s7_pointer args)
{
@@ -34975,7 +35093,7 @@ static s7_pointer g_multivector(s7_scheme *sc, s7_int dims, s7_pointer data)
if (is_null(data)) /* dims are already 0 (calloc above) */
return(g_make_vector(sc, set_plist_1(sc, make_list(sc, dims, small_int(0)))));
- sizes = (int32_t *)calloc(dims, sizeof(int));
+ sizes = (int32_t *)calloc(dims, sizeof(int32_t));
for (x = data, i = 0; i < dims; i++)
{
sizes[i] = safe_list_length(sc, x);
@@ -35200,21 +35318,23 @@ static s7_pointer univect_set(s7_scheme *sc, s7_pointer args, bool flt)
}
else
{
- if (!s7_is_integer(cadr(args)))
+ s7_pointer p;
+ p = cdr(args);
+ if (!s7_is_integer(car(p)))
{
- s7_pointer p;
- if (!s7_is_integer(p = check_values(sc, cadr(args), cdr(args))))
- method_or_bust(sc, cadr(args), caller, args, T_INTEGER, 2);
- index = s7_integer(p);
+ s7_pointer z;
+ if (!s7_is_integer(z = check_values(sc, car(p), p)))
+ method_or_bust(sc, car(p), caller, args, T_INTEGER, 2);
+ index = s7_integer(z);
}
- else index = s7_integer(cadr(args));
+ else index = s7_integer(car(p));
if ((index < 0) ||
(index >= vector_length(vec)))
- return(out_of_range(sc, caller, small_int(2), cadr(args), (index < 0) ? its_negative_string : its_too_large_string));
+ return(out_of_range(sc, caller, small_int(2), car(p), (index < 0) ? its_negative_string : its_too_large_string));
- if (is_not_null(cdddr(args)))
+ if (is_not_null(cddr(p)))
return(s7_wrong_number_of_args_error(sc, "too many args: ~S", args));
- val = caddr(args);
+ val = cadr(p);
}
if (flt)
@@ -35530,7 +35650,7 @@ static int32_t closure_compare_begin(const void *v1, const void *v2)
static s7_pointer g_sort(s7_scheme *sc, s7_pointer args)
{
#define H_sort "(sort! sequence less?) sorts a sequence using the function 'less?' to compare elements."
- #define Q_sort s7_make_signature(sc, 3, sc->T, sc->is_sequence_symbol, sc->is_procedure_symbol)
+ #define Q_sort s7_make_signature(sc, 3, sc->is_sequence_symbol, sc->is_sequence_symbol, sc->is_procedure_symbol)
s7_pointer data, lessp, lx;
s7_int len = 0, n, k;
@@ -35602,12 +35722,12 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args)
* but that is irrelevant at this point -- if c_function_is_ok, we're good to go.
*/
(((optimize_op(expr) & 1) != 0) ||
- (c_function_is_ok(sc, expr))))
+ ((is_global(car(expr))) && /* (sort! x (lambda (car y) (car x)...))! */
+ (c_function_is_ok(sc, expr)))))
{
int32_t orig_data;
orig_data = optimize_op(expr);
set_optimize_op(expr, optimize_op(expr) | 1);
- /* fprintf(stderr, "%s\n", opt_names[orig_data]); */
if (((optimize_op(expr) == HOP_SAFE_C_SS) || (optimize_op(expr) == HOP_SAFE_C_LL)) &&
(car(largs) == cadr(expr)) &&
(cadr(largs) == caddr(expr)))
@@ -35975,7 +36095,7 @@ static s7_pointer g_sort(s7_scheme *sc, s7_pointer args)
}
n = len - 1;
- k = ((int)(n / 2)) + 1;
+ k = ((int32_t)(n / 2)) + 1;
lx = s7_make_vector(sc, (sc->safety == NO_SAFETY) ? 4 : 6);
gc_loc = s7_gc_protect(sc, lx);
@@ -36218,7 +36338,7 @@ static uint32_t hash_map_ci_string(s7_scheme *sc, s7_pointer table, s7_pointer k
int32_t len;
len = string_length(key);
if (len == 0) return(0);
- return(len + (uppers[(int)(string_value(key)[0])] << 4));
+ return(len + (uppers[(int32_t)(string_value(key)[0])] << 4));
}
#endif
@@ -36230,7 +36350,7 @@ static uint32_t hash_map_real(s7_scheme *sc, s7_pointer table, s7_pointer key)
* we need round, not floor for the location calculation in the real/complex cases else
* 1-eps doesn't match 1.0, but 1+eps does. And what if round(val) is too big for int?
* lrint is complex and requires special compiler flags to get any speed (-fno-math-errno).
- * all we need is (int)(val+0.5) -- all the other stuff is pointless in this context
+ * all we need is (int32_t)(val+0.5) -- all the other stuff is pointless in this context
*/
}
@@ -36368,7 +36488,7 @@ static uint32_t hash_map_let(s7_scheme *sc, s7_pointer table, s7_pointer key)
static uint32_t hash_map_pair(s7_scheme *sc, s7_pointer table, s7_pointer key)
{
/* len+loc(car) is not horrible, but it means (for example) every list '(set! ...) is hashed to the same location,
- * so at least we need to take cadr into account if possible. Better would combine the list_length(max 5 == safe_strlen5?) call
+ * so at least we need to take cadr into account if possible. Better would combine the list_length
* with stats like symbols/pairs/constants at top level, then use those to spread it out over all the locs.
*/
s7_pointer p1;
@@ -36605,12 +36725,12 @@ static hash_entry_t *hash_equal_any(s7_scheme *sc, s7_pointer table, s7_pointer
/* we can get into an infinite loop here, but it requires 2 hash tables that are members of each other
* and key is one of them, so I changed the equality check above to use eq? -- not sure this is right.
*/
- /* hope for an easy case... */
-
+#if 0
+ /* hope for an easy case... (apparently this never happens) */
for (x = hash_table_element(table, loc); x; x = x->next)
if (x->key == key)
return(x);
-
+#endif
for (x = hash_table_element(table, loc); x; x = x->next)
if (s7_is_equal(sc, x->key, key))
return(x);
@@ -36806,7 +36926,10 @@ static s7_pointer remove_from_hash_table(s7_scheme *sc, s7_pointer table, s7_poi
hash_table_entries(table)--;
if ((hash_table_entries(table) == 0) &&
(!hash_table_checker_locked(table)))
- hash_table_checker(table) = hash_empty;
+ {
+ hash_table_checker(table) = hash_empty;
+ hash_clear_chosen(table);
+ }
x->next = hash_free_list;
hash_free_list = x;
return(sc->F);
@@ -36895,8 +37018,18 @@ static s7_pointer g_make_hash_table(s7_scheme *sc, s7_pointer args)
return(wrong_type_argument_with_type(sc, sc->make_hash_table_symbol, 3, proc, an_eq_func_string));
ht = s7_make_hash_table(sc, size);
+ hash_set_chosen(ht);
if (c_function_call(proc) == g_is_equal)
- return(ht);
+ {
+ hash_table_checker(ht) = hash_equal;
+ return(ht);
+ }
+ if (c_function_call(proc) == g_is_morally_equal)
+ {
+ hash_table_checker(ht) = hash_morally_equal;
+ hash_table_mapper(ht) = morally_equal_hash_map;
+ return(ht);
+ }
if (c_function_call(proc) == g_is_eq)
{
hash_table_checker(ht) = hash_eq;
@@ -36946,12 +37079,6 @@ static s7_pointer g_make_hash_table(s7_scheme *sc, s7_pointer args)
hash_table_mapper(ht) = eqv_hash_map;
return(ht);
}
- if (c_function_call(proc) == g_is_morally_equal)
- {
- hash_table_checker(ht) = hash_morally_equal;
- hash_table_mapper(ht) = morally_equal_hash_map;
- return(ht);
- }
return(wrong_type_argument_with_type(sc, sc->make_hash_table_symbol, 3, proc, s7_make_string_wrapper(sc, "a hash function")));
}
/* proc not c_function */
@@ -36970,6 +37097,7 @@ static s7_pointer g_make_hash_table(s7_scheme *sc, s7_pointer args)
{
s7_pointer sig;
ht = s7_make_hash_table(sc, size);
+ hash_set_chosen(ht);
if (is_any_c_function(checker))
{
sig = c_function_signature(checker);
@@ -37110,8 +37238,7 @@ void init_hash_maps(void)
static uint32_t resize_hash_table(s7_scheme *sc, s7_pointer table)
{
/* resize the table */
- uint32_t hash_len, loc;
- int32_t i, old_size, new_size;
+ uint32_t hash_len, loc, i, old_size, new_size;
hash_entry_t **new_els, **old_els;
old_size = hash_table_mask(table) + 1;
@@ -37208,7 +37335,7 @@ static s7_pointer g_hash_table_ref_car(s7_scheme *sc, s7_pointer args)
hash_entry_t *x;
table = find_symbol_unchecked(sc, car(args));
- y = find_symbol_unchecked(sc, cadadr(args));
+ y = find_symbol_unchecked(sc, opt_sym3(args));
if (!is_pair(y))
return(simple_wrong_type_argument(sc, sc->car_symbol, y, T_PAIR));
@@ -37235,14 +37362,18 @@ static s7_pointer hash_table_ref_p_pp_direct(s7_pointer p1, s7_pointer p2)
/* -------------------------------- hash-table-set! -------------------------------- */
-static void hash_table_set_function(s7_pointer table, int32_t typ)
+static void hash_table_set_checker(s7_pointer table, uint8_t typ)
{
- if ((hash_table_checker(table) != hash_equal) &&
+ if (/* (hash_table_checker(table) != hash_equal) && */
(hash_table_checker(table) != default_hash_checks[typ]))
{
if (hash_table_checker(table) == hash_empty)
hash_table_checker(table) = default_hash_checks[typ];
- else hash_table_checker(table) = hash_equal;
+ else
+ {
+ hash_table_checker(table) = hash_equal;
+ hash_set_chosen(table);
+ }
}
}
@@ -37272,8 +37403,8 @@ s7_pointer s7_hash_table_set(s7_scheme *sc, s7_pointer table, s7_pointer key, s7
hash_entry_t *p;
if (value == sc->F) return(sc->F);
- if (!hash_table_checker_locked(table))
- hash_table_set_function(table, type(key));
+ if (!hash_chosen(table))
+ hash_table_set_checker(table, type(key));
hash_len = hash_table_mask(table);
if (hash_table_entries(table) > hash_len)
@@ -37375,7 +37506,7 @@ That is, (hash-table* 'a 1 'b 2) returns a new hash-table with the two key/value
s7_pointer x, y;
ht_loc = s7_gc_protect(sc, ht); /* hash_table_set can cons, so we need to protect this */
- for (x = args, y = cdr(args); is_pair(y); x = cddr(x), y = cddr(y))
+ for (x = args, y = cdr(args); is_pair(x); x = cddr(x), y = unchecked_cdr(cdr(y)))
s7_hash_table_set(sc, ht, car(x), car(y));
s7_gc_unprotect_at(sc, ht_loc);
@@ -37397,6 +37528,7 @@ static s7_pointer hash_table_copy(s7_scheme *sc, s7_pointer old_hash, s7_pointer
if (hash_table_entries(new_hash) == 0)
{
hash_table_checker(new_hash) = hash_table_checker(old_hash);
+ if (hash_chosen(old_hash)) hash_set_chosen(new_hash);
if ((start == 0) &&
(end >= hash_table_entries(old_hash)))
{
@@ -37454,8 +37586,8 @@ static s7_pointer hash_table_copy(s7_scheme *sc, s7_pointer old_hash, s7_pointer
p->next = new_lists[loc];
new_lists[loc] = p;
hash_table_entries(new_hash)++;
- if (!hash_table_checker_locked(new_hash))
- hash_table_set_function(new_hash, type(x->key));
+ if (!hash_chosen(new_hash))
+ hash_table_set_checker(new_hash, type(x->key));
}
}
count++;
@@ -37516,7 +37648,10 @@ static s7_pointer hash_table_fill(s7_scheme *sc, s7_pointer args)
}
memset(entries, 0, len * sizeof(hash_entry_t *));
if (!hash_table_checker_locked(table))
- hash_table_checker(table) = hash_empty;
+ {
+ hash_table_checker(table) = hash_empty;
+ hash_clear_chosen(table);
+ }
hash_table_entries(table) = 0;
}
else
@@ -37863,7 +37998,6 @@ static s7_pointer s7_macroexpand(s7_scheme *sc, s7_pointer mac, s7_pointer args)
sc->args = copy_list(sc, args);
new_frame(sc, closure_let(sc->code), sc->envir);
eval(sc, OP_APPLY_LAMBDA);
- /* fprintf(stderr, "%s -> %s\n", DISPLAY(cons(sc, mac, args)), DISPLAY(sc->value)); */
return(sc->value);
}
@@ -38003,7 +38137,7 @@ static s7_pointer g_procedure_documentation(s7_scheme *sc, s7_pointer args)
check_method(sc, p, sc->procedure_documentation_symbol, list_1(sc, p));
if ((!is_procedure(p)) &&
- (!s7_is_macro(sc, p)))
+ (!is_any_macro(p)))
return(simple_wrong_type_argument_with_type(sc, sc->procedure_documentation_symbol, p, a_procedure_string));
return(s7_make_string(sc, s7_procedure_documentation(sc, p)));
@@ -38065,20 +38199,24 @@ static s7_pointer g_procedure_signature(s7_scheme *sc, s7_pointer args)
{
s7_pointer p;
#define H_procedure_signature "(procedure-signature func) returns func's signature"
- #define Q_procedure_signature s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_boolean_symbol), sc->T)
+ #define Q_procedure_signature s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_pair_symbol, sc->is_boolean_symbol), sc->is_procedure_symbol)
p = car(args);
if (is_symbol(p))
{
p = s7_symbol_value(sc, p);
+ if (is_procedure(p))
+ return(s7_procedure_signature(sc, p));
if (p == sc->undefined)
return(sc->F);
}
+ else
+ {
+ if (is_procedure(p))
+ return(s7_procedure_signature(sc, p));
+ }
check_method(sc, p, sc->procedure_signature_symbol, list_1(sc, p));
-
- if (!is_procedure(p))
- return(sc->F);
- return(s7_procedure_signature(sc, p));
+ return(sc->F);
}
/* -------------------------------- new types (c_objects) -------------------------------- */
@@ -38088,12 +38226,12 @@ static void fallback_mark(void *value) {}
static char *fallback_print(s7_scheme *sc, void *val)
{
- return(copy_string("#<unprintable object>"));
+ return(copy_string("#<unprintable c_object>"));
}
static char *fallback_print_readably(s7_scheme *sc, void *val)
{
- return(copy_string("#<unprint-readable object>"));
+ return(copy_string("#<unprint-readable c_object>"));
}
static bool fallback_equal(void *val1, void *val2)
@@ -38117,31 +38255,145 @@ static s7_pointer fallback_length(s7_scheme *sc, s7_pointer obj)
}
-bool s7_is_object(s7_pointer p)
+bool s7_is_c_object(s7_pointer p)
{
return(is_c_object(p));
}
static s7_pointer g_is_c_object(s7_scheme *sc, s7_pointer args)
{
- #define H_is_c_object "(c-object? obj) returns the object's type tag if obj is a C object, otherwise #f"
+ #define H_is_c_object "(c-object? obj) returns the c_object's type tag."
#define Q_is_c_object pl_bt
s7_pointer p;
p = car(args);
if (is_c_object(p))
- return(make_integer(sc, c_object_type(p))); /* this is the object_types table index = tag */
+ return(make_integer(sc, c_object_type(p))); /* this is the c_object_types table index = tag */
check_method(sc, p, sc->is_c_object_symbol, args);
return(sc->F);
}
-static s7_pointer g_internal_object_set(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_internal_c_object_set(s7_scheme *sc, s7_pointer args)
+{
+ return((*(c_object_set(sc, car(args))))(sc, car(args), cdr(args)));
+}
+
+int32_t s7_make_c_type(s7_scheme *sc, const char *name)
+{
+ int32_t tag;
+ tag = sc->num_c_object_types++;
+ if (tag >= sc->c_object_types_size)
+ {
+ if (sc->c_object_types_size == 0)
+ {
+ sc->c_object_types_size = 8;
+ sc->c_object_types = (c_object_t **)calloc(sc->c_object_types_size, sizeof(c_object_t *));
+ }
+ else
+ {
+ sc->c_object_types_size = tag + 8;
+ sc->c_object_types = (c_object_t **)realloc((void *)(sc->c_object_types), sc->c_object_types_size * sizeof(c_object_t *));
+ }
+ }
+ sc->c_object_types[tag] = (c_object_t *)calloc(1, sizeof(c_object_t));
+ sc->c_object_types[tag]->type = tag;
+ sc->c_object_types[tag]->name = copy_string(name);
+ sc->c_object_types[tag]->scheme_name = s7_make_permanent_string(name);
+
+ sc->c_object_types[tag]->free = fallback_free;
+ sc->c_object_types[tag]->print = fallback_print;
+ sc->c_object_types[tag]->equal = fallback_equal;
+ sc->c_object_types[tag]->gc_mark = fallback_mark;
+ sc->c_object_types[tag]->ref = fallback_ref;
+ sc->c_object_types[tag]->set = fallback_set;
+ sc->c_object_types[tag]->outer_type = T_C_OBJECT;
+ sc->c_object_types[tag]->length = fallback_length;
+ sc->c_object_types[tag]->copy = NULL;
+ sc->c_object_types[tag]->reverse = NULL;
+ sc->c_object_types[tag]->fill = NULL;
+ sc->c_object_types[tag]->print_readably = fallback_print_readably;
+
+ return(tag);
+}
+
+void s7_c_type_set_print(s7_scheme *sc, int32_t tag, char *(*print)(s7_scheme *sc, void *value))
+{
+ sc->c_object_types[tag]->print = print;
+}
+
+void s7_c_type_set_print_readably(s7_scheme *sc, int32_t type, char *(*printer)(s7_scheme *sc, void *val))
+{
+ sc->c_object_types[type]->print_readably = printer;
+}
+
+void s7_c_type_set_free(s7_scheme *sc, int32_t tag, void (*gc_free)(void *value))
+{
+ sc->c_object_types[tag]->free = gc_free;
+}
+
+void s7_c_type_set_equal(s7_scheme *sc, int32_t tag, bool (*equal)(void *val1, void *val2))
+{
+ sc->c_object_types[tag]->equal = equal;
+}
+
+void s7_c_type_set_mark(s7_scheme *sc, int32_t tag, void (*gc_mark)(void *val))
+{
+ sc->c_object_types[tag]->gc_mark = gc_mark;
+}
+
+void s7_c_type_set_apply(s7_scheme *sc, int32_t tag, s7_pointer (*ref)(s7_scheme *sc, s7_pointer obj, s7_pointer args))
+{
+ sc->c_object_types[tag]->ref = ref;
+ if (sc->c_object_types[tag]->ref != fallback_ref)
+ sc->c_object_types[tag]->outer_type = (T_C_OBJECT | T_SAFE_PROCEDURE);
+}
+
+void s7_c_type_set_apply_direct(s7_scheme *sc, int32_t tag, s7_pointer (*dref)(s7_scheme *sc, s7_pointer obj, s7_int index))
+{
+ sc->c_object_types[tag]->direct_ref = dref;
+}
+
+void s7_c_type_set_set(s7_scheme *sc, int32_t tag, s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args))
+{
+ sc->c_object_types[tag]->set = set;
+}
+
+void s7_c_type_set_set_direct(s7_scheme *sc, int32_t tag, s7_pointer (*dset)(s7_scheme *sc, s7_pointer obj, s7_int index, s7_pointer val))
+{
+ sc->c_object_types[tag]->direct_set = dset;
+}
+
+void s7_c_type_set_length(s7_scheme *sc, int32_t tag, s7_pointer (*length)(s7_scheme *sc, s7_pointer obj))
+{
+ sc->c_object_types[tag]->length = length;
+}
+
+void s7_c_type_set_copy(s7_scheme *sc, int32_t tag, s7_pointer (*copy)(s7_scheme *sc, s7_pointer args))
+{
+ sc->c_object_types[tag]->copy = copy;
+}
+
+void s7_c_type_set_fill(s7_scheme *sc, int32_t tag, s7_pointer (*fill)(s7_scheme *sc, s7_pointer args))
+{
+ sc->c_object_types[tag]->fill = fill;
+}
+
+void s7_c_type_set_reverse(s7_scheme *sc, int32_t tag, s7_pointer (*reverse)(s7_scheme *sc, s7_pointer args))
{
- return((*(c_object_set(car(args))))(sc, car(args), cdr(args)));
+ sc->c_object_types[tag]->reverse = reverse;
}
+/* #if (!DISABLE_DEPRECATED) */
+void s7_object_type_set_direct(int32_t tag,
+ s7_pointer (*dref)(s7_scheme *sc, s7_pointer obj, s7_int index),
+ s7_pointer (*dset)(s7_scheme *sc, s7_pointer obj, s7_int index, s7_pointer val))
+{
+ cur_sc->c_object_types[tag]->direct_ref = dref;
+ cur_sc->c_object_types[tag]->direct_set = dset;
+}
+
int s7_new_type(const char *name,
char *(*print)(s7_scheme *sc, void *value),
void (*gc_free)(void *value),
@@ -38151,46 +38403,21 @@ int s7_new_type(const char *name,
s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args))
{
int32_t tag;
- tag = num_object_types++;
- if (tag >= object_types_size)
- {
- if (object_types_size == 0)
- {
- object_types_size = 8;
- object_types = (c_object_t **)calloc(object_types_size, sizeof(c_object_t *));
- }
- else
- {
- object_types_size = tag + 8;
- object_types = (c_object_t **)realloc((void *)object_types, object_types_size * sizeof(c_object_t *));
- }
- }
- object_types[tag] = (c_object_t *)calloc(1, sizeof(c_object_t));
- object_types[tag]->type = tag;
- object_types[tag]->name = copy_string(name);
- object_types[tag]->scheme_name = s7_make_permanent_string(name);
+ tag = s7_make_c_type(cur_sc, name);
- object_types[tag]->free = (gc_free) ? gc_free : fallback_free;
- object_types[tag]->print = (print) ? print : fallback_print;
- object_types[tag]->equal = (equal) ? equal : fallback_equal;
- object_types[tag]->gc_mark = (gc_mark) ? gc_mark : fallback_mark;
- object_types[tag]->ref = (ref) ? ref : fallback_ref;
- object_types[tag]->set = (set) ? set : fallback_set;
+ if (gc_free) cur_sc->c_object_types[tag]->free = gc_free;
+ if (print) cur_sc->c_object_types[tag]->print = print;
+ if (equal) cur_sc->c_object_types[tag]->equal = equal;
+ if (gc_mark) cur_sc->c_object_types[tag]->gc_mark = gc_mark;
+ if (set) cur_sc->c_object_types[tag]->set = set;
- if (object_types[tag]->ref != fallback_ref)
- object_types[tag]->outer_type = (T_C_OBJECT | T_SAFE_PROCEDURE);
- else object_types[tag]->outer_type = T_C_OBJECT;
-
- object_types[tag]->length = fallback_length;
- object_types[tag]->copy = NULL;
- object_types[tag]->reverse = NULL;
- object_types[tag]->fill = NULL;
- object_types[tag]->print_readably = fallback_print_readably;
+ if (ref) cur_sc->c_object_types[tag]->ref = ref;
+ if (cur_sc->c_object_types[tag]->ref != fallback_ref)
+ cur_sc->c_object_types[tag]->outer_type = (T_C_OBJECT | T_SAFE_PROCEDURE);
return(tag);
}
-
int s7_new_type_x(s7_scheme *sc,
const char *name,
char *(*print)(s7_scheme *sc, void *value),
@@ -38206,36 +38433,29 @@ int s7_new_type_x(s7_scheme *sc,
{
int32_t tag;
tag = s7_new_type(name, print, free, equal, gc_mark, apply, set);
- if (length)
- object_types[tag]->length = length;
- else object_types[tag]->length = fallback_length;
- object_types[tag]->copy = copy;
- object_types[tag]->reverse = reverse;
- object_types[tag]->fill = fill;
+ if (length) sc->c_object_types[tag]->length = length;
+ sc->c_object_types[tag]->copy = copy;
+ sc->c_object_types[tag]->reverse = reverse;
+ sc->c_object_types[tag]->fill = fill;
return(tag);
}
+/* #endif */
-static void free_object(s7_pointer a)
-{
- (*(c_object_free(a)))(c_object_value(a));
-}
-
-
-static bool objects_are_equal(s7_scheme *sc, s7_pointer a, s7_pointer b)
+static bool c_objects_are_equal(s7_scheme *sc, s7_pointer a, s7_pointer b)
{
return((c_object_type(a) == c_object_type(b)) &&
- ((*(c_object_eql(a)))(c_object_value(a), c_object_value(b))));
+ ((*(c_object_eql(sc, a)))(c_object_value(a), c_object_value(b))));
}
-void *s7_object_value(s7_pointer obj)
+void *s7_c_object_value(s7_pointer obj)
{
return(c_object_value(obj));
}
-void *s7_object_value_checked(s7_pointer obj, int32_t type)
+void *s7_c_object_value_checked(s7_pointer obj, int32_t type)
{
if ((is_c_object(obj)) &&
(c_object_type(obj) == type))
@@ -38244,13 +38464,7 @@ void *s7_object_value_checked(s7_pointer obj, int32_t type)
}
-void s7_set_object_print_readably(int32_t type, char *(*printer)(s7_scheme *sc, void *val))
-{
- object_types[type]->print_readably = printer;
-}
-
-
-int s7_object_type(s7_pointer obj)
+int s7_c_object_type(s7_pointer obj)
{
if (is_c_object(obj))
return(c_object_type(obj));
@@ -38258,65 +38472,58 @@ int s7_object_type(s7_pointer obj)
}
-s7_pointer s7_make_object_with_let(s7_scheme *sc, int32_t type, void *value, s7_pointer let)
+s7_pointer s7_make_c_object_with_let(s7_scheme *sc, int32_t type, void *value, s7_pointer let)
{
s7_pointer x;
- new_cell(sc, x, object_types[type]->outer_type);
+ new_cell(sc, x, sc->c_object_types[type]->outer_type);
- /* c_object_info(x) = &(object_types[type]); */
- /* that won't work because object_types can move when it is realloc'd and the old stuff is freed by realloc
+ /* c_object_info(x) = &(sc->c_object_types[type]); */
+ /* that won't work because c_object_types can move when it is realloc'd and the old stuff is freed by realloc
* and since we're checking (for example) ref_2 existence as not null, we can't use a table of c_object_t's!
*/
c_object_type(x) = type;
c_object_value(x) = value;
c_object_set_let(x, let);
+ c_object_mark(x) = sc->c_object_types[type]->gc_mark;
add_c_object(sc, x);
return(x);
}
-s7_pointer s7_make_object(s7_scheme *sc, int32_t type, void *value)
+s7_pointer s7_make_c_object(s7_scheme *sc, int32_t type, void *value)
{
- return(s7_make_object_with_let(sc, type, value, sc->nil));
+ return(s7_make_c_object_with_let(sc, type, value, sc->nil));
}
-s7_pointer s7_object_let(s7_pointer obj)
+s7_pointer s7_c_object_let(s7_pointer obj)
{
return(c_object_let(obj));
}
-s7_pointer s7_object_set_let(s7_pointer obj, s7_pointer e)
+s7_pointer s7_c_object_set_let(s7_pointer obj, s7_pointer e)
{
c_object_set_let(obj, e);
return(e);
}
-void s7_object_type_set_direct(int32_t tag,
- s7_pointer (*dref)(s7_scheme *sc, s7_pointer obj, s7_int index),
- s7_pointer (*dset)(s7_scheme *sc, s7_pointer obj, s7_int index, s7_pointer val))
-{
- object_types[tag]->direct_ref = dref;
- object_types[tag]->direct_set = dset;
-}
+static s7_pointer c_object_pi_direct(s7_pointer obj, s7_int i) {return((c_object_direct_ref(cur_sc, obj))(cur_sc, obj, i));}
-static s7_pointer c_object_pi_direct(s7_pointer obj, s7_int i) {return((c_object_direct_ref(obj))(cur_sc, obj, i));}
-
-static s7_pointer object_length(s7_scheme *sc, s7_pointer obj)
+static s7_pointer c_object_length(s7_scheme *sc, s7_pointer obj)
{
- if (c_object_length(obj))
- return((*(c_object_length(obj)))(sc, obj));
+ if (c_object_len(sc, obj))
+ return((*(c_object_len(sc, obj)))(sc, obj));
eval_error(sc, "attempt to get length of ~S?", obj);
}
-static s7_int object_length_to_int(s7_scheme *sc, s7_pointer obj)
+static s7_int c_object_length_to_int(s7_scheme *sc, s7_pointer obj)
{
- if (c_object_length(obj))
+ if (c_object_len(sc, obj))
{
s7_pointer res;
- res = (*(c_object_length(obj)))(sc, obj);
+ res = (*(c_object_len(sc, obj)))(sc, obj);
if (s7_is_integer(res))
return(s7_integer(res));
}
@@ -38329,8 +38536,8 @@ static s7_pointer object_copy(s7_scheme *sc, s7_pointer args)
s7_pointer obj;
obj = car(args);
check_method(sc, obj, sc->copy_symbol, args);
- if (c_object_copy(obj))
- return((*(c_object_copy(obj)))(sc, args));
+ if (c_object_copy(sc, obj))
+ return((*(c_object_copy(sc, obj)))(sc, args));
eval_error(sc, "attempt to copy ~S?", obj);
}
@@ -38482,8 +38689,13 @@ static s7_pointer g_procedure_setter(s7_scheme *sc, s7_pointer args)
case T_CONTINUATION:
return(sc->F);
+ case T_C_OBJECT:
+ /* this can satisfy procedure? if T_SAFE_PROCEDURE bit is set -- has apply method, see s7_c_type_set_apply */
+ check_method(sc, p, s7_make_symbol(sc, "procedure-setter"), args);
+ return(make_boolean(sc, (c_object_set(sc, p) != fallback_set)));
+ /* unfortunately ref/set are not s7_functions (they have an extra object arg), so we can't return c_object_set */
+
case T_LET:
- case T_C_OBJECT:
check_method(sc, p, s7_make_symbol(sc, "procedure-setter"), args);
break;
@@ -38732,13 +38944,13 @@ bool s7_is_aritable(s7_scheme *sc, s7_pointer x, int32_t args)
{
case T_C_RST_ARGS_FUNCTION:
case T_C_FUNCTION:
- return(((int)c_function_required_args(x) <= args) &&
- ((int)c_function_all_args(x) >= args));
+ return(((int32_t)c_function_required_args(x) <= args) &&
+ ((int32_t)c_function_all_args(x) >= args));
case T_C_OPT_ARGS_FUNCTION: /* any/opt req args == 0 */
case T_C_ANY_ARGS_FUNCTION:
case T_C_FUNCTION_STAR:
- return((int)c_function_all_args(x) >= args);
+ return((int32_t)c_function_all_args(x) >= args);
case T_MACRO:
case T_BACRO:
@@ -38751,8 +38963,8 @@ bool s7_is_aritable(s7_scheme *sc, s7_pointer x, int32_t args)
return(closure_star_is_aritable(sc, x, closure_args(x), args));
case T_C_MACRO:
- return(((int)c_macro_required_args(x) <= args) &&
- ((int)c_macro_all_args(x) >= args));
+ return(((int32_t)c_macro_required_args(x) <= args) &&
+ ((int32_t)c_macro_all_args(x) >= args));
case T_GOTO:
case T_CONTINUATION:
@@ -38806,7 +39018,7 @@ static s7_pointer g_is_aritable(s7_scheme *sc, s7_pointer args)
return(out_of_range(sc, sc->is_aritable_symbol, small_int(2), n, its_negative_string));
if (num > MAX_ARITY) num = MAX_ARITY;
- return(make_boolean(sc, s7_is_aritable(sc, car(args), (int)num)));
+ return(make_boolean(sc, s7_is_aritable(sc, car(args), (int32_t)num)));
}
static bool is_aritable_b_pp(s7_pointer f, s7_pointer i) {return(g_is_aritable(cur_sc, set_plist_2(cur_sc, f, i)) != cur_sc->F);}
@@ -38886,7 +39098,7 @@ s7_pointer s7_symbol_set_access(s7_scheme *sc, s7_pointer symbol, s7_pointer fun
static s7_pointer g_symbol_access(s7_scheme *sc, s7_pointer args)
{
#define H_symbol_access "(symbol-access sym (env (curlet))) is the function called when the symbol is set!."
- #define Q_symbol_access s7_make_signature(sc, 3, sc->T, sc->is_symbol_symbol, sc->is_let_symbol)
+ #define Q_symbol_access s7_make_signature(sc, 3, s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->is_procedure_symbol), sc->is_symbol_symbol, sc->is_let_symbol)
s7_pointer sym, p;
sym = car(args);
@@ -39094,16 +39306,15 @@ static bool floats_are_morally_equal(s7_scheme *sc, s7_double x, s7_double y)
return(fabs(x - y) <= sc->morally_equal_float_epsilon);
}
-static bool eq_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static bool eq_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
return(x == y);
}
-static bool symbol_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static bool symbol_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
if (x == y) return(true);
if (!is_symbol(y)) return(false); /* (morally-equal? ''(1) '(1)) */
- if (!morally) return(false);
return((is_slot(global_slot(x))) && /* the optimizer can replace the original symbol with its own */
(is_syntax(slot_value(global_slot(x)))) &&
(is_slot(global_slot(y))) &&
@@ -39111,12 +39322,18 @@ static bool symbol_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info
(syntax_symbol(slot_value(global_slot(x))) == syntax_symbol(slot_value(global_slot(y)))));
}
-static bool unspecified_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static bool unspecified_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
return(is_unspecified(y));
}
-static bool c_pointer_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static bool c_pointer_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+{
+ return((s7_is_c_pointer(y)) &&
+ (raw_pointer(x) == raw_pointer(y)));
+}
+
+static bool c_pointer_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
return((s7_is_c_pointer(y)) &&
(raw_pointer(x) == raw_pointer(y)) &&
@@ -39124,25 +39341,30 @@ static bool c_pointer_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_in
(raw_pointer_info(x) == raw_pointer_info(y))); /* should these use s7_is_equal? */
}
-static bool string_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static bool string_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
return((is_string(y)) && (scheme_strings_are_equal(x, y)));
}
-static bool syntax_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static bool syntax_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
return((is_syntax(y)) && (syntax_symbol(x) == syntax_symbol(y)));
}
-static bool c_object_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static bool c_object_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
- return((is_c_object(y)) && (objects_are_equal(sc, x, y)));
+ return((is_c_object(y)) && (c_objects_are_equal(sc, x, y)));
+}
+
+static bool port_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+{
+ return(x == y);
}
-static bool port_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static bool port_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
if (x == y) return(true);
- if ((!morally) || (type(x) != type(y)) || (port_type(x) != port_type(y))) return(false);
+ if ((type(x) != type(y)) || (port_type(x) != port_type(y))) return(false);
if ((port_is_closed(x)) && (port_is_closed(y))) return(true);
return((is_string_port(x)) &&
(port_position(x) == port_position(y)) &&
@@ -39153,14 +39375,16 @@ static bool port_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *c
#define equal_ref(Sc, X, Y, Ci) \
do { \
/* here we know x and y are pointers to the same type of structure */ \
- int32_t ref_x, ref_y; \
- ref_x = (is_collected(X)) ? peek_shared_ref(Ci, X) : 0; \
+ int32_t ref_y; \
ref_y = (is_collected(Y)) ? peek_shared_ref(Ci, Y) : 0; \
- if ((ref_x != 0) && (ref_y != 0)) \
- return(ref_x == ref_y); \
- /* try to harmonize the new guy -- there can be more than one structure equal to the current one */ \
- if (ref_x != 0) \
- add_shared_ref(Ci, Y, ref_x); \
+ if (is_collected(X)) \
+ { \
+ int32_t ref_x; \
+ ref_x = peek_shared_ref(Ci, X); \
+ if (ref_y != 0) return(ref_x == ref_y); \
+ /* try to harmonize the new guy -- there can be more than one structure equal to the current one */ \
+ if (ref_x != 0) add_shared_ref(Ci, Y, ref_x); \
+ } \
else \
{ \
if (ref_y != 0) \
@@ -39170,23 +39394,21 @@ static bool port_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *c
/* assume neither x nor y is in the table, and that they should share a ref value, \
* called only in equality check, not printer. \
*/ \
- if ((Ci->top + 2) >= Ci->size) \
- enlarge_shared_info(Ci); \
+ if (Ci->top >= Ci->size2) enlarge_shared_info(Ci); \
set_collected(X); \
set_collected(Y); \
Ci->objs[Ci->top] = X; \
- Ci->ref++; \
- Ci->refs[Ci->top++] = Ci->ref; \
+ Ci->refs[Ci->top++] = ++Ci->ref; \
Ci->objs[Ci->top] = Y; \
Ci->refs[Ci->top++] = Ci->ref; \
} \
} \
} while (0)
+static bool s7_is_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci);
+static bool s7_is_morally_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci);
-static bool s7_is_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally);
-
-static bool hash_table_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static bool hash_table_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
hash_entry_t **lists;
int32_t i, len;
@@ -39196,7 +39418,7 @@ static bool hash_table_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_i
return(true);
if (!is_hash_table(y))
{
- if ((morally) && (has_methods(y)))
+ if (has_methods(y))
{
s7_pointer equal_func;
equal_func = find_method(sc, find_let(sc, y), sc->is_morally_equal_symbol);
@@ -39212,8 +39434,43 @@ static bool hash_table_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_i
return(false);
if (hash_table_entries(x) == 0)
return(true);
- if ((!morally) &&
- ((hash_table_checker_locked(x)) || (hash_table_checker_locked(y))))
+ len = hash_table_mask(x) + 1;
+ lists = hash_table_elements(x);
+ if (!nci) nci = new_shared_info(sc);
+
+ for (i = 0; i < len; i++)
+ {
+ hash_entry_t *p;
+ for (p = lists[i]; p; p = p->next)
+ {
+ hash_entry_t *y_val;
+ y_val = (*hash_table_checker(y))(sc, y, p->key);
+
+ if ((!y_val) ||
+ (!s7_is_morally_equal_1(sc, p->value, y_val->value, nci)))
+ return(false);
+ }
+ }
+ return(true);
+}
+
+static bool hash_table_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+{
+ hash_entry_t **lists;
+ int32_t i, len;
+ shared_info *nci = ci;
+
+ if (x == y)
+ return(true);
+ if (!is_hash_table(y)) return(false);
+ if (ci)
+ equal_ref(sc, x, y, ci);
+
+ if (hash_table_entries(x) != hash_table_entries(y))
+ return(false);
+ if (hash_table_entries(x) == 0)
+ return(true);
+ if ((hash_table_checker_locked(x)) || (hash_table_checker_locked(y)))
{
if (hash_table_checker(x) != hash_table_checker(y))
return(false);
@@ -39234,7 +39491,7 @@ static bool hash_table_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_i
y_val = (*hash_table_checker(y))(sc, y, p->key);
if ((!y_val) ||
- (!s7_is_equal_1(sc, p->value, y_val->value, nci, morally)))
+ (!s7_is_equal_1(sc, p->value, y_val->value, nci)))
return(false);
}
}
@@ -39245,45 +39502,32 @@ static bool hash_table_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_i
}
-static bool slots_match(s7_scheme *sc, s7_pointer px, s7_pointer y, bool morally, shared_info *nci)
+static bool slots_match(s7_scheme *sc, s7_pointer px, s7_pointer y, shared_info *nci)
{
s7_pointer ey, py;
for (ey = y; (is_let(ey)) && (ey != sc->rootlet); ey = outlet(ey))
for (py = let_slots(ey); is_slot(py); py = next_slot(py))
if (slot_symbol(px) == slot_symbol(py)) /* we know something will match */
- return(s7_is_equal_1(sc, slot_value(px), slot_value(py), nci, morally));
+ return(s7_is_equal_1(sc, slot_value(px), slot_value(py), nci));
return(false);
}
-static bool let_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static bool slots_morally_match(s7_scheme *sc, s7_pointer px, s7_pointer y, shared_info *nci)
{
- /* x == y if all unshadowed vars match, leaving aside the rootlet, so that for any local variable,
- * we get the same value in either x or y.
- */
+ s7_pointer ey, py;
+ for (ey = y; (is_let(ey)) && (ey != sc->rootlet); ey = outlet(ey))
+ for (py = let_slots(ey); is_slot(py); py = next_slot(py))
+ if (slot_symbol(px) == slot_symbol(py)) /* we know something will match */
+ return(s7_is_morally_equal_1(sc, slot_value(px), slot_value(py), nci));
+ return(false);
+}
+static bool let_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+{
s7_pointer ex, ey, px, py;
shared_info *nci = ci;
int32_t x_len, y_len;
- if (x == y)
- return(true);
-
- if (morally)
- {
- s7_pointer equal_func;
- if (has_methods(x))
- {
- equal_func = find_method(sc, find_let(sc, x), sc->is_morally_equal_symbol);
- if (equal_func != sc->undefined)
- return(s7_boolean(sc, s7_apply_function(sc, equal_func, list_2(sc, x, y))));
- }
- if (has_methods(y))
- {
- equal_func = find_method(sc, find_let(sc, y), sc->is_morally_equal_symbol);
- if (equal_func != sc->undefined)
- return(s7_boolean(sc, s7_apply_function(sc, equal_func, list_2(sc, y, x))));
- }
- }
if (!is_let(y))
return(false);
if ((x == sc->rootlet) || (y == sc->rootlet))
@@ -39324,13 +39568,47 @@ static bool let_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci
if (symbol_tag(slot_symbol(px)) == 0) /* unshadowed */
{
symbol_set_tag(slot_symbol(px), sc->syms_tag); /* values don't match */
- if (!slots_match(sc, px, y, morally, nci))
+ if (((!morally) && (!slots_match(sc, px, y, nci))) ||
+ ((morally) && (!slots_morally_match(sc, px, y, nci))))
return(false);
}
return(true);
}
-static bool closure_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+
+static bool let_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+{
+ /* x == y if all unshadowed vars match, leaving aside the rootlet, so that for any local variable,
+ * we get the same value in either x or y.
+ */
+ if (x == y)
+ return(true);
+ return(let_equal_1(sc, x, y, ci, false));
+}
+
+static bool let_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+{
+ s7_pointer equal_func;
+
+ if (x == y)
+ return(true);
+
+ if (has_methods(x))
+ {
+ equal_func = find_method(sc, find_let(sc, x), sc->is_morally_equal_symbol);
+ if (equal_func != sc->undefined)
+ return(s7_boolean(sc, s7_apply_function(sc, equal_func, list_2(sc, x, y))));
+ }
+ if (has_methods(y))
+ {
+ equal_func = find_method(sc, find_let(sc, y), sc->is_morally_equal_symbol);
+ if (equal_func != sc->undefined)
+ return(s7_boolean(sc, s7_apply_function(sc, equal_func, list_2(sc, y, x))));
+ }
+ return(let_equal_1(sc, x, y, ci, true));
+}
+
+static bool closure_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
if (x == y)
return(true);
@@ -39340,28 +39618,72 @@ static bool closure_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info
(has_methods(y)))
{
s7_pointer equal_func;
- equal_func = find_method(sc, closure_let(x), (morally) ? sc->is_morally_equal_symbol : sc->is_equal_symbol);
+ equal_func = find_method(sc, closure_let(x), sc->is_equal_symbol);
+ if (equal_func != sc->undefined)
+ return(s7_boolean(sc, s7_apply_function(sc, equal_func, list_2(sc, x, y))));
+ }
+ return(false);
+}
+
+static bool closure_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+{
+ if (x == y)
+ return(true);
+ if (type(x) != type(y))
+ return(false);
+ if ((has_methods(x)) &&
+ (has_methods(y)))
+ {
+ s7_pointer equal_func;
+ equal_func = find_method(sc, closure_let(x), sc->is_morally_equal_symbol);
if (equal_func != sc->undefined)
return(s7_boolean(sc, s7_apply_function(sc, equal_func, list_2(sc, x, y))));
}
/* not sure about this -- we can't simply check let_equal(closure_let(x), closure_let(y))
* because locally defined constant functions on the second pass find the outer let.
*/
- return((morally) &&
- (s7_is_equal_1(sc, closure_args(x), closure_args(y), ci, morally)) &&
- (s7_is_equal_1(sc, closure_body(x), closure_body(y), ci, morally)));
+ return((s7_is_morally_equal_1(sc, closure_args(x), closure_args(y), ci)) &&
+ (s7_is_morally_equal_1(sc, closure_body(x), closure_body(y), ci)));
}
-static bool pair_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static bool pair_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
+ shared_info *nci;
s7_pointer px, py;
- shared_info *nci = ci;
if (x == y)
return(true);
if (!is_pair(y))
+ return(false);
+
+ if (ci)
{
- if ((morally) && (has_methods(y)))
+ nci = ci;
+ equal_ref(sc, x, y, ci);
+ }
+ else nci = new_shared_info(sc);
+
+ if (!s7_is_equal_1(sc, car(x), car(y), nci)) return(false);
+ for (px = cdr(x), py = cdr(y); (is_pair(px)) && (is_pair(py)); px = cdr(px), py = cdr(py))
+ {
+ if (!s7_is_equal_1(sc, car(px), car(py), nci)) return(false);
+ equal_ref(sc, px, py, nci);
+ }
+ if (px == py) /* normally nil? */
+ return(true);
+ return(s7_is_equal_1(sc, px, py, nci));
+}
+
+static bool pair_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+{
+ shared_info *nci;
+ s7_pointer px, py;
+
+ if (x == y)
+ return(true);
+ if (!is_pair(y))
+ {
+ if (has_methods(y))
{
s7_pointer equal_func;
equal_func = find_method(sc, find_let(sc, y), sc->is_morally_equal_symbol);
@@ -39370,17 +39692,23 @@ static bool pair_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *c
}
return(false);
}
+
if (ci)
- equal_ref(sc, x, y, ci);
+ {
+ nci = ci;
+ equal_ref(sc, x, y, ci);
+ }
else nci = new_shared_info(sc);
-
- if (!s7_is_equal_1(sc, car(x), car(y), nci, morally)) return(false);
+
+ if (!s7_is_morally_equal_1(sc, car(x), car(y), nci)) return(false);
for (px = cdr(x), py = cdr(y); (is_pair(px)) && (is_pair(py)); px = cdr(px), py = cdr(py))
{
- if (!s7_is_equal_1(sc, car(px), car(py), nci, morally)) return(false);
+ if (!s7_is_morally_equal_1(sc, car(px), car(py), nci)) return(false);
equal_ref(sc, px, py, nci);
}
- return(s7_is_equal_1(sc, px, py, nci, morally));
+ if (px == py) /* normally nil? */
+ return(true);
+ return(s7_is_morally_equal_1(sc, px, py, nci));
}
static bool vector_rank_match(s7_scheme *sc, s7_pointer x, s7_pointer y)
@@ -39407,8 +39735,57 @@ static bool vector_rank_match(s7_scheme *sc, s7_pointer x, s7_pointer y)
return(true);
}
+static bool vector_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+{
+ s7_int i, len;
+ shared_info *nci = ci;
+
+ if (x == y)
+ return(true);
+ if (!s7_is_vector(y)) return(false);
+
+ len = vector_length(x);
+ if (len != vector_length(y)) return(false);
+ if (len == 0)
+ return(vector_rank_match(sc, x, y));
+
+ if (type(x) != type(y))
+ return(false);
+ if (!vector_rank_match(sc, x, y))
+ return(false);
+
+ if (is_float_vector(x))
+ {
+ for (i = 0; i < len; i++)
+ {
+ s7_double z;
+ z = float_vector_element(x, i);
+ if ((is_NaN(z)) ||
+ (z != float_vector_element(y, i)))
+ return(false);
+ }
+ return(true);
+ }
-static bool vector_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+ if (is_int_vector(x))
+ {
+ for (i = 0; i < len; i++)
+ if (int_vector_element(x, i) != int_vector_element(y, i))
+ return(false);
+ return(true);
+ }
+
+ if (ci)
+ equal_ref(sc, x, y, ci);
+ else nci = new_shared_info(sc);
+
+ for (i = 0; i < len; i++)
+ if (!(s7_is_equal_1(sc, vector_element(x, i), vector_element(y, i), nci)))
+ return(false);
+ return(true);
+}
+
+static bool vector_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
s7_int i, len;
shared_info *nci = ci;
@@ -39417,7 +39794,7 @@ static bool vector_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info
return(true);
if (!s7_is_vector(y))
{
- if ((morally) && (has_methods(y)))
+ if (has_methods(y))
{
s7_pointer equal_func;
equal_func = find_method(sc, find_let(sc, y), sc->is_morally_equal_symbol);
@@ -39428,70 +39805,48 @@ static bool vector_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info
}
len = vector_length(x);
if (len != vector_length(y)) return(false);
- if (len == 0)
- {
- if (morally) return(true);
- if (!vector_rank_match(sc, x, y))
- return(false);
- return(true);
- }
+ if (len == 0) return(true);
if (!vector_rank_match(sc, x, y))
return(false);
if (type(x) != type(y))
{
- if (!morally) return(false);
/* (morally-equal? (make-int-vector 3 0) (make-vector 3 0)) -> #t
* (morally-equal? (make-float-vector 3 1.0) (vector 1 1 1)) -> #t
*/
for (i = 0; i < len; i++)
- if (!s7_is_equal_1(sc, vector_getter(x)(sc, x, i), vector_getter(y)(sc, y, i), NULL, true)) /* this could be greatly optimized */
+ if (!s7_is_morally_equal_1(sc, vector_getter(x)(sc, x, i), vector_getter(y)(sc, y, i), NULL)) /* this could be greatly optimized */
return(false);
return(true);
}
if (is_float_vector(x))
{
- if (!morally)
+ s7_double *arr1, *arr2;
+ s7_double fudge;
+ arr1 = float_vector_elements(x);
+ arr2 = float_vector_elements(y);
+ fudge = sc->morally_equal_float_epsilon;
+ if (fudge == 0.0)
{
for (i = 0; i < len; i++)
- {
- s7_double z;
- z = float_vector_element(x, i);
- if ((is_NaN(z)) ||
- (z != float_vector_element(y, i)))
- return(false);
- }
- return(true);
+ if ((arr1[i] != arr2[i]) &&
+ ((!is_NaN(arr1[i])) || (!is_NaN(arr2[i]))))
+ return(false);
}
else
{
- s7_double *arr1, *arr2;
- s7_double fudge;
- arr1 = float_vector_elements(x);
- arr2 = float_vector_elements(y);
- fudge = sc->morally_equal_float_epsilon;
- if (fudge == 0.0)
- {
- for (i = 0; i < len; i++)
- if ((arr1[i] != arr2[i]) &&
- ((!is_NaN(arr1[i])) || (!is_NaN(arr2[i]))))
- return(false);
- }
- else
+ for (i = 0; i < len; i++)
{
- for (i = 0; i < len; i++)
- {
- s7_double diff;
- diff = fabs(arr1[i] - arr2[i]);
- if (diff > fudge) return(false);
- if ((is_NaN(diff)) &&
- ((!is_NaN(arr1[i])) || (!is_NaN(arr2[i]))))
- return(false);
- }
+ s7_double diff;
+ diff = fabs(arr1[i] - arr2[i]);
+ if (diff > fudge) return(false);
+ if ((is_NaN(diff)) &&
+ ((!is_NaN(arr1[i])) || (!is_NaN(arr2[i]))))
+ return(false);
}
- return(true);
}
+ return(true);
}
if (is_int_vector(x))
@@ -39507,12 +39862,12 @@ static bool vector_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info
else nci = new_shared_info(sc);
for (i = 0; i < len; i++)
- if (!(s7_is_equal_1(sc, vector_element(x, i), vector_element(y, i), nci, morally)))
+ if (!(s7_is_morally_equal_1(sc, vector_element(x, i), vector_element(y, i), nci)))
return(false);
return(true);
}
-static bool iterator_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static bool iterator_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
{
if (x == y) return(true);
if (!is_iterator(y)) return(false);
@@ -39522,14 +39877,15 @@ static bool iterator_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_inf
case T_STRING:
return((is_string(iterator_sequence(y))) &&
(iterator_position(x) == iterator_position(y)) &&
- (string_equal(sc, iterator_sequence(x), iterator_sequence(y), ci, morally)));
+ (string_equal(sc, iterator_sequence(x), iterator_sequence(y), ci)));
case T_VECTOR:
case T_INT_VECTOR:
case T_FLOAT_VECTOR:
return((s7_is_vector(iterator_sequence(y))) &&
(iterator_position(x) == iterator_position(y)) &&
- (vector_equal(sc, iterator_sequence(x), iterator_sequence(y), ci, morally)));
+ ((morally) ? (vector_morally_equal(sc, iterator_sequence(x), iterator_sequence(y), ci)) :
+ (vector_equal(sc, iterator_sequence(x), iterator_sequence(y), ci))));
case T_PAIR:
return((iterator_sequence(x) == iterator_sequence(y)) &&
@@ -39549,31 +39905,56 @@ static bool iterator_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_inf
return(false);
}
-static bool bignum_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static bool iterator_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+{
+ return(iterator_equal_1(sc, x, y, ci, false));
+}
+
+static bool iterator_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+{
+ return(iterator_equal_1(sc, x, y, ci, true));
+}
+
+static bool bignum_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+{
+ if (!s7_is_number(y)) return(false);
+#if WITH_GMP
+ return(big_numbers_are_eqv(x, y));
+#else
+ return(false);
+#endif
+}
+
+static bool bignum_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
if (!s7_is_number(y)) return(false);
#if WITH_GMP
- if (!morally)
- return(big_numbers_are_eqv(x, y));
return(big_equal(sc, set_plist_2(sc, x, y)) != sc->F);
#else
return(false);
#endif
}
-static bool integer_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static bool integer_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
#if WITH_GMP
if (is_big_number(y))
- {
- if (!morally)
- return(big_numbers_are_eqv(x, y));
- return(big_equal(sc, set_plist_2(sc, x, y)) != sc->F);
- }
+ return(big_numbers_are_eqv(x, y));
#endif
if (is_integer(y))
return(integer(x) == integer(y));
- if ((!morally) || (!is_number(y)))
+ return(false);
+}
+
+static bool integer_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+{
+#if WITH_GMP
+ if (is_big_number(y))
+ return(big_equal(sc, set_plist_2(sc, x, y)) != sc->F);
+#endif
+ if (is_integer(y))
+ return(integer(x) == integer(y));
+ if (!is_number(y))
return(false);
if (is_t_real(y))
@@ -39590,21 +39971,23 @@ static bool integer_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info
}
/* apparently ratio_equal is predefined in g++ -- name collision on mac */
-static bool fraction_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static bool fraction_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
#if WITH_GMP
if (is_big_number(y))
- {
- if (!morally)
- return(big_numbers_are_eqv(x, y));
- return(big_equal(sc, set_plist_2(sc, x, y)) != sc->F);
- }
+ return(big_numbers_are_eqv(x, y));
#endif
- if (!morally)
- return((s7_is_ratio(y)) &&
- (numerator(x) == numerator(y)) &&
- (denominator(x) == denominator(y)));
+ return((s7_is_ratio(y)) &&
+ (numerator(x) == numerator(y)) &&
+ (denominator(x) == denominator(y)));
+}
+static bool fraction_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+{
+#if WITH_GMP
+ if (is_big_number(y))
+ return(big_equal(sc, set_plist_2(sc, x, y)) != sc->F);
+#endif
if (is_t_ratio(y))
return(s7_fabsl(fraction(x) - fraction(y)) <= sc->morally_equal_float_epsilon);
@@ -39622,19 +40005,22 @@ static bool fraction_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_inf
return(false);
}
-static bool real_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static bool real_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
#if WITH_GMP
if (is_big_number(y))
- {
- if (!morally)
- return(big_numbers_are_eqv(x, y));
- return(big_equal(sc, set_plist_2(sc, x, y)) != sc->F);
- }
+ return(big_numbers_are_eqv(x, y));
+#endif
+ return((is_t_real(y)) &&
+ (real(x) == real(y)));
+}
+
+static bool real_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+{
+#if WITH_GMP
+ if (is_big_number(y))
+ return(big_equal(sc, set_plist_2(sc, x, y)) != sc->F);
#endif
- if (!morally)
- return((is_t_real(y)) &&
- (real(x) == real(y)));
if (!is_number(y)) return(false);
if (is_t_real(y))
@@ -39659,22 +40045,25 @@ static bool real_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *c
(fabs(imag_part(y)) <= sc->morally_equal_float_epsilon));
}
-static bool complex_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static bool complex_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
#if WITH_GMP
if (is_big_number(y))
- {
- if (!morally)
- return(big_numbers_are_eqv(x, y));
- return(big_equal(sc, set_plist_2(sc, x, y)) != sc->F);
- }
+ return(big_numbers_are_eqv(x, y));
+#endif
+ return((is_t_complex(y)) &&
+ (!is_NaN(real_part(x))) &&
+ (!is_NaN(imag_part(x))) &&
+ (real_part(x) == real_part(y)) &&
+ (imag_part(x) == imag_part(y)));
+}
+
+static bool complex_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+{
+#if WITH_GMP
+ if (is_big_number(y))
+ return(big_equal(sc, set_plist_2(sc, x, y)) != sc->F);
#endif
- if (!morally)
- return((is_t_complex(y)) &&
- (!is_NaN(real_part(x))) &&
- (!is_NaN(imag_part(x))) &&
- (real_part(x) == real_part(y)) &&
- (imag_part(x) == imag_part(y)));
if (!is_number(y)) return(false);
if (is_integer(y))
@@ -39723,7 +40112,7 @@ static bool complex_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info
(fabs(imag_part(x) - imag_part(y)) <= sc->morally_equal_float_epsilon)));
}
-static bool rng_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+static bool rng_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
#if WITH_GMP
return(x == y);
@@ -39735,15 +40124,14 @@ static bool rng_equal(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci
#endif
}
-
-
-static bool (*equals[NUM_TYPES])(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally);
+static bool (*equals[NUM_TYPES])(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci);
+static bool (*morally_equals[NUM_TYPES])(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci);
static void init_equals(void)
{
int32_t i;
- for (i = 0; i < NUM_TYPES; i++) equals[i] = eq_equal;
- equals[T_SYMBOL] = symbol_equal;
+ for (i = 0; i < NUM_TYPES; i++) {equals[i] = eq_equal; morally_equals[i] = eq_equal;}
+ equals[T_SYMBOL] = eq_equal;
equals[T_C_POINTER] = c_pointer_equal;
equals[T_UNSPECIFIED] = unspecified_equal;
equals[T_STRING] = string_equal;
@@ -39773,21 +40161,57 @@ static void init_equals(void)
equals[T_BIG_RATIO] = bignum_equal;
equals[T_BIG_REAL] = bignum_equal;
equals[T_BIG_COMPLEX] = bignum_equal;
+
+ morally_equals[T_SYMBOL] = symbol_morally_equal;
+ morally_equals[T_C_POINTER] = c_pointer_morally_equal;
+ morally_equals[T_UNSPECIFIED] = unspecified_equal;
+ morally_equals[T_STRING] = string_equal;
+ morally_equals[T_SYNTAX] = syntax_equal;
+ morally_equals[T_C_OBJECT] = c_object_equal;
+ morally_equals[T_RANDOM_STATE] = rng_equal;
+ morally_equals[T_ITERATOR] = iterator_morally_equal;
+ morally_equals[T_INPUT_PORT] = port_morally_equal;
+ morally_equals[T_OUTPUT_PORT] = port_morally_equal;
+ morally_equals[T_MACRO] = closure_morally_equal;
+ morally_equals[T_MACRO_STAR] = closure_morally_equal;
+ morally_equals[T_BACRO] = closure_morally_equal;
+ morally_equals[T_BACRO_STAR] = closure_morally_equal;
+ morally_equals[T_CLOSURE] = closure_morally_equal;
+ morally_equals[T_CLOSURE_STAR] = closure_morally_equal;
+ morally_equals[T_HASH_TABLE] = hash_table_morally_equal;
+ morally_equals[T_LET] = let_morally_equal;
+ morally_equals[T_PAIR] = pair_morally_equal;
+ morally_equals[T_VECTOR] = vector_morally_equal;
+ morally_equals[T_INT_VECTOR] = vector_morally_equal;
+ morally_equals[T_FLOAT_VECTOR] = vector_morally_equal;
+ morally_equals[T_INTEGER] = integer_morally_equal;
+ morally_equals[T_RATIO] = fraction_morally_equal;
+ morally_equals[T_REAL] = real_morally_equal;
+ morally_equals[T_COMPLEX] = complex_morally_equal;
+ morally_equals[T_BIG_INTEGER] = bignum_morally_equal;
+ morally_equals[T_BIG_RATIO] = bignum_morally_equal;
+ morally_equals[T_BIG_REAL] = bignum_morally_equal;
+ morally_equals[T_BIG_COMPLEX] = bignum_morally_equal;
+}
+
+static bool s7_is_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
+{
+ return((*(equals[type(x)]))(sc, x, y, ci));
}
-static bool s7_is_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci, bool morally)
+bool s7_is_equal(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- return((*(equals[type(x)]))(sc, x, y, ci, morally));
+ return(s7_is_equal_1(sc, x, y, NULL));
}
-bool s7_is_equal(s7_scheme *sc, s7_pointer x, s7_pointer y)
+static bool s7_is_morally_equal_1(s7_scheme *sc, s7_pointer x, s7_pointer y, shared_info *ci)
{
- return(s7_is_equal_1(sc, x, y, NULL, false));
+ return((*(morally_equals[type(x)]))(sc, x, y, ci));
}
bool s7_is_morally_equal(s7_scheme *sc, s7_pointer x, s7_pointer y)
{
- return(s7_is_equal_1(sc, x, y, NULL, true));
+ return(s7_is_morally_equal_1(sc, x, y, NULL));
}
static s7_pointer g_is_equal(s7_scheme *sc, s7_pointer args)
@@ -39814,62 +40238,85 @@ static s7_pointer is_morally_equal_p_pp(s7_pointer a, s7_pointer b) {return((s7_
/* ---------------------------------------- length, copy, fill ---------------------------------------- */
-static s7_pointer s7_length(s7_scheme *sc, s7_pointer lst)
+static s7_pointer (*length_functions[256])(s7_scheme *sc, s7_pointer obj);
+static s7_pointer any_length(s7_scheme *sc, s7_pointer obj) {return(sc->F);}
+
+static s7_pointer pair_length(s7_scheme *sc, s7_pointer a)
{
- switch (type(lst))
+ int32_t i;
+ s7_pointer slow, fast;
+ slow = a;
+ fast = cdr(a); /* we know a is a pair */
+ i = 1;
+ while (true)
{
- case T_PAIR:
- {
- int32_t len;
- len = s7_list_length(sc, lst);
- /* len < 0 -> dotted and (abs len) is length not counting the final cdr
- * len == 0, circular so length is infinite
- */
- if (len == 0)
- return(real_infinity);
- return(make_integer(sc, len));
- }
-
- case T_NIL:
- return(small_int(0));
-
- case T_INT_VECTOR:
- case T_FLOAT_VECTOR:
- case T_VECTOR:
- return(make_integer(sc, vector_length(lst)));
+ if (!is_pair(fast)) return(make_integer(sc, (is_null(fast)) ? i : -i));
+ fast = cdr(fast);
+ i++;
+ if (!is_pair(fast)) return(make_integer(sc, (is_null(fast)) ? i : -i));
+ fast = cdr(fast);
+ i++;
+ slow = cdr(slow);
+ if (fast == slow) return(real_infinity);
+ }
+ return(real_infinity);
+}
- case T_STRING:
- return(make_integer(sc, string_length(lst)));
+static s7_pointer nil_length(s7_scheme *sc, s7_pointer lst) {return(small_int(0));}
+static s7_pointer v_length(s7_scheme *sc, s7_pointer v) {return(make_integer(sc, vector_length(v)));}
+static s7_pointer str_length(s7_scheme *sc, s7_pointer v) {return(make_integer(sc, string_length(v)));}
+static s7_pointer iter_length(s7_scheme *sc, s7_pointer lst) {return(make_integer(sc, iterator_length(lst)));} /* in several cases, this is incorrect */
+static s7_pointer h_length(s7_scheme *sc, s7_pointer lst) {return(make_integer(sc, hash_table_mask(lst) + 1));}
- case T_ITERATOR:
- return(make_integer(sc, iterator_length(lst))); /* in several cases, this is incorrect */
+static s7_pointer c_obj_length(s7_scheme *sc, s7_pointer lst)
+{
+ check_method(sc, lst, sc->length_symbol, list_1(sc, lst));
+ return(c_object_length(sc, lst));
+}
- case T_HASH_TABLE:
- return(make_integer(sc, hash_table_mask(lst) + 1));
+static s7_pointer lt_length(s7_scheme *sc, s7_pointer lst)
+{
+ check_method(sc, lst, sc->length_symbol, list_1(sc, lst));
+ return(make_integer(sc, let_length(sc, lst)));
+}
- case T_C_OBJECT:
- check_method(sc, lst, sc->length_symbol, list_1(sc, lst));
- return(object_length(sc, lst));
+static s7_pointer fnc_length(s7_scheme *sc, s7_pointer lst)
+{
+ if (has_methods(lst))
+ return(make_integer(sc, closure_length(sc, lst)));
+ return(sc->F);
+}
- case T_LET:
- check_method(sc, lst, sc->length_symbol, list_1(sc, lst));
- return(make_integer(sc, let_length(sc, lst)));
+static s7_pointer io_length(s7_scheme *sc, s7_pointer lst)
+{
+ if (is_string_port(lst))
+ return(make_integer(sc, port_data_size(lst)));
+ return(sc->F);
+}
- case T_CLOSURE:
- case T_CLOSURE_STAR:
- if (has_methods(lst))
- return(make_integer(sc, closure_length(sc, lst)));
- return(sc->F);
+static void init_length_functions(void)
+{
+ int i;
+ for (i = 0; i < 256; i++) length_functions[i] = any_length;
+ length_functions[T_NIL] = nil_length;
+ length_functions[T_PAIR] = pair_length;
+ length_functions[T_VECTOR] = v_length;
+ length_functions[T_FLOAT_VECTOR] = v_length;
+ length_functions[T_INT_VECTOR] = v_length;
+ length_functions[T_STRING] = str_length;
+ length_functions[T_ITERATOR] = iter_length;
+ length_functions[T_HASH_TABLE] = h_length;
+ length_functions[T_C_OBJECT] = c_obj_length;
+ length_functions[T_LET] = lt_length;
+ length_functions[T_CLOSURE] = fnc_length;
+ length_functions[T_CLOSURE_STAR] = fnc_length;
+ length_functions[T_INPUT_PORT] = io_length;
+}
- case T_INPUT_PORT:
- if (is_string_port(lst))
- return(make_integer(sc, port_data_size(lst)));
- return(sc->F);
- default:
- return(sc->F);
- }
- return(sc->F);
+static s7_pointer s7_length(s7_scheme *sc, s7_pointer lst)
+{
+ return((*length_functions[unchecked_type(lst)])(sc, lst));
}
static s7_pointer g_length(s7_scheme *sc, s7_pointer args)
@@ -39878,7 +40325,7 @@ static s7_pointer g_length(s7_scheme *sc, s7_pointer args)
The length of a dotted list does not include the final cdr, and is returned as a negative number. A circular \
list has infinite length. Length of anything else returns #f."
#define Q_length s7_make_signature(sc, 2, s7_make_signature(sc, 2, sc->is_real_symbol, sc->is_boolean_symbol), sc->T)
- return(s7_length(sc, car(args)));
+ return((*length_functions[unchecked_type(car(args))])(sc, car(args)));
}
/* what about (length file)? input port, read_file gets the file length, so perhaps save it
@@ -39953,13 +40400,13 @@ static s7_pointer c_object_setter(s7_scheme *sc, s7_pointer obj, s7_int loc, s7_
{
set_car(sc->t2_1, make_integer(sc, loc));
set_car(sc->t2_2, val);
- return((*(c_object_set(obj)))(sc, obj, sc->t2_1));
+ return((*(c_object_set(sc, obj)))(sc, obj, sc->t2_1));
}
static s7_pointer c_object_getter(s7_scheme *sc, s7_pointer obj, s7_int loc)
{
set_car(sc->t1_1, make_integer(sc, loc));
- return((*(c_object_ref(obj)))(sc, obj, sc->t1_1));
+ return((*(c_object_ref(sc, obj)))(sc, obj, sc->t1_1));
}
static s7_pointer let_setter(s7_scheme *sc, s7_pointer e, s7_int loc, s7_pointer val)
@@ -40041,6 +40488,7 @@ s7_pointer s7_copy(s7_scheme *sc, s7_pointer args)
new_hash = s7_make_hash_table(sc, hash_table_mask(source) + 1);
gc_loc = s7_gc_protect(sc, new_hash);
hash_table_checker(new_hash) = hash_table_checker(source);
+ if (hash_chosen(source)) hash_set_chosen(new_hash);
hash_table_mapper(new_hash) = hash_table_mapper(source);
hash_table_set_procedures(new_hash, hash_table_procedures(source));
hash_table_copy(sc, source, new_hash, 0, hash_table_entries(source));
@@ -40151,9 +40599,9 @@ s7_pointer s7_copy(s7_scheme *sc, s7_pointer args)
return(dest);
/* if object_copy can't handle args for some reason, it should return #f (not dest), and we'll soldier on... */
}
- get = c_object_direct_ref(source);
+ get = c_object_direct_ref(sc, source);
if (!get) get = c_object_getter;
- end = object_length_to_int(sc, source);
+ end = c_object_length_to_int(sc, source);
break;
case T_LET:
@@ -40216,9 +40664,9 @@ s7_pointer s7_copy(s7_scheme *sc, s7_pointer args)
break;
case T_C_OBJECT:
- set = c_object_direct_set(dest);
+ set = c_object_direct_set(sc, dest);
if (!set) set = c_object_setter;
- dest_len = object_length_to_int(sc, dest);
+ dest_len = c_object_length_to_int(sc, dest);
break;
case T_LET:
@@ -40289,8 +40737,8 @@ s7_pointer s7_copy(s7_scheme *sc, s7_pointer args)
mj = make_mutable_integer(sc, end);
gc_loc1 = s7_gc_protect(sc, mi);
gc_loc2 = s7_gc_protect(sc, mj);
- ref = c_object_ref(source);
- set = c_object_set(dest);
+ ref = c_object_ref(sc, source);
+ set = c_object_set(sc, dest);
for (i = start, j = 0; i < end; i++, j++)
{
@@ -40320,7 +40768,11 @@ s7_pointer s7_copy(s7_scheme *sc, s7_pointer args)
{
if (hash_table_checker(dest) == hash_empty)
hash_table_checker(dest) = hash_table_checker(source);
- else hash_table_checker(dest) = hash_equal;
+ else
+ {
+ hash_table_checker(dest) = hash_equal;
+ hash_set_chosen(dest);
+ }
}
return(p);
}
@@ -40635,10 +41087,38 @@ also accepts a string or vector argument."
case T_C_OBJECT:
check_method(sc, p, sc->reverse_symbol, args);
- if (c_object_reverse(p))
- return((*(c_object_reverse(p)))(sc, args));
+ if (c_object_reverse(sc, p))
+ return((*(c_object_reverse(sc, p)))(sc, args));
eval_error(sc, "attempt to reverse ~S?", p);
+ case T_LET:
+ {
+ s7_pointer new_e, x;
+ s7_int id;
+ check_method(sc, p, sc->reverse_symbol, args);
+ if ((p == sc->rootlet) ||
+ (!is_slot(let_slots(p))) ||
+ (!is_slot(next_slot(let_slots(p)))))
+ return(p);
+ new_e = new_frame_in_env(sc, outlet(p));
+ set_all_methods(new_e, p);
+ sc->temp3 = new_e;
+ id = let_id(new_e);
+ for (x = let_slots(p); is_slot(x); x = next_slot(x))
+ {
+ s7_pointer z;
+ new_cell(sc, z, T_SLOT);
+ slot_set_symbol(z, slot_symbol(x));
+ slot_set_value(z, slot_value(x));
+ if (symbol_id(slot_symbol(z)) != id) /* keep shadowing intact */
+ symbol_set_local(slot_symbol(x), id, z);
+ next_slot(z) = let_slots(new_e);
+ let_slots(new_e) = z;
+ }
+ sc->temp3 = sc->nil;
+ return(new_e);
+ }
+
default:
method_or_bust_with_type_one_arg(sc, p, sc->reverse_symbol, args, a_sequence_string);
}
@@ -40821,8 +41301,8 @@ s7_pointer s7_fill(s7_scheme *sc, s7_pointer args)
case T_C_OBJECT:
check_method(sc, p, sc->fill_symbol, args);
- if (c_object_fill(p))
- return((*(c_object_fill(p)))(sc, args));
+ if (c_object_fill(sc, p))
+ return((*(c_object_fill(sc, p)))(sc, args));
eval_error(sc, "attempt to fill ~S?", p);
default:
@@ -40860,7 +41340,7 @@ static s7_int sequence_length(s7_scheme *sc, s7_pointer lst)
case T_C_OBJECT:
{
s7_pointer x;
- x = object_length(sc, lst);
+ x = c_object_length(sc, lst);
if (s7_is_integer(x))
return(s7_integer(x));
}
@@ -40868,7 +41348,7 @@ static s7_int sequence_length(s7_scheme *sc, s7_pointer lst)
return(-1);
}
-static s7_int total_sequence_length(s7_scheme *sc, s7_pointer args, s7_pointer caller, int32_t typ)
+static s7_int total_sequence_length(s7_scheme *sc, s7_pointer args, s7_pointer caller, uint8_t typ)
{
s7_pointer p;
int32_t i;
@@ -40899,7 +41379,7 @@ static s7_int total_sequence_length(s7_scheme *sc, s7_pointer args, s7_pointer c
return(len);
}
-static s7_pointer vector_append(s7_scheme *sc, s7_pointer args, int32_t typ)
+static s7_pointer vector_append(s7_scheme *sc, s7_pointer args, uint8_t typ)
{
s7_pointer new_vec;
s7_int len;
@@ -40941,6 +41421,7 @@ static s7_pointer vector_append(s7_scheme *sc, s7_pointer args, int32_t typ)
set_plist_2(sc, sc->nil, sc->nil);
sc->temp9 = sc->nil;
sc->temp10 = sc->nil;
+ free_cell(sc, sv);
vector_length(sv) = 0;
}
return(new_vec);
@@ -41180,7 +41661,7 @@ static s7_pointer object_to_list(s7_scheme *sc, s7_pointer obj)
s7_pointer x, z, result;
uint32_t gc_z;
- x = object_length(sc, obj);
+ x = c_object_length(sc, obj);
if (s7_is_integer(x))
len = s7_integer(x);
else return(sc->F);
@@ -41200,7 +41681,7 @@ static s7_pointer object_to_list(s7_scheme *sc, s7_pointer obj)
for (i = 0, x = result; i < len; i++, x = cdr(x))
{
set_car(z, make_integer(sc, i));
- set_car(x, (*(c_object_ref(obj)))(sc, obj, z));
+ set_car(x, (*(c_object_ref(sc, obj)))(sc, obj, z));
}
sc->x = car(sc->z2_1);
sc->z = car(sc->z2_2);
@@ -41216,8 +41697,7 @@ static s7_pointer object_to_list(s7_scheme *sc, s7_pointer obj)
/* -------------------------------- object->let -------------------------------- */
-static bool is_decodable(s7_scheme *sc, s7_pointer p);
-static s7_pointer stack_entries(s7_scheme *sc, s7_pointer stack, int32_t top);
+static s7_pointer stack_entries(s7_scheme *sc, s7_pointer stack, int64_t top);
static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args)
{
@@ -41306,6 +41786,7 @@ static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args)
((vector_has_dimensional_info(obj)) && (is_normal_vector(shared_vector(obj)))) ? shared_vector(obj) : sc->F)));
case T_C_POINTER:
+ /* raw_pointer_info can be a let and might have an object->let method (see c_object below) */
return(s7_inlet(sc, s7_list(sc, 10, sc->value_symbol, obj,
sc->type_symbol, sc->is_c_pointer_symbol,
s7_make_symbol(sc, "c-pointer"), s7_make_integer(sc, (s7_int)raw_pointer(obj)),
@@ -41468,8 +41949,10 @@ static s7_pointer g_object_to_let(s7_scheme *sc, s7_pointer args)
sc->type_symbol, sc->is_c_object_symbol,
s7_make_symbol(sc, "c-object-type"), s7_make_integer(sc, c_object_type(obj)),
s7_make_symbol(sc, "c-object-let"), clet,
- s7_make_symbol(sc, "class"), c_object_scheme_name(obj)));
- /* TODO: local 'let entry causes trouble -- it's an error now in s7_varlet */
+ s7_make_symbol(sc, "class"), c_object_scheme_name(sc, obj)));
+ /* TODO: local 'let entry causes trouble -- it's an error now in s7_varlet
+ * also how to examine the c_object_type table?
+ */
if ((is_let(clet)) &&
((has_methods(clet)) || (has_methods(obj))))
{
@@ -41615,7 +42098,7 @@ static s7_pointer stacktrace_find_caller(s7_scheme *sc, s7_pointer e)
return(sc->F);
}
-static bool stacktrace_find_let(s7_scheme *sc, int32_t loc, s7_pointer e)
+static bool stacktrace_find_let(s7_scheme *sc, int64_t loc, s7_pointer e)
{
return((loc > 0) &&
((stack_let(sc->stack, loc) == e) ||
@@ -41624,14 +42107,14 @@ static bool stacktrace_find_let(s7_scheme *sc, int32_t loc, s7_pointer e)
static int32_t stacktrace_find_error_hook_quit(s7_scheme *sc)
{
- int32_t i;
+ int64_t i;
for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4)
if (stack_op(sc->stack, i) == OP_ERROR_HOOK_QUIT)
return(i);
return(-1);
}
-static bool stacktrace_in_error_handler(s7_scheme *sc, int32_t loc)
+static bool stacktrace_in_error_handler(s7_scheme *sc, int64_t loc)
{
return((outlet(sc->owlet) == sc->envir) ||
(stacktrace_find_let(sc, loc * 4, outlet(sc->owlet))) ||
@@ -41827,7 +42310,7 @@ static char *stacktrace_add_func(s7_scheme *sc, s7_pointer f, s7_pointer code, c
static char *stacktrace_1(s7_scheme *sc, int32_t frames_max, int32_t code_cols, int32_t total_cols, int32_t notes_start_col, bool as_comment)
{
char *str;
- int32_t loc, top, frames = 0;
+ int64_t loc, top, frames = 0;
uint32_t gc_syms;
gc_syms = s7_gc_protect(sc, sc->nil);
@@ -41864,7 +42347,7 @@ static char *stacktrace_1(s7_scheme *sc, int32_t frames_max, int32_t code_cols,
s7_pointer code;
int32_t true_loc;
- true_loc = (int)(loc + 1) * 4 - 1;
+ true_loc = (int32_t)(loc + 1) * 4 - 1;
code = stack_code(sc->stack, true_loc); /* can code be free here? [hit this once, could not repeat it] */
if (is_pair(code))
@@ -41992,7 +42475,7 @@ line to be preceded by a semicolon."
}
else method_or_bust(sc, car(args), sc->stacktrace_symbol, args, T_INTEGER, 1);
}
- str = stacktrace_1(sc, (int)max_frames, (int)code_cols, (int)total_cols, (int)notes_start_col, as_comment);
+ str = stacktrace_1(sc, (int32_t)max_frames, (int32_t)code_cols, (int32_t)total_cols, (int32_t)notes_start_col, as_comment);
return(make_string_uncopied_with_length(sc, str, safe_strlen(str)));
}
@@ -42153,7 +42636,7 @@ static const char *type_name(s7_scheme *sc, s7_pointer arg, int32_t article)
switch (unchecked_type(arg))
{
case T_C_OBJECT:
- return(make_type_name(sc, object_types[c_object_type(arg)]->name, article));
+ return(make_type_name(sc, sc->c_object_types[c_object_type(arg)]->name, article));
case T_INPUT_PORT:
return(make_type_name(sc, (is_file_port(arg)) ? "input file port" : ((is_string_port(arg)) ? "input string port" : "input port"), article));
@@ -42197,7 +42680,7 @@ static s7_pointer prepackaged_type_name(s7_scheme *sc, s7_pointer x)
switch (type(x))
{
- case T_C_OBJECT: return(c_object_scheme_name(x));
+ case T_C_OBJECT: return(c_object_scheme_name(sc, x));
case T_INPUT_PORT: return((is_file_port(x)) ? an_input_file_port_string : ((is_string_port(x)) ? an_input_string_port_string : an_input_port_string));
case T_OUTPUT_PORT: return((is_file_port(x)) ? an_output_file_port_string : ((is_string_port(x)) ? an_output_string_port_string : an_output_port_string));
}
@@ -42391,7 +42874,7 @@ s7_pointer s7_dynamic_wind(s7_scheme *sc, s7_pointer init, s7_pointer body, s7_p
if (jump_loc != NO_JUMP)
{
if (jump_loc != ERROR_JUMP)
- eval(sc, sc->op);
+ eval(sc, sc->cur_op);
}
else
{
@@ -42445,7 +42928,7 @@ static s7_pointer g_catch(s7_scheme *sc, s7_pointer args)
new_cell(sc, p, T_CATCH);
catch_tag(p) = car(args);
catch_goto_loc(p) = s7_stack_top(sc);
- catch_op_loc(p) = (int)(sc->op_stack_now - sc->op_stack);
+ catch_op_loc(p) = (int32_t)(sc->op_stack_now - sc->op_stack);
catch_handler(p) = err;
if (is_any_macro(err))
@@ -42473,7 +42956,7 @@ static s7_pointer g_catch(s7_scheme *sc, s7_pointer args)
if (is_symbol(closure_args(proc)))
new_frame_with_slot(sc, closure_let(proc), sc->envir, closure_args(proc), sc->nil);
else new_frame(sc, closure_let(proc), sc->envir);
- push_stack(sc, OP_BEGIN_UNCHECKED, sc->args, sc->code);
+ push_stack_no_args(sc, OP_BEGIN1, _TPair(sc->code));
}
else push_stack(sc, OP_APPLY, sc->nil, proc);
@@ -42535,6 +43018,7 @@ static s7_pointer init_owlet(s7_scheme *sc)
#if WITH_HISTORY
sc->error_history = make_slot_1(sc, e, make_symbol(sc, "error-history"), sc->F); /* buffer of previous evaluations */
#endif
+ sc->temp3 = sc->nil;
return(e);
}
@@ -42569,7 +43053,7 @@ It has the additional local variables: error-type, error-data, error-code, error
static s7_pointer active_catches(s7_scheme *sc)
{
- int32_t i;
+ int64_t i;
s7_pointer x, lst;
lst = sc->nil;
for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4)
@@ -42592,7 +43076,7 @@ static s7_pointer active_catches(s7_scheme *sc)
static s7_pointer active_exits(s7_scheme *sc)
{
/* (call-with-exit (lambda (exiter) (*s7* 'exits))) */
- int32_t i;
+ int64_t i;
s7_pointer lst;
lst = sc->nil;
for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4)
@@ -42603,21 +43087,21 @@ static s7_pointer active_exits(s7_scheme *sc)
jump = stack_args(sc->stack, i); /* call this to jump */
if (is_any_closure(func))
- lst = cons(sc, cons(sc, car(closure_args(func)), jump), lst);
+ lst = cons_unchecked(sc, cons(sc, car(closure_args(func)), jump), lst);
else
{
if ((is_pair(func)) && (car(func) == sc->call_with_exit_symbol))
- lst = cons(sc, cons(sc, car(cadadr(func)), jump), lst); /* (call-with-exit (lambda (three) ...)) */
- else lst = cons(sc, cons(sc, sc->unspecified, jump), lst);
+ lst = cons_unchecked(sc, cons(sc, car(cadadr(func)), jump), lst); /* (call-with-exit (lambda (three) ...)) */
+ else lst = cons_unchecked(sc, cons(sc, sc->unspecified, jump), lst);
}
sc->w = lst;
}
return(reverse_in_place_unchecked(sc, sc->nil, lst));
}
-static s7_pointer stack_entries(s7_scheme *sc, s7_pointer stack, int32_t top)
+static s7_pointer stack_entries(s7_scheme *sc, s7_pointer stack, int64_t top)
{
- int32_t i;
+ int64_t i;
s7_pointer lst;
lst = sc->nil;
for (i = top - 1; i >= 3; i -= 4)
@@ -42658,10 +43142,21 @@ static bool catch_all_function(s7_scheme *sc, int32_t i, s7_pointer type, s7_poi
{
s7_pointer catcher;
catcher = stack_let(sc->stack, i);
+ sc->value = stack_args(sc->stack, i);
sc->op_stack_now = (s7_pointer *)(sc->op_stack + catch_all_op_loc(catcher));
sc->stack_end = (s7_pointer *)(sc->stack_start + catch_all_goto_loc(catcher));
pop_stack(sc);
- sc->value = catch_all_result(catcher);
+ if (is_pair(sc->value))
+ {
+ if (car(sc->value) == sc->quote_symbol)
+ sc->value = cadr(sc->value);
+ else sc->value = type;
+ }
+ else
+ {
+ if (is_symbol(sc->value))
+ sc->value = type;
+ }
return(true);
}
@@ -42676,7 +43171,7 @@ static bool catch_2_function(s7_scheme *sc, int32_t i, s7_pointer type, s7_point
(catch_tag(x) == type) ||
(type == sc->T))
{
- int32_t loc;
+ int64_t loc;
loc = catch_goto_loc(x);
sc->op_stack_now = (s7_pointer *)(sc->op_stack + catch_op_loc(x));
sc->stack_end = (s7_pointer *)(sc->stack_start + loc);
@@ -42690,7 +43185,7 @@ static bool catch_2_function(s7_scheme *sc, int32_t i, s7_pointer type, s7_point
set_car(sc->t2_2, info);
sc->args = sc->t2_1;
}
- sc->op = OP_APPLY;
+ sc->cur_op = OP_APPLY;
return(true);
}
return(false);
@@ -42704,9 +43199,9 @@ static bool catch_1_function(s7_scheme *sc, int32_t i, s7_pointer type, s7_point
(catch_tag(x) == type) ||
(type == sc->T))
{
- uint32_t loc;
+ uint64_t loc;
opcode_t op;
- s7_pointer catcher, error_func, body;
+ s7_pointer catcher, error_func, error_body, error_args;
op = stack_op(sc->stack, i);
sc->temp4 = stack_let(sc->stack, i); /* GC protect this, since we're moving the stack top below */
@@ -42728,39 +43223,53 @@ static bool catch_1_function(s7_scheme *sc, int32_t i, s7_pointer type, s7_point
/* if OP_CATCH_1, we deferred making the error handler until it is actually needed */
if (op == OP_CATCH_1)
- body = cdr(error_func);
+ {
+ error_body = cdr(error_func);
+ error_args = car(error_func);
+ }
else
{
if (is_closure(error_func))
- body = closure_body(error_func);
- else body = NULL;
+ {
+ error_body = closure_body(error_func);
+ error_args = closure_args(error_func);
+ }
+ else
+ {
+ error_body = NULL;
+ error_args = NULL;
+ }
}
- if ((body) && (is_null(cdr(body))))
+ if ((error_body) && (is_null(cdr(error_body))))
{
s7_pointer y = NULL;
- body = car(body);
- if (is_pair(body))
+ error_body = car(error_body);
+ if (is_pair(error_body))
{
- if (car(body) == sc->quote_symbol)
- y = cadr(body);
+ if (car(error_body) == sc->quote_symbol)
+ y = cadr(error_body);
else
{
- if ((car(body) == sc->car_symbol) &&
- (is_pair(error_func)) &&
- (cadr(body) == car(error_func)))
+ if ((car(error_body) == sc->car_symbol) &&
+ (cadr(error_body) == error_args))
y = type;
}
}
else
{
- if (is_symbol(body))
+ if (is_symbol(error_body))
{
- if ((is_pair(error_func)) &&
- (body == car(error_func)))
+ if (error_body == error_args)
y = list_2(sc, type, info);
+ else
+ {
+ if ((is_pair(error_args)) &&
+ (error_body == car(error_args)))
+ y = type;
+ }
}
- else y = body;
+ else y = error_body; /* not pair or symbol */
}
if (y)
{
@@ -42792,9 +43301,14 @@ static bool catch_1_function(s7_scheme *sc, int32_t i, s7_pointer type, s7_point
}
if (op == OP_CATCH_1)
{
- s7_pointer y = NULL;
- make_closure_without_capture(sc, y, car(error_func), cdr(error_func), sc->temp4);
- sc->code = y;
+ s7_pointer x;
+ new_cell(sc, x, T_CLOSURE | T_COPY_ARGS); /* never a safe_closure, apparently */
+ closure_set_args(x, car(error_func));
+ closure_set_body(x, cdr(error_func));
+ closure_set_setter(x, sc->F);
+ closure_arity(x) = CLOSURE_ARITY_NOT_SET;
+ closure_set_let(x, sc->temp4);
+ sc->code = x;
}
else sc->code = error_func;
sc->temp4 = sc->nil;
@@ -42811,19 +43325,9 @@ static bool catch_1_function(s7_scheme *sc, int32_t i, s7_pointer type, s7_point
s7_wrong_number_of_args_error(sc, "catch error handler should accept 2 args: ~S", sc->code);
return(false);
}
-
- /* since make_closure_with_let sets needs_copied_args and we're going to OP_APPLY,
- * we don't need a new list here.
- */
- if (needs_copied_args(sc->code))
- sc->args = list_2(sc, type, info);
- else
- {
- set_car(sc->t2_1, type);
- set_car(sc->t2_2, info);
- sc->args = sc->t2_1;
- }
- sc->op = OP_APPLY;
+
+ sc->args = list_2(sc, type, info); /* almost never able to skip this -- costs more to check! */
+ sc->cur_op = OP_APPLY;
/* explicit eval needed if s7_call called into scheme where a caught error occurred (ex6 in exs7.c)
* but putting it here (via eval(sc, OP_APPLY)) means the C stack is not cleared correctly in non-s7-call cases,
@@ -42936,7 +43440,7 @@ It looks for an existing catch with a matching tag, and jumps to it if found. O
#define Q_throw s7_make_circular_signature(sc, 2, 3, sc->values_symbol, sc->is_symbol_symbol, sc->T)
bool ignored_flag = false;
- int32_t i;
+ int64_t i;
s7_pointer type, info;
type = car(args);
@@ -42979,7 +43483,6 @@ static void s7_warn(s7_scheme *sc, int32_t len, const char *ctrl, ...)
s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info)
{
- static int32_t last_line = -1;
bool reset_error_hook = false;
s7_pointer cur_code;
@@ -43004,10 +43507,6 @@ s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info)
slot_set_value(sc->error_type, type);
slot_set_value(sc->error_data, info);
-#if DEBUGGING
- if (!is_let(sc->owlet))
- fprintf(stderr, "owlet clobbered!\n");
-#endif
if ((unchecked_type(sc->envir) != T_LET) &&
(sc->envir != sc->nil))
sc->envir = sc->nil; /* in reader, the envir frame is mostly ignored so it can be (and usually is) garbage */
@@ -43027,8 +43526,9 @@ s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info)
if ((is_pair(cur_code)) && /* can be () if unexpected close paren read error */
(has_line_number(cur_code)))
{
+ static int32_t last_line = -1;
int32_t line;
- line = (int)pair_line(cur_code); /* cast to int32_t (from uint32_t) for last_line */
+ line = (int32_t)pair_line(cur_code); /* cast to int32_t (from uint32_t) for last_line */
if (line != last_line)
{
last_line = line;
@@ -43067,7 +43567,7 @@ s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info)
}
{ /* look for a catcher */
- int32_t i;
+ int64_t i;
/* top is 1 past actual top, top - 1 is op, if op = OP_CATCH, top - 4 is the cell containing the catch struct */
for (i = s7_stack_top(sc) - 1; i >= 3; i -= 4)
{
@@ -43239,7 +43739,7 @@ s7_pointer s7_error(s7_scheme *sc, s7_pointer type, s7_pointer info)
*/
sc->value = type;
/* stack_reset(sc); */
- sc->op = OP_ERROR_QUIT;
+ sc->cur_op = OP_ERROR_QUIT;
}
if (sc->longjmp_ok) longjmp(sc->goto_start, ERROR_JUMP);
@@ -43402,7 +43902,7 @@ static char *truncate_string(char *form, int32_t len, use_write_t use_write, int
/* I guess we need to protect the outer double quotes in this case */
int32_t i;
for (i = len - 5; i >= (len / 2); i--)
- if (is_white_space((int)f[i]))
+ if (is_white_space((int32_t)f[i]))
{
form[i] = '.';
form[i + 1] = '.';
@@ -43434,7 +43934,7 @@ static char *truncate_string(char *form, int32_t len, use_write_t use_write, int
{
int32_t i;
for (i = len - 4; i >= (len / 2); i--)
- if (is_white_space((int)f[i]))
+ if (is_white_space((int32_t)f[i]))
{
form[i] = '.';
form[i + 1] = '.';
@@ -43506,7 +44006,7 @@ static char *current_input_string(s7_scheme *sc, s7_pointer pt)
const unsigned char *str;
char *msg;
int32_t i, j, start, pos;
- pos = (int)port_position(pt);
+ pos = (int32_t)port_position(pt);
start = pos - 40;
if (start < 0) start = 0;
msg = (char *)malloc(64 * sizeof(char));
@@ -43647,7 +44147,7 @@ static bool call_begin_hook(s7_scheme *sc)
* that I hope can't be optimized out of existence.
*/
opcode_t op;
- op = sc->op;
+ op = sc->cur_op;
push_stack(sc, OP_BARRIER, sc->args, sc->code);
sc->begin_hook(sc, &result);
@@ -43672,7 +44172,7 @@ static bool call_begin_hook(s7_scheme *sc)
return(true);
}
pop_stack_no_op(sc);
- sc->op = op; /* for better error handling. otherwise we get "barrier" as the offending function name in eval_error */
+ sc->cur_op = op; /* for better error handling. otherwise we get "barrier" as the offending function name in eval_error */
return(false);
}
@@ -43906,10 +44406,7 @@ static s7_pointer set_c_function_star_args(s7_scheme *sc)
return(call_args);
}
-static void apply_c_function_star(s7_scheme *sc)
-{
- sc->value = c_function_call(sc->code)(sc, set_c_function_star_args(sc));
-}
+#define apply_c_function_star(Sc) Sc->value = c_function_call(Sc->code)(Sc, set_c_function_star_args(Sc))
s7_pointer s7_apply_function_star(s7_scheme *sc, s7_pointer fnc, s7_pointer args)
{
@@ -43959,7 +44456,7 @@ s7_pointer s7_eval(s7_scheme *sc, s7_pointer code, s7_pointer e)
if (jump_loc != NO_JUMP)
{
if (jump_loc != ERROR_JUMP)
- eval(sc, sc->op);
+ eval(sc, sc->cur_op);
}
else
{
@@ -44015,7 +44512,7 @@ pass (rootlet):\n\
clear_all_optimizations(sc, sc->code);
}
if (s7_stack_top(sc) < 12)
- push_stack(sc, OP_BARRIER, sc->nil, sc->nil);
+ push_stack_op(sc, OP_BARRIER);
push_stack(sc, OP_EVAL, sc->args, sc->code);
return(sc->nil);
@@ -44042,11 +44539,11 @@ s7_pointer s7_call(s7_scheme *sc, s7_pointer func, s7_pointer args)
if (jump_loc != NO_JUMP)
{
if (jump_loc != ERROR_JUMP)
- eval(sc, sc->op);
+ eval(sc, sc->cur_op);
if ((jump_loc == CATCH_JUMP) && /* we're returning (back to eval) from an error in catch */
(sc->stack_end == sc->stack_start))
- push_stack(sc, OP_ERROR_QUIT, sc->nil, sc->nil);
+ push_stack_op(sc, OP_ERROR_QUIT);
}
else
{
@@ -44137,7 +44634,7 @@ static s7_pointer implicit_index(s7_scheme *sc, s7_pointer obj, s7_pointer indic
return(obj);
case T_C_OBJECT:
- return((*(c_object_ref(obj)))(sc, obj, indices));
+ return((*(c_object_ref(sc, obj)))(sc, obj, indices));
case T_LET:
obj = s7_let_ref(sc, obj, car(indices));
@@ -44244,7 +44741,7 @@ void s7_quit(s7_scheme *sc)
pop_input_port(sc);
stack_reset(sc);
- push_stack(sc, OP_EVAL_DONE, sc->nil, sc->nil);
+ push_stack_op_let(sc, OP_EVAL_DONE);
}
/* -------------------------------- exit -------------------------------- */
@@ -44402,33 +44899,33 @@ static s7_pointer all_x_c_char_eq(s7_scheme *sc, s7_pointer arg)
static s7_pointer all_x_not_is_eq_car_q(s7_scheme *sc, s7_pointer arg)
{
s7_pointer lst, a;
- a = cdadr(arg);
- lst = find_symbol_unchecked(sc, cadar(a));
+ a = opt_pair2(cdr(arg));
+ lst = find_symbol_unchecked(sc, opt_sym2(a));
if (!is_pair(lst))
- return(make_boolean(sc, is_false(sc, g_is_eq(sc, set_plist_2(sc, g_car(sc, set_plist_1(sc, lst)), cadadr(a))))));
- return(make_boolean(sc, car(lst) != cadadr(a)));
+ return(make_boolean(sc, is_false(sc, g_is_eq(sc, set_plist_2(sc, g_car(sc, set_plist_1(sc, lst)), opt_sym3(a))))));
+ return(make_boolean(sc, car(lst) != opt_sym3(a)));
}
static s7_pointer local_x_not_is_eq_car_q(s7_scheme *sc, s7_pointer arg)
{
s7_pointer lst, a;
- a = cdadr(arg);
- lst = local_symbol_value(cadar(a));
+ a = opt_pair2(cdr(arg));
+ lst = local_symbol_value(opt_sym2(a));
if (!is_pair(lst))
- return(make_boolean(sc, is_false(sc, g_is_eq(sc, set_plist_2(sc, g_car(sc, set_plist_1(sc, lst)), cadadr(a))))));
- return(make_boolean(sc, car(lst) != cadadr(a)));
+ return(make_boolean(sc, is_false(sc, g_is_eq(sc, set_plist_2(sc, g_car(sc, set_plist_1(sc, lst)), opt_sym3(a))))));
+ return(make_boolean(sc, car(lst) != opt_sym3(a)));
}
-static s7_pointer all_x_is_pair_cdr(s7_scheme *sc, s7_pointer arg)
+static s7_pointer all_x_is_pair_cdr_s(s7_scheme *sc, s7_pointer arg)
{
s7_pointer p;
- p = find_symbol_unchecked(sc, cadadr(arg));
+ p = find_symbol_unchecked(sc, opt_sym2(cdr(arg)));
if (is_pair(p))
return(make_boolean(sc, is_pair(cdr(p))));
return(g_is_pair(sc, set_plist_1(sc, g_cdr(sc, set_plist_1(sc, p)))));
}
-static s7_pointer local_x_is_pair_cdr(s7_scheme *sc, s7_pointer arg)
+static s7_pointer local_x_is_pair_cdr_s(s7_scheme *sc, s7_pointer arg)
{
s7_pointer p;
p = local_symbol_value(opt_sym2(cdr(arg)));
@@ -44560,14 +45057,14 @@ static s7_pointer all_x_not_s(s7_scheme *sc, s7_pointer arg)
return(make_boolean(sc, is_false(sc, find_symbol_unchecked(sc, cadr(arg)))));
}
-static s7_pointer all_x_not_is_pair(s7_scheme *sc, s7_pointer arg)
+static s7_pointer all_x_not_is_pair_s(s7_scheme *sc, s7_pointer arg)
{
- all_x_not_bool(sc, is_pair, sc->is_pair_symbol, find_symbol_unchecked(sc, cadadr(arg)));
+ all_x_not_bool(sc, is_pair, sc->is_pair_symbol, find_symbol_unchecked(sc, opt_sym3(arg)));
}
-static s7_pointer local_x_not_is_pair(s7_scheme *sc, s7_pointer arg)
+static s7_pointer local_x_not_is_pair_s(s7_scheme *sc, s7_pointer arg)
{
- all_x_not_bool(sc, is_pair, sc->is_pair_symbol, local_symbol_value(cadadr(arg)));
+ all_x_not_bool(sc, is_pair, sc->is_pair_symbol, local_symbol_value(opt_sym3(arg)));
}
static s7_pointer all_x_c_sc(s7_scheme *sc, s7_pointer arg)
@@ -44631,7 +45128,7 @@ static s7_pointer all_x_c_hash_table_ref_car(s7_scheme *sc, s7_pointer arg)
hash_entry_t *x;
table = find_symbol_unchecked(sc, cadr(arg));
- lst = find_symbol_unchecked(sc, cadr(caddr(arg)));
+ lst = find_symbol_unchecked(sc, opt_sym3(cdr(arg)));
if (!is_pair(lst))
return(simple_wrong_type_argument(sc, sc->car_symbol, lst, T_PAIR));
@@ -44660,21 +45157,21 @@ static s7_pointer all_x_c_qs(s7_scheme *sc, s7_pointer arg)
static s7_pointer all_x_c_sq(s7_scheme *sc, s7_pointer arg)
{
set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(arg)));
- set_car(sc->t2_2, cadr(caddr(arg)));
+ set_car(sc->t2_2, opt_con2(cdr(arg)));
return(c_call(arg)(sc, sc->t2_1));
}
static s7_pointer local_x_c_sq(s7_scheme *sc, s7_pointer arg)
{
set_car(sc->t2_1, local_symbol_value(cadr(arg)));
- set_car(sc->t2_2, cadr(caddr(arg)));
+ set_car(sc->t2_2, opt_con2(cdr(arg)));
return(c_call(arg)(sc, sc->t2_1));
}
static s7_pointer all_x_c_cq(s7_scheme *sc, s7_pointer arg)
{
set_car(sc->t2_1, cadr(arg));
- set_car(sc->t2_2, cadr(caddr(arg)));
+ set_car(sc->t2_2, opt_con2(cdr(arg)));
return(c_call(arg)(sc, sc->t2_1));
}
@@ -44836,7 +45333,7 @@ static s7_pointer local_x_c_opsq(s7_scheme *sc, s7_pointer arg)
static s7_pointer all_x_c_car_s(s7_scheme *sc, s7_pointer arg)
{
s7_pointer val;
- val = find_symbol_unchecked(sc, cadadr(arg));
+ val = find_symbol_unchecked(sc, opt_sym2(cdr(arg)));
set_car(sc->t1_1, (is_pair(val)) ? car(val) : g_car(sc, set_plist_1(sc, val)));
return(c_call(arg)(sc, sc->t1_1));
}
@@ -44844,7 +45341,7 @@ static s7_pointer all_x_c_car_s(s7_scheme *sc, s7_pointer arg)
static s7_pointer local_x_c_car_s(s7_scheme *sc, s7_pointer arg)
{
s7_pointer val;
- val = local_symbol_value(cadadr(arg));
+ val = local_symbol_value(opt_sym2(cdr(arg)));
set_car(sc->t1_1, (is_pair(val)) ? car(val) : g_car(sc, set_plist_1(sc, val)));
return(c_call(arg)(sc, sc->t1_1));
}
@@ -44852,7 +45349,7 @@ static s7_pointer local_x_c_car_s(s7_scheme *sc, s7_pointer arg)
static s7_pointer all_x_c_cdr_s(s7_scheme *sc, s7_pointer arg)
{
s7_pointer val;
- val = find_symbol_unchecked(sc, cadadr(arg));
+ val = find_symbol_unchecked(sc, opt_sym2(cdr(arg)));
set_car(sc->t1_1, (is_pair(val)) ? cdr(val) : g_cdr(sc, set_plist_1(sc, val)));
return(c_call(arg)(sc, sc->t1_1));
}
@@ -44860,7 +45357,7 @@ static s7_pointer all_x_c_cdr_s(s7_scheme *sc, s7_pointer arg)
static s7_pointer local_x_c_cdr_s(s7_scheme *sc, s7_pointer arg)
{
s7_pointer val;
- val = local_symbol_value(cadadr(arg));
+ val = local_symbol_value(opt_sym2(cdr(arg)));
set_car(sc->t1_1, (is_pair(val)) ? cdr(val) : g_cdr(sc, set_plist_1(sc, val)));
return(c_call(arg)(sc, sc->t1_1));
}
@@ -45512,6 +46009,22 @@ static s7_pointer all_x_closure_s(s7_scheme *sc, s7_pointer code)
return(result);
}
+static s7_pointer all_x_and_2_closure_s(s7_scheme *sc, s7_pointer code)
+{
+ s7_pointer result, old_e;
+
+ old_e = sc->envir;
+ sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), find_symbol_unchecked(sc, opt_sym2(code)));
+
+ code = cdar(closure_body(opt_lambda(code)));
+ result = c_call(code)(sc, car(code));
+ if (result != sc->F)
+ result = c_call(cdr(code))(sc, cadr(code));
+
+ sc->envir = old_e;
+ return(result);
+}
+
static s7_pointer all_x_closure_a(s7_scheme *sc, s7_pointer code)
{
s7_pointer result, old_e;
@@ -45607,8 +46120,8 @@ static void all_x_function_init(void)
}
static s7_pointer g_not_c_c(s7_scheme *sc, s7_pointer args);
-static s7_pointer g_not_is_pair(s7_scheme *sc, s7_pointer args);
-static s7_pointer g_is_pair_cdr(s7_scheme *sc, s7_pointer args);
+static s7_pointer g_not_is_pair_s(s7_scheme *sc, s7_pointer args);
+static s7_pointer g_is_pair_cdr_s(s7_scheme *sc, s7_pointer args);
static s7_pointer g_is_eq_car(s7_scheme *sc, s7_pointer args);
static s7_pointer g_is_eq_car_q(s7_scheme *sc, s7_pointer args);
static s7_pointer g_if_x2(s7_scheme *sc, s7_pointer args);
@@ -45628,16 +46141,15 @@ static s7_function all_x_eval(s7_scheme *sc, s7_pointer holder, s7_pointer e, sa
switch (optimize_op(arg))
{
case HOP_SAFE_C_C:
- if (c_call(arg) == g_not_is_pair)
- return((is_local_symbol(cdadr(arg))) ? local_x_not_is_pair : all_x_not_is_pair);
- if (c_call(arg) == g_is_pair_cdr)
+ if (c_call(arg) == g_not_is_pair_s)
{
- if (is_local_symbol(cdadr(arg)))
- {
- set_opt_sym2(cdr(arg), cadadr(arg));
- return(local_x_is_pair_cdr);
- }
- else return(all_x_is_pair_cdr);
+ set_opt_sym3(arg, cadadr(arg));
+ return((is_local_symbol(cdadr(arg))) ? local_x_not_is_pair_s : all_x_not_is_pair_s);
+ }
+ if (c_call(arg) == g_is_pair_cdr_s)
+ {
+ set_opt_sym2(cdr(arg), cadadr(arg));
+ return((is_local_symbol(cdadr(arg))) ? local_x_is_pair_cdr_s : all_x_is_pair_cdr_s);
}
if (c_call(arg) == g_add_cs1) return(all_x_c_add1);
if (c_call(arg) == g_add_cl1) return(local_x_c_add1);
@@ -45655,7 +46167,10 @@ static s7_function all_x_eval(s7_scheme *sc, s7_pointer holder, s7_pointer e, sa
if (c_call(arg) == g_not_c_c)
{
if (c_call(cadr(arg)) == g_is_eq_car_q)
- return((is_local_symbol(cdr(cadadr(arg)))) ? local_x_not_is_eq_car_q : all_x_not_is_eq_car_q);
+ {
+ set_opt_pair2(cdr(arg), cdadr(arg));
+ return((is_local_symbol(cdr(cadadr(arg)))) ? local_x_not_is_eq_car_q : all_x_not_is_eq_car_q);
+ }
return(all_x_not_c_c);
}
if (c_call(arg) == g_hash_table_ref_ss)
@@ -45695,8 +46210,16 @@ static s7_function all_x_eval(s7_scheme *sc, s7_pointer holder, s7_pointer e, sa
case HOP_SAFE_C_opSq:
if (car(arg) == sc->not_symbol) return((is_local_symbol(cdadr(arg))) ? local_x_c_not_opsq : all_x_c_not_opsq);
- if (caadr(arg) == sc->car_symbol) return((is_local_symbol(cdr(cadr(arg)))) ? local_x_c_car_s : all_x_c_car_s);
- if (caadr(arg) == sc->cdr_symbol) return((is_local_symbol(cdr(cadr(arg)))) ? local_x_c_cdr_s : all_x_c_cdr_s);
+ if (caadr(arg) == sc->car_symbol)
+ {
+ set_opt_sym2(cdr(arg), cadadr(arg));
+ return((is_local_symbol(cdr(cadr(arg)))) ? local_x_c_car_s : all_x_c_car_s);
+ }
+ if (caadr(arg) == sc->cdr_symbol)
+ {
+ set_opt_sym2(cdr(arg), cadadr(arg));
+ return((is_local_symbol(cdadr(arg))) ? local_x_c_cdr_s : all_x_c_cdr_s);
+ }
return((is_local_symbol(cdr(cadr(arg)))) ? local_x_c_opsq : all_x_c_opsq);
case HOP_SAFE_C_opSq_C:
@@ -45705,7 +46228,11 @@ static s7_function all_x_eval(s7_scheme *sc, s7_pointer holder, s7_pointer e, sa
case HOP_SAFE_C_SC:
return((is_local_symbol(cdr(arg))) ? local_x_c_sc : all_x_c_sc);
case HOP_SAFE_C_SQ:
+ set_opt_con2(cdr(arg), cadr(caddr(arg)));
return((is_local_symbol(cdr(arg))) ? local_x_c_sq : all_x_c_sq);
+ case HOP_SAFE_C_CQ:
+ set_opt_con2(cdr(arg), cadr(caddr(arg)));
+ return(all_x_c_cq);
case HOP_SAFE_C_SS:
if ((is_local_symbol(cdr(arg))) &&
@@ -45770,6 +46297,11 @@ static s7_function all_x_eval(s7_scheme *sc, s7_pointer holder, s7_pointer e, sa
if (!is_pair(caddr(arg)))
return(all_x_c_ac);
return(NULL);
+
+ case HOP_SAFE_CLOSURE_S_C:
+ if (c_call(car(closure_body(opt_lambda(arg)))) == g_and_2)
+ return(all_x_and_2_closure_s);
+ return(all_x_closure_s);
default:
/* if (!all_x_function[optimize_op(arg)]) fprintf(stderr, "all_x_eval %s %s\n", DISPLAY(arg), (is_optimized(arg)) ? opt_names[optimize_op(arg)] : "unopt"); */
@@ -47130,7 +47662,7 @@ static bool d_v_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer c
if (s7_apply_function(sc, checker, set_plist_1(sc, obj)) == sc->T)
{
opc->v1.p = slot;
- opc->v5.obj = (void *)s7_object_value(obj);
+ opc->v5.obj = (void *)s7_c_object_value(obj);
opc->v3.d_v_f = flt_func;
opc->v7.fd = opt_d_v;
return(true);
@@ -47488,7 +48020,7 @@ static bool d_vd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer
if (!is_pair(arg2))
{
opc->v1.p = slot;
- opc->v5.obj = (void *)s7_object_value(obj);
+ opc->v5.obj = (void *)s7_c_object_value(obj);
if (is_real(arg2))
{
opc->v2.x = s7_number_to_real(sc, arg2);
@@ -47517,7 +48049,7 @@ static bool d_vd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer
if (float_optimize(sc, cddr(car_x)))
{
opc->v1.p = slot;
- opc->v5.obj = (void *)s7_object_value(obj);
+ opc->v5.obj = (void *)s7_c_object_value(obj);
if (!d_vd_f_combinable(sc, start))
opc->v7.fd = opt_d_vd_f;
return(true);
@@ -48460,7 +48992,7 @@ static bool d_vid_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer
{
opc->v7.fd = opt_d_vid_ssf;
opc->v1.p = slot;
- opc->v5.obj = (void *)s7_object_value(obj);
+ opc->v5.obj = (void *)s7_c_object_value(obj);
opc->v2.p = find_symbol(sc, caddr(car_x));
if ((is_slot(opc->v2.p)) &&
(is_integer(slot_value(opc->v2.p))) &&
@@ -48523,7 +49055,7 @@ static bool d_vdd_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer
(float_optimize(sc, cdddr(car_x))))
{
opc->v1.p = slot;
- opc->v5.obj = (void *)s7_object_value(obj);
+ opc->v5.obj = (void *)s7_c_object_value(obj);
opc->v7.fd = opt_d_vdd_ff;
return(true);
}
@@ -50215,12 +50747,14 @@ static s7_pointer opt_p_cf_ff(void *p)
{
opt_info *o = (opt_info *)p;
opt_info *o1;
- s7_pointer po1, po2;
+ int32_t tx;
+ s7_pointer po2;
o1 = cur_sc->opts[++cur_sc->pc];
- po1 = o1->v7.fp(o1);
+ tx = next_tx(cur_sc);
+ cur_sc->t_temps[tx] = o1->v7.fp(o1);
o1 = cur_sc->opts[++cur_sc->pc];
po2 = o1->v7.fp(o1);
- return(o->v3.cf(cur_sc, set_plist_2(cur_sc, po1, po2)));
+ return(o->v3.cf(cur_sc, set_plist_2(cur_sc, cur_sc->t_temps[tx], po2)));
}
static s7_pointer opt_p_cf_fs(void *p)
@@ -50664,6 +51198,7 @@ static bool p_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer
func = s7_p_ppp_function(s_func);
if (func)
{
+ s7_pointer arg1, arg2, arg3;
int32_t start;
s7_pointer sig, checker = NULL;
sig = s7_procedure_signature(sc, s_func);
@@ -50674,10 +51209,13 @@ static bool p_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer
start = sc->pc;
opc->v3.p_ppp_f = func;
- if (is_symbol(cadr(car_x))) /* dealt with at the top -> p1 */
+ arg1 = cadr(car_x);
+ arg2 = caddr(car_x);
+ arg3 = cadddr(car_x);
+ if (is_symbol(arg1)) /* dealt with at the top -> p1 */
{
s7_pointer slot;
- slot = find_symbol(sc, cadr(car_x));
+ slot = find_symbol(sc, arg1);
if ((!is_slot(slot)) ||
(has_methods(slot_value(slot))))
return(return_false(sc, car_x, __func__, __LINE__));
@@ -50693,16 +51231,16 @@ static bool p_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer
if (s7_apply_function(sc, checker, set_plist_1(sc, slot_value(opc->v1.p))) == sc->T)
opc->v3.p_ppp_f = s7_p_ppp_direct_function(s_func);
}
- if (is_symbol(caddr(car_x)))
+ if (is_symbol(arg2))
{
- slot = find_symbol(sc, caddr(car_x));
+ slot = find_symbol(sc, arg2);
if ((is_slot(slot)) &&
(!has_methods(slot_value(slot))))
{
opc->v2.p = slot;
- if (is_symbol(cadddr(car_x)))
+ if (is_symbol(arg3))
{
- slot = find_symbol(sc, cadddr(car_x));
+ slot = find_symbol(sc, arg3);
if ((is_slot(slot)) &&
(!has_methods(slot_value(slot))))
{
@@ -50714,12 +51252,13 @@ static bool p_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer
}
else
{
- if ((!is_pair(cadddr(car_x))) ||
- (car(cadddr(car_x)) == sc->quote_symbol))
+ if ((!is_pair(arg3)) ||
+ ((car(arg3) == sc->quote_symbol) &&
+ (is_pair(cdr(arg3))))) /* (quote) as arg3 */
{
- if (!is_pair(cadddr(car_x)))
- opc->v4.p = cadddr(car_x);
- else opc->v4.p = cadr(cadddr(car_x));
+ if (!is_pair(arg3))
+ opc->v4.p = arg3;
+ else opc->v4.p = cadr(arg3);
opc->v7.fp = opt_p_ppp_ssc;
return(true);
}
@@ -50732,15 +51271,15 @@ static bool p_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer
pc_fallback(sc, start);
}
}
- if ((is_proper_quote(sc, caddr(car_x))) &&
- (is_symbol(cadddr(car_x))))
+ if ((is_proper_quote(sc, arg2)) &&
+ (is_symbol(arg3)))
{
s7_pointer val_slot;
- val_slot = find_symbol(sc, cadddr(car_x));
+ val_slot = find_symbol(sc, arg3);
if ((is_slot(val_slot)) &&
(!has_methods(val_slot)))
{
- opc->v4.p = cadr(caddr(car_x));
+ opc->v4.p = cadr(arg2);
opc->v2.p = val_slot;
opc->v7.fp = opt_p_ppp_scs;
return(true);
@@ -50748,10 +51287,10 @@ static bool p_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer
}
if (cell_optimize(sc, cddr(car_x)))
{
- if (is_symbol(cadddr(car_x)))
+ if (is_symbol(arg3))
{
s7_pointer val_slot;
- val_slot = find_symbol(sc, cadddr(car_x));
+ val_slot = find_symbol(sc, arg3);
if ((is_slot(val_slot)) &&
(!has_methods(val_slot)))
{
@@ -50787,14 +51326,17 @@ static s7_pointer opt_p_cf_ppp(void *p)
{
opt_info *o = (opt_info *)p;
opt_info *o1;
- s7_pointer po1, po2, po3;
+ int32_t tx1, tx2;
+ s7_pointer po3;
o1 = cur_sc->opts[++cur_sc->pc];
- po1 = o1->v7.fp(o1);
+ tx1 = next_tx(cur_sc);
+ cur_sc->t_temps[tx1] = o1->v7.fp(o1);
o1 = cur_sc->opts[++cur_sc->pc];
- po2 = o1->v7.fp(o1);
+ tx2 = next_tx(cur_sc);
+ cur_sc->t_temps[tx2] = o1->v7.fp(o1);
o1 = cur_sc->opts[++cur_sc->pc];
po3 = o1->v7.fp(o1);
- return(o->v2.cf(cur_sc, set_plist_3(cur_sc, po1, po2, po3)));
+ return(o->v2.cf(cur_sc, set_plist_3(cur_sc, cur_sc->t_temps[tx1], cur_sc->t_temps[tx2], po3)));
}
static bool p_cf_ppp_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x)
@@ -50840,8 +51382,8 @@ static s7_pointer opt_p_cf_any(void *p)
static bool p_cf_any_ok(s7_scheme *sc, opt_info *opc, s7_pointer s_func, s7_pointer car_x, int32_t len)
{
if ((is_safe_procedure(s_func)) &&
- ((int)c_function_required_args(s_func) <= (len - 1)) &&
- ((int)c_function_all_args(s_func) >= (len - 1)))
+ ((int32_t)c_function_required_args(s_func) <= (len - 1)) &&
+ ((int32_t)c_function_all_args(s_func) >= (len - 1)))
{
s7_pointer p;
opc->v1.i = (len - 1);
@@ -50910,7 +51452,7 @@ static bool p_implicit(s7_scheme *sc, s7_pointer car_x, int32_t len)
opc->v1.p = s_slot;
if (len == 2)
{
- /* TODO: c-object implicit ref is direct exists (pi case) */
+ /* TODO: c-object implicit ref if direct exists (pi case) */
switch (type(obj))
{
case T_STRING: opc->v3.p_pi_f = string_ref_p_pi_direct; break;
@@ -50927,7 +51469,7 @@ static bool p_implicit(s7_scheme *sc, s7_pointer car_x, int32_t len)
break;
case T_C_OBJECT:
- if (c_object_direct_ref(obj))
+ if (c_object_direct_ref(sc, obj))
opc->v3.p_pi_f = c_object_pi_direct;
/* this doesn't currently work because in opt_dotimes, safe_stepper is false;
* do_is_safe or whoever can't tell that (obj i) does not affect i!
@@ -50995,25 +51537,28 @@ static bool p_implicit(s7_scheme *sc, s7_pointer car_x, int32_t len)
} /* len==2 */
else
{
- s7_pointer p;
- opc->v1.i = len;
- for (p = car_x; is_pair(p); p = cdr(p))
- if (!cell_optimize(sc, p))
- break;
- if (is_null(p))
+ if (len > 2)
{
- opc->v7.fp = opt_p_cf_any;
- switch (type(obj)) /* string can't happen here (no multidimensional strings) */
+ s7_pointer p;
+ opc->v1.i = len;
+ for (p = car_x; is_pair(p); p = cdr(p))
+ if (!cell_optimize(sc, p))
+ break;
+ if (is_null(p))
{
- case T_PAIR: opc->v2.cf = g_list_ref; break;
- case T_HASH_TABLE: opc->v2.cf = g_hash_table_ref; break;
- /* case T_LET: opc->v2.cf = g_let_ref; break; */ /* this doesn't handle implicit indices via g_let_ref! apply_let */
- case T_VECTOR: opc->v2.cf = g_vector_ref; break;
- case T_INT_VECTOR: opc->v2.cf = g_int_vector_ref; break;
- case T_FLOAT_VECTOR: opc->v2.cf = g_float_vector_ref; break;
- default: return(return_false(sc, car_x, __func__, __LINE__));
+ opc->v7.fp = opt_p_cf_any;
+ switch (type(obj)) /* string can't happen here (no multidimensional strings) */
+ {
+ case T_PAIR: opc->v2.cf = g_list_ref; break;
+ case T_HASH_TABLE: opc->v2.cf = g_hash_table_ref; break;
+ /* case T_LET: opc->v2.cf = g_let_ref; break; */ /* this doesn't handle implicit indices via g_let_ref! apply_let */
+ case T_VECTOR: opc->v2.cf = g_vector_ref; break;
+ case T_INT_VECTOR: opc->v2.cf = g_int_vector_ref; break;
+ case T_FLOAT_VECTOR: opc->v2.cf = g_float_vector_ref; break;
+ default: return(return_false(sc, car_x, __func__, __LINE__));
+ }
+ return(true);
}
- return(true);
}
}
} /* obj is sequence */
@@ -52709,7 +53254,7 @@ static bool opt_cell_do(s7_scheme *sc, s7_pointer car_x, int32_t len)
if (is_slot(let_slots(frame)))
let_set_slots(frame, reverse_slots(sc, let_slots(frame)));
sc->envir = frame;
- push_stack(sc, OP_GC_PROTECT, frame, sc->nil);
+ push_stack_no_let_no_code(sc, OP_GC_PROTECT, frame);
for (p = cadr(car_x); is_pair(p); p = cdr(p))
{
@@ -52887,7 +53432,7 @@ static bool opt_cell_do(s7_scheme *sc, s7_pointer car_x, int32_t len)
var = caadr(car_x);
ind = car(var);
ind_step = caddr(var);
- end = car(caddr(car_x));
+ end = caaddr(car_x);
slot = let_slots(frame);
if ((is_pair(end)) && /* (= i len|100) */
@@ -53057,7 +53602,7 @@ static s7_pointer make_optlist(s7_scheme *sc)
int32_t i;
stored_optlists_size = INITIAL_STORED_OPTLISTS_SIZE;
stored_optlists = (s7_pointer *)malloc(INITIAL_STORED_OPTLISTS_SIZE * sizeof(s7_pointer));
- stofl = (int32_t *)malloc(INITIAL_STORED_OPTLISTS_SIZE * sizeof(int));
+ stofl = (int32_t *)malloc(INITIAL_STORED_OPTLISTS_SIZE * sizeof(int32_t));
stofl_loc = INITIAL_STORED_OPTLISTS_SIZE - 1;
for (i = 0; i < INITIAL_STORED_OPTLISTS_SIZE; i++)
stofl[i] = i;
@@ -53069,9 +53614,9 @@ static s7_pointer make_optlist(s7_scheme *sc)
new_size = 2 * size;
stored_optlists = (s7_pointer *)realloc(stored_optlists, new_size * sizeof(s7_pointer));
stored_optlists_size = new_size;
- stofl = (int32_t *)realloc(stofl, new_size * sizeof(int));
+ stofl = (int32_t *)realloc(stofl, new_size * sizeof(int32_t));
for (k = size; k < new_size; k++)
- stofl[++stofl_loc] = (int)k;
+ stofl[++stofl_loc] = k;
}
}
loc = stofl[stofl_loc--];
@@ -54117,15 +54662,188 @@ static bool tree_has_setters(s7_scheme *sc, s7_pointer tree)
return(tree_set_memq(sc, tree));
}
+static s7_pointer g_for_each_closure(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer body, f, seq;
+
+ seq = cadr(args);
+ if (is_null(seq)) return(sc->unspecified);
+ f = car(args);
+ body = closure_body(f);
+
+ if (!pair_no_opt(body))
+ {
+ s7_function func;
+ s7_pointer slot, old_e, expr, pars;
+
+ old_e = sc->envir;
+ pars = closure_args(f);
+ sc->envir = new_frame_in_env(sc, sc->envir);
+ if (is_pair(seq))
+ slot = make_slot_1(sc, sc->envir, car(pars), sc->F);
+ else
+ {
+ if (is_float_vector(seq))
+ slot = make_slot_1(sc, sc->envir, car(pars), real_zero);
+ else slot = make_slot_1(sc, sc->envir, car(pars), (is_int_vector(seq)) ? small_int(0) : sc->F);
+ }
+ if (is_null(cdr(body)))
+ {
+ expr = car(body);
+ func = s7_optimize_nr(sc, body);
+ }
+ else
+ {
+ expr = cons(sc, sc->begin_symbol, body);
+ func = s7_cell_optimize(sc, cons(sc, expr, sc->nil), true);
+ }
+
+ if (func)
+ {
+ if (is_pair(seq))
+ {
+ s7_pointer x, y;
+ for (x = seq, y = x; is_pair(x); )
+ {
+ slot_set_value(slot, car(x));
+ func(sc, expr);
+ x = cdr(x);
+ if (is_pair(x))
+ {
+ slot_set_value(slot, car(x));
+ func(sc, expr);
+ y = cdr(y);
+ x = cdr(x);
+ if (x == y) return(sc->unspecified);
+ }
+ }
+ return(sc->unspecified);
+ }
+
+ if (is_float_vector(seq))
+ {
+ s7_double *vals;
+ s7_int i, len;
+ len = vector_length(seq);
+ vals = float_vector_elements(seq);
+
+ if ((len > 1000) &&
+ (!tree_has_setters(sc, body)))
+ {
+ s7_pointer sv;
+ sv = s7_make_mutable_real(sc, 0.0);
+ slot_set_value(slot, sv);
+ for (i = 0; i < len; i++)
+ {
+ real(sv) = vals[i];
+ func(sc, expr);
+ }
+ return(sc->unspecified);
+ }
+ for (i = 0; i < len; i++)
+ {
+ slot_set_value(slot, make_real(sc, vals[i]));
+ func(sc, expr);
+ }
+ return(sc->unspecified);
+ }
+
+ /* if no set! vector|list|let|hash-table-set! set-car!|cdr! mutable arg? */
+ if (is_int_vector(seq))
+ {
+ s7_int *vals;
+ s7_int i, len;
+ len = vector_length(seq);
+ vals = int_vector_elements(seq);
+
+ if ((len > 1000) &&
+ (!tree_has_setters(sc, body)))
+ {
+ s7_pointer sv;
+ sv = make_mutable_integer(sc, 0);
+ slot_set_value(slot, sv);
+ for (i = 0; i < len; i++)
+ {
+ integer(sv) = vals[i];
+ func(sc, expr);
+ }
+ return(sc->unspecified);
+ }
+
+ for (i = 0; i < len; i++)
+ {
+ slot_set_value(slot, make_integer(sc, vals[i]));
+ func(sc, expr);
+ }
+ return(sc->unspecified);
+ }
+
+ sc->z = seq;
+ if (!is_iterator(sc->z))
+ sc->z = s7_make_iterator(sc, sc->z);
+ seq = sc->z;
+ push_stack_no_let(sc, OP_GC_PROTECT, seq, f);
+ sc->z = sc->nil;
+ while (true)
+ {
+ slot_set_value(slot, s7_iterate(sc, seq));
+ if (iterator_is_at_end(seq))
+ {
+ sc->stack_end -= 4;
+ return(sc->unspecified);
+ }
+ func(sc, expr);
+ }
+ }
+ set_pair_no_opt(body);
+ sc->envir = old_e;
+ }
+
+ if ((is_null(cdr(body))) &&
+ (is_pair(seq)))
+ {
+ s7_pointer c;
+ c = make_counter(sc, seq);
+ counter_set_result(c, seq);
+ push_stack(sc, OP_FOR_EACH_2, c, f);
+ return(sc->unspecified);
+ }
+
+ sc->z = seq;
+ if (!is_iterator(sc->z))
+ sc->z = s7_make_iterator(sc, sc->z);
+ push_stack(sc, OP_FOR_EACH_1, make_counter(sc, sc->z), f);
+ sc->z = sc->nil;
+ return(sc->unspecified);
+}
+
+static inline bool for_each_arg_is_null(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer p;
+ bool got_nil = false;
+ for (p = args; is_pair(p); p = cdr(p))
+ {
+ s7_pointer obj;
+ obj = car(p);
+ if (!is_mappable(obj))
+ {
+ if (is_null(obj))
+ got_nil = true;
+ else return(simple_wrong_type_argument_with_type(sc, sc->for_each_symbol, obj, a_sequence_string));
+ }
+ }
+ return(got_nil);
+}
+
static s7_pointer g_for_each(s7_scheme *sc, s7_pointer args)
{
#define H_for_each "(for-each proc object . objects) applies proc to each element of the objects traversed in parallel. \
Each object can be a list, string, vector, hash-table, or any other sequence."
#define Q_for_each s7_make_circular_signature(sc, 2, 3, sc->is_unspecified_symbol, sc->is_procedure_symbol, sc->is_sequence_symbol)
- s7_pointer p, f;
+ s7_pointer f;
int32_t len;
- bool got_nil = false, arity_ok = false;
+ bool arity_ok = false;
/* try the normal case first */
f = car(args); /* the function */
@@ -54153,20 +54871,6 @@ Each object can be a list, string, vector, hash-table, or any other sequence."
return(s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, for_each_args_error, f, small_int(len))));
}
- for (p = cdr(args); is_pair(p); p = cdr(p))
- {
- s7_pointer obj;
- obj = car(p);
- if (!is_mappable(obj))
- {
- if (is_null(obj))
- got_nil = true;
- else return(simple_wrong_type_argument_with_type(sc, sc->for_each_symbol, obj, a_sequence_string));
- }
- }
-
- if (got_nil) return(sc->unspecified);
-
/* if function is safe c func, do the for-each locally */
if ((is_safe_procedure(f)) &&
(is_c_function(f)))
@@ -54174,10 +54878,12 @@ Each object can be a list, string, vector, hash-table, or any other sequence."
s7_function func;
s7_pointer iters;
+ if (for_each_arg_is_null(sc, cdr(args))) return(sc->unspecified);
+
func = c_function_call(f);
sc->z = make_iterators(sc, args);
sc->z = cons(sc, sc->z, make_list(sc, len, sc->nil));
- push_stack(sc, OP_GC_PROTECT, sc->args, sc->z); /* temporary GC protection */
+ push_stack_no_let(sc, OP_GC_PROTECT, sc->args, sc->z); /* temporary GC protection */
if (len == 1)
{
s7_pointer x, y;
@@ -54221,161 +54927,104 @@ Each object can be a list, string, vector, hash-table, or any other sequence."
(is_closure(f)) && /* not lambda* that might get confused about arg names */
(closure_arity_to_int(sc, f) == 1) && /* not a rest arg: not is_pair: (lambda (x . args) arg) */
(!is_immutable_symbol(car(closure_args(f)))))
- {
- s7_pointer body, expr;
- body = closure_body(f);
- expr = car(body);
+ return(g_for_each_closure(sc, args));
- if (!pair_no_opt(body))
- {
- s7_function func;
- s7_pointer slot, old_e, seq;
+ if (for_each_arg_is_null(sc, cdr(args))) return(sc->unspecified);
- old_e = sc->envir;
- sc->envir = new_frame_in_env(sc, sc->envir);
- seq = cadr(args);
- if (is_pair(seq))
- slot = make_slot_1(sc, sc->envir, car(closure_args(f)), sc->F);
- else
- {
- if (is_float_vector(seq))
- slot = make_slot_1(sc, sc->envir, car(closure_args(f)), real_zero);
- else slot = make_slot_1(sc, sc->envir, car(closure_args(f)), (is_int_vector(seq)) ? small_int(0) : sc->F);
- }
- if (is_null(cdr(body)))
- func = s7_optimize_nr(sc, body);
- else func = s7_cell_optimize(sc, cons(sc, cons(sc, sc->begin_symbol, body), sc->nil), true);
+ push_stack(sc, OP_FOR_EACH, cons(sc, make_iterators(sc, args), make_list(sc, len, sc->nil)), f);
+ sc->z = sc->nil;
+ return(sc->unspecified);
+}
- if (func)
- {
- if (is_pair(seq))
- {
- s7_pointer x, y;
- for (x = seq, y = x; is_pair(x); )
- {
- slot_set_value(slot, car(x));
- func(sc, expr);
- x = cdr(x);
- if (is_pair(x))
- {
- slot_set_value(slot, car(x));
- func(sc, expr);
- y = cdr(y);
- x = cdr(x);
- if (x == y) return(sc->unspecified);
- }
- }
- return(sc->unspecified);
- }
- if (is_float_vector(seq))
- {
- s7_double *vals;
- s7_int i, len;
- len = vector_length(seq);
- vals = float_vector_elements(seq);
-
- if ((len > 1000) &&
- (!tree_has_setters(sc, body)))
- {
- s7_pointer sv;
- sv = s7_make_mutable_real(sc, 0.0);
- slot_set_value(slot, sv);
- for (i = 0; i < len; i++)
- {
- real(sv) = vals[i];
- func(sc, expr);
- }
- return(sc->unspecified);
- }
- for (i = 0; i < len; i++)
- {
- slot_set_value(slot, make_real(sc, vals[i]));
- func(sc, expr);
- }
- return(sc->unspecified);
- }
-
- /* if no set! vector|list|let|hash-table-set! set-car!|cdr! mutable arg? */
- if (is_int_vector(seq))
- {
- s7_int *vals;
- s7_int i, len;
- len = vector_length(seq);
- vals = int_vector_elements(seq);
-
- if ((len > 1000) &&
- (!tree_has_setters(sc, body)))
- {
- s7_pointer sv;
- sv = make_mutable_integer(sc, 0);
- slot_set_value(slot, sv);
- for (i = 0; i < len; i++)
- {
- integer(sv) = vals[i];
- func(sc, expr);
- }
- return(sc->unspecified);
- }
-
- for (i = 0; i < len; i++)
- {
- slot_set_value(slot, make_integer(sc, vals[i]));
- func(sc, expr);
- }
- return(sc->unspecified);
- }
+/* ---------------------------------------- map ---------------------------------------- */
- sc->z = seq;
- if (!is_iterator(sc->z))
- sc->z = s7_make_iterator(sc, sc->z);
- seq = sc->z;
- push_stack(sc, OP_GC_PROTECT, seq, f);
- sc->z = sc->nil;
- while (true)
- {
- slot_set_value(slot, s7_iterate(sc, seq));
- if (iterator_is_at_end(seq))
- {
- sc->stack_end -= 4;
- return(sc->unspecified);
- }
- func(sc, expr);
- }
- }
- set_pair_no_opt(body);
- sc->envir = old_e;
- }
+static s7_pointer slookup(s7_scheme *sc, s7_pointer s) {return(slot_value(s));}
+
+static s7_pointer g_map_closure(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer body, f, seq;
+ seq = cadr(args);
+ if (is_null(seq)) return(sc->nil);
+ f = car(args);
+ body = closure_body(f);
+
+ /* fprintf(stderr, "f: %p, args: %s, body: %s %s\n", f, DISPLAY(args), DISPLAY(body), DISPLAY(closure_let(f))); */
+
+ if ((is_pair(seq)) &&
+ (!pair_no_opt(body)) &&
+ (is_optimized(car(body)))) /* for index.scm? */
+ {
+ s7_function func;
+ s7_pointer slot, old_e, expr;
+
+ old_e = sc->envir;
+ sc->envir = new_frame_in_env(sc, closure_let(f));
+ slot = make_slot_1(sc, sc->envir, car(closure_args(f)), sc->F);
+
if (is_null(cdr(body)))
{
- p = cadr(args);
- if (is_pair(p))
+ expr = car(body);
+ if (is_symbol(expr))
{
- s7_pointer c;
- c = make_counter(sc, p);
- counter_set_result(c, p);
- push_stack(sc, OP_FOR_EACH_2, c, f);
- return(sc->unspecified);
+ expr = find_symbol(sc, expr);
+ func = slookup;
}
+ else func = s7_optimize(sc, body);
+ }
+ else
+ {
+ expr = cons(sc, sc->begin_symbol, body);
+ func = s7_cell_optimize(sc, cons(sc, expr, sc->nil), false);
}
- sc->z = cadr(args);
- if (!is_iterator(sc->z))
- sc->z = s7_make_iterator(sc, sc->z);
- push_stack(sc, OP_FOR_EACH_1, make_counter(sc, sc->z), f);
- sc->z = sc->nil;
+ if (func)
+ {
+ s7_pointer fast, slow, val;
+
+ val = sc->nil;
+ push_stack_no_let(sc, OP_GC_PROTECT, args, val); /* was sc->args? */
+ for (fast = seq, slow = seq; is_pair(fast); fast = cdr(fast), slow = cdr(slow))
+ {
+ s7_pointer z;
+ slot_set_value(slot, car(fast));
+ z = func(sc, expr);
+ if (z != sc->no_value)
+ val = cons(sc, z, val);
+ if (is_pair(cdr(fast)))
+ {
+ fast = cdr(fast);
+ if (fast == slow)
+ break;
+ slot_set_value(slot, car(fast));
+ z = func(sc, expr);
+ if (z != sc->no_value)
+ val = cons(sc, z, val);
+ }
+ }
+ sc->stack_end -= 4;
+ return(safe_reverse_in_place(sc, val));
+ }
+ set_pair_no_opt(body);
+ sc->envir = old_e;
+ }
+
+ if ((is_null(cdr(body))) &&
+ (is_pair(seq)))
+ {
+ closure_set_setter(f, seq);
+ push_stack(sc, OP_MAP_2, make_counter(sc, seq), f);
return(sc->unspecified);
}
- push_stack(sc, OP_FOR_EACH, cons(sc, make_iterators(sc, args), make_list(sc, len, sc->nil)), f);
+ sc->z = (!is_iterator(seq)) ? s7_make_iterator(sc, seq) : seq;
+ push_stack(sc, OP_MAP_1, make_counter(sc, sc->z), f);
sc->z = sc->nil;
- return(sc->unspecified);
+ return(sc->nil);
}
-/* ---------------------------------------- map ---------------------------------------- */
-
static s7_pointer g_map(s7_scheme *sc, s7_pointer args)
{
#define H_map "(map proc object . objects) applies proc to a list made up of the next element of each of its arguments, returning \
@@ -54402,8 +55051,8 @@ a list of the results. Its arguments can be lists, vectors, strings, hash-table
{
case T_C_FUNCTION:
case T_C_RST_ARGS_FUNCTION:
- if (((int)c_function_required_args(f) > len) ||
- ((int)c_function_all_args(f) < len))
+ if (((int32_t)c_function_required_args(f) > len) ||
+ ((int32_t)c_function_all_args(f) < len))
{
if (!map_args_error)
map_args_error = s7_make_permanent_string("map ~A: ~A args?");
@@ -54424,7 +55073,7 @@ a list of the results. Its arguments can be lists, vectors, strings, hash-table
s7_pointer f_args, val, fast, slow;
f_args = list_1(sc, sc->F);
val = list_1(sc, sc->nil);
- push_stack(sc, OP_GC_PROTECT, f_args, val);
+ push_stack_no_let(sc, OP_GC_PROTECT, f_args, val);
for (fast = cadr(args), slow = cadr(args); is_pair(fast); fast = cdr(fast), slow = cdr(slow))
{
s7_pointer z;
@@ -54454,7 +55103,7 @@ a list of the results. Its arguments can be lists, vectors, strings, hash-table
iter_list = sc->z;
old_args = sc->args;
func = c_function_call(f);
- push_stack(sc, OP_GC_PROTECT, val1, val = cons(sc, sc->nil, sc->code)); /* temporary GC protection: need to protect val1, iter_list, val */
+ push_stack_no_let(sc, OP_GC_PROTECT, val1, val = cons(sc, sc->nil, sc->code)); /* temporary GC protection: need to protect val1, iter_list, val */
sc->z = sc->nil;
while (true)
{
@@ -54501,56 +55150,9 @@ a list of the results. Its arguments can be lists, vectors, strings, hash-table
(fargs == 1) &&
(!is_immutable_symbol(car(closure_args(f)))))
{
- s7_pointer body, expr;
+ /* g_map_closure here if not s7_tree_memq 'map takes more time than it saves */
if (got_nil) return(sc->nil);
- body = closure_body(f);
- expr = car(body);
- if ((is_pair(cadr(args))) &&
- (!pair_no_opt(body)) &&
- (is_optimized(expr)))
- {
- s7_function func;
- s7_pointer slot, old_e;
-
- old_e = sc->envir;
- sc->envir = new_frame_in_env(sc, sc->envir);
- slot = make_slot_1(sc, sc->envir, car(closure_args(f)), sc->F);
-
- if (is_null(cdr(body)))
- func = s7_optimize(sc, body);
- else func = s7_cell_optimize(sc, cons(sc, cons(sc, sc->begin_symbol, body), sc->nil), false);
-
- if (func)
- {
- s7_pointer fast, slow, val;
-
- val = list_2(sc, sc->nil, f);
- push_stack(sc, OP_GC_PROTECT, sc->args, val);
- for (fast = cadr(args), slow = cadr(args); is_pair(fast); fast = cdr(fast), slow = cdr(slow))
- {
- s7_pointer z;
- slot_set_value(slot, car(fast));
- z = func(sc, expr);
- if (z != sc->no_value)
- set_car(val, cons(sc, z, car(val)));
- if (is_pair(cdr(fast)))
- {
- fast = cdr(fast);
- if (fast == slow)
- break;
- slot_set_value(slot, car(fast));
- z = func(sc, expr);
- if (z != sc->no_value)
- set_car(val, cons(sc, z, car(val)));
- }
- }
- sc->stack_end -= 4;
- return(safe_reverse_in_place(sc, car(val)));
- }
- set_pair_no_opt(body);
- sc->envir = old_e;
- }
-
+ /* don't go to OP_MAP_2 here! It assumes no recursion */
sc->z = (!is_iterator(cadr(args))) ? s7_make_iterator(sc, cadr(args)) : cadr(args);
push_stack(sc, OP_MAP_1, make_counter(sc, sc->z), f);
sc->z = sc->nil;
@@ -54595,7 +55197,7 @@ a list of the results. Its arguments can be lists, vectors, strings, hash-table
static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args)
{
- int32_t top;
+ int64_t top;
s7_pointer x;
top = s7_stack_top(sc) - 1; /* stack_end - stack_start: if this is negative, we're in big trouble */
@@ -54620,17 +55222,13 @@ static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args)
/* in the next set, the main evaluator branches blithely assume no multiple-values,
* and if it happens anyway, we vector to a different branch here
*/
- case OP_SAFE_C_opSq_P_1:
- vector_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_opSq_P_MV;
- return(args);
-
- case OP_SAFE_C_SSZ_1:
- case OP_EVAL_ARGS_SSP_1:
- vector_element(sc->stack, top) = (s7_pointer)OP_EVAL_ARGS_SSP_MV;
+ case OP_EVAL_ARGS_AAP_1:
+ vector_element(sc->stack, top) = (s7_pointer)OP_EVAL_ARGS_AAP_MV;
return(args);
- case OP_SAFE_C_SZ_1:
+ case OP_C_AP_1:
case OP_EVAL_ARGS_P_2:
+ case OP_EVAL_ARGS_P_4:
vector_element(sc->stack, top) = (s7_pointer)OP_EVAL_ARGS_P_2_MV;
return(args);
@@ -54638,11 +55236,6 @@ static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args)
vector_element(sc->stack, top) = (s7_pointer)OP_EVAL_ARGS_P_3_MV;
return(args);
- case OP_SAFE_C_ZC_1:
- case OP_EVAL_ARGS_P_4:
- vector_element(sc->stack, top) = (s7_pointer)OP_EVAL_ARGS_P_4_MV;
- return(args);
-
case OP_C_P_1:
case OP_SAFE_C_P_1:
case OP_NOT_P_1:
@@ -54663,19 +55256,11 @@ static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args)
case OP_CLOSURE_PA_1:
vector_element(sc->stack, top) = (s7_pointer)OP_CLOSURE_PA_MV;
return(args);
-
- case OP_C_AP_1:
- vector_element(sc->stack, top) = (s7_pointer)OP_C_AP_2;
- return(args);
case OP_SAFE_C_PP_1:
vector_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_PP_3;
return(args);
- case OP_SAFE_C_PP_2:
- vector_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_PP_4;
- return(args);
-
case OP_SAFE_C_PP_5:
vector_element(sc->stack, top) = (s7_pointer)OP_SAFE_C_PP_6;
return(args);
@@ -54723,9 +55308,12 @@ static s7_pointer splice_in_values(s7_scheme *sc, s7_pointer args)
eval_error_with_caller(sc, "~A: can't bind some variable to ~S", sc->let_star_symbol, args);
case OP_LETREC1:
+ set_multiple_value(args);
+ eval_error_with_caller(sc, "~A: can't bind some variable to ~S", sc->letrec_symbol, args);
+
case OP_LETREC_STAR1:
set_multiple_value(args);
- eval_error_with_caller(sc, "~A: can't bind some variable to ~S", (sc->op == OP_LETREC1) ? sc->letrec_symbol : sc->letrec_star_symbol, args);
+ eval_error_with_caller(sc, "~A: can't bind some variable to ~S", sc->letrec_star_symbol, args);
/* handle 'and' and 'or' specially */
case OP_AND1:
@@ -55346,38 +55934,60 @@ static token_t token(s7_scheme *sc)
}
}
-
-#define NOT_AN_X_CHAR -1
-
-static int32_t read_x_char(s7_pointer pt)
+static int32_t read_x_char(s7_scheme *sc, int32_t i, s7_pointer pt)
{
- /* possible "\xnn" char (write creates these things, so we have to read them)
+ /* possible "\xn...;" char (write creates these things, so we have to read them)
* but we could have crazy input like "\x -- with no trailing double quote
*/
- int32_t d1, c;
-
- c = inchar(pt);
- if (c == EOF)
- return(NOT_AN_X_CHAR);
-
- d1 = digits[c];
- if (d1 < 16)
+ while (true)
{
- int32_t d2;
+ int32_t d1, d2, c;
c = inchar(pt);
+ if (c == '"')
+ {
+ backchar(c, pt);
+ return(i);
+ }
+ if (c == ';') return(i);
+ if (c == EOF)
+ {
+ read_error(sc, "#<eof> in midst of hex-char");
+ return(i);
+ }
+ d1 = digits[c];
+ if (d1 >= 16)
+ {
+ sc->strbuf[i++] = c; /* just go on -- maybe a special char is not intended */
+ return(i);
+ }
+ c = inchar(pt);
+ if (c == '"')
+ {
+ sc->strbuf[i++] = d1;
+ backchar(c, pt);
+ return(i);
+ }
if (c == EOF)
- return(NOT_AN_X_CHAR);
+ {
+ read_error(sc, "#<eof> in midst of hex-char");
+ return(i);
+ }
+ if (c == ';')
+ {
+ sc->strbuf[i++] = d1;
+ return(i);
+ }
d2 = digits[c];
- if (d2 < 16)
- return(16 * d1 + d2); /* following char can be anything, including a number -- we ignore it */
- /* apparently one digit is also ok */
- backchar(c, pt);
- return(d1);
+ if (d2 >= 16)
+ {
+ sc->strbuf[i++] = c; /* just go on -- maybe a special char is not intended */
+ return(i);
+ }
+ sc->strbuf[i++] = 16 * d1 + d2;
}
- return(NOT_AN_X_CHAR);
+ return(i);
}
-
static s7_pointer unknown_string_constant(s7_scheme *sc, int32_t c)
{
/* check *read-error-hook* */
@@ -55486,58 +56096,43 @@ static s7_pointer read_string_constant(s7_scheme *sc, s7_pointer pt)
case '\\':
c = inchar(pt);
- if (c == EOF)
+ switch (c)
{
+ case EOF:
sc->strbuf[(i > 8) ? 8 : i] = '\0';
return(sc->F);
- }
-
- if ((c == '\\') || (c == '"') || (c == '|'))
- sc->strbuf[i++] = c;
- else
- {
- if (c == 'n')
- sc->strbuf[i++] = '\n';
- else
+
+ case '\\': case '"': case '|':
+ sc->strbuf[i++] = c;
+ break;
+
+ case 'n': sc->strbuf[i++] = '\n'; break;
+ case 't': sc->strbuf[i++] = '\t'; break;
+ case 'r': sc->strbuf[i++] = '\r'; break;
+ case '/': sc->strbuf[i++] = '/'; break;
+ case 'b': sc->strbuf[i++] = 8; break;
+ case 'f': sc->strbuf[i++] = 12; break;
+
+ case 'x':
+ i = read_x_char(sc, i, pt);
+ break;
+
+ default: /* if (!is_white_space(c)) */ /* changed 8-Apr-12 */
+ if ((c != '\n') && (c != '\r')) /* i.e. line continuation via #\\ at end of line */
{
- if (c == 't') /* this is for compatibility with other Schemes */
- sc->strbuf[i++] = '\t';
- else
- {
- if (c == 'x')
- {
- c = read_x_char(pt);
- if (c == NOT_AN_X_CHAR)
- {
- s7_pointer result;
- result = unknown_string_constant(sc, c);
- if (s7_is_character(result))
- sc->strbuf[i++] = character(result);
- else return(result);
- }
- sc->strbuf[i++] = (unsigned char)c;
- }
- else
- {
- /* if (!is_white_space(c)) */ /* changed 8-Apr-12 */
- if ((c != '\n') && (c != '\r'))
- {
- s7_pointer result;
- result = unknown_string_constant(sc, c);
- if (s7_is_character(result))
- sc->strbuf[i++] = character(result);
- else return(result);
- }
- /* #f here would give confusing error message "end of input", so return #t=bad backslash.
- * this is not optimal. It's easy to forget that backslash needs to be backslashed.
- *
- * the white_space business half-implements Scheme's \<newline>...<eol>... or \<space>...<eol>...
- * feature -- the characters after \ are flushed if they're all white space and include a newline.
- * (string->number "1\ 2") is 12?? Too bizarre.
- */
- }
- }
+ s7_pointer result;
+ result = unknown_string_constant(sc, c);
+ if (s7_is_character(result))
+ sc->strbuf[i++] = character(result);
+ else return(result);
}
+ /* #f here would give confusing error message "end of input", so return #t=bad backslash.
+ * this is not optimal. It's easy to forget that backslash needs to be backslashed.
+ *
+ * the white_space business half-implements Scheme's \<newline>...<eol>... or \<space>...<eol>...
+ * feature -- the characters after \ are flushed if they're all white space and include a newline.
+ * (string->number "1\ 2") is 12?? Too bizarre.
+ */
}
break;
@@ -55563,22 +56158,22 @@ static s7_pointer read_expression(s7_scheme *sc)
return(sc->eof_object);
case TOKEN_BYTE_VECTOR:
- push_stack_no_code(sc, OP_READ_BYTE_VECTOR, sc->nil); /* assume 1-dim for now */
+ push_stack_no_let_no_code(sc, OP_READ_BYTE_VECTOR, sc->nil); /* assume 1-dim for now */
sc->tok = TOKEN_LEFT_PAREN;
break;
case TOKEN_INT_VECTOR:
- push_stack_no_code(sc, OP_READ_INT_VECTOR, sc->w);
+ push_stack_no_let_no_code(sc, OP_READ_INT_VECTOR, sc->w);
sc->tok = TOKEN_LEFT_PAREN;
break;
case TOKEN_FLOAT_VECTOR:
- push_stack_no_code(sc, OP_READ_FLOAT_VECTOR, sc->w);
+ push_stack_no_let_no_code(sc, OP_READ_FLOAT_VECTOR, sc->w);
sc->tok = TOKEN_LEFT_PAREN;
break;
case TOKEN_VECTOR: /* already read #( -- TOKEN_VECTOR is triggered by #( */
- push_stack_no_code(sc, OP_READ_VECTOR, sc->w); /* sc->w is the dimensions */
+ push_stack_no_let_no_code(sc, OP_READ_VECTOR, sc->w); /* sc->w is the dimensions */
/* fall through */
case TOKEN_LEFT_PAREN:
@@ -55597,24 +56192,24 @@ static s7_pointer read_expression(s7_scheme *sc)
if (sc->tok == TOKEN_EOF)
return(missing_close_paren_error(sc));
- push_stack_no_code(sc, OP_READ_LIST, sc->nil);
+ push_stack_no_let_no_code(sc, OP_READ_LIST, sc->nil);
/* here we need to clear args, but code is ignored */
check_stack_size(sc);
break;
case TOKEN_QUOTE:
- push_stack_no_code(sc, OP_READ_QUOTE, sc->nil);
+ push_stack_no_let_no_code(sc, OP_READ_QUOTE, sc->nil);
sc->tok = token(sc);
break;
case TOKEN_BACK_QUOTE:
sc->tok = token(sc);
- push_stack_no_code(sc, OP_READ_QUASIQUOTE, sc->nil);
+ push_stack_no_let_no_code(sc, OP_READ_QUASIQUOTE, sc->nil);
break;
case TOKEN_COMMA:
- push_stack_no_code(sc, OP_READ_UNQUOTE, sc->nil);
+ push_stack_no_let_no_code(sc, OP_READ_UNQUOTE, sc->nil);
sc->tok = token(sc);
switch (sc->tok)
{
@@ -55645,7 +56240,7 @@ static s7_pointer read_expression(s7_scheme *sc)
break;
case TOKEN_AT_MARK:
- push_stack_no_code(sc, OP_READ_APPLY_VALUES, sc->nil);
+ push_stack_no_let_no_code(sc, OP_READ_APPLY_VALUES, sc->nil);
sc->tok = token(sc);
break;
@@ -55718,7 +56313,7 @@ static s7_pointer unbound_variable(s7_scheme *sc, s7_pointer sym)
/* this always occurs in a context where we're trying to find anything, so I'll move a couple of those checks here
*/
if (has_ref_fallback(sc->envir)) /* an experiment -- see s7test (with-let *db* (+ int32_t (length str))) */
- check_method(sc, sc->envir, sc->let_ref_fallback_symbol, sc->w = list_2(sc, sc->envir, sym));
+ apply_known_method(sc, sc->envir, sc->let_ref_fallback_symbol, sc->w = list_2(sc, sc->envir, sym));
/* but if the thing we want to hit this fallback happens to exist at a higher level, oops... */
if (sym == sc->unquote_symbol)
@@ -55969,8 +56564,8 @@ static s7_pointer g_pair_filename(s7_scheme *sc, s7_pointer args)
}
-static s7_pointer is_pair_car, is_pair_cdr, is_pair_cadr;
-static s7_pointer g_is_pair_car(s7_scheme *sc, s7_pointer args)
+static s7_pointer is_pair_car_s, is_pair_cdr_s, is_pair_cadr_s;
+static s7_pointer g_is_pair_car_s(s7_scheme *sc, s7_pointer args)
{
s7_pointer val;
val = find_symbol_unchecked(sc, cadar(args));
@@ -55979,7 +56574,7 @@ static s7_pointer g_is_pair_car(s7_scheme *sc, s7_pointer args)
return(g_is_pair(sc, set_plist_1(sc, g_car(sc, set_plist_1(sc, val)))));
}
-static s7_pointer g_is_pair_cdr(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_is_pair_cdr_s(s7_scheme *sc, s7_pointer args)
{
s7_pointer val;
val = find_symbol_unchecked(sc, cadar(args));
@@ -55988,7 +56583,7 @@ static s7_pointer g_is_pair_cdr(s7_scheme *sc, s7_pointer args)
return(g_is_pair(sc, set_plist_1(sc, g_cdr(sc, set_plist_1(sc, val)))));
}
-static s7_pointer g_is_pair_cadr(s7_scheme *sc, s7_pointer args)
+static s7_pointer g_is_pair_cadr_s(s7_scheme *sc, s7_pointer args)
{
s7_pointer val;
val = find_symbol_unchecked(sc, cadar(args));
@@ -56008,17 +56603,17 @@ static s7_pointer is_pair_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_
if (g == g_car)
{
set_optimize_op(expr, HOP_SAFE_C_C);
- return(is_pair_car);
+ return(is_pair_car_s);
}
if (g == g_cdr)
{
set_optimize_op(expr, HOP_SAFE_C_C);
- return(is_pair_cdr);
+ return(is_pair_cdr_s);
}
if (g == g_cadr)
{
set_optimize_op(expr, HOP_SAFE_C_C);
- return(is_pair_cadr);
+ return(is_pair_cadr_s);
}
}
return(f);
@@ -56107,45 +56702,47 @@ static s7_pointer g_format_allg_no_column(s7_scheme *sc, s7_pointer args)
static s7_pointer format_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops)
{
- s7_pointer port, str_arg;
- port = cadr(expr);
- str_arg = caddr(expr);
- if ((args > 1) &&
- (!is_string(port)) &&
- (is_string(str_arg)))
+ if (args > 1)
{
- if ((ops) && (args == 2))
+ s7_pointer port, str_arg;
+ port = cadr(expr);
+ str_arg = caddr(expr);
+ if ((!is_string(port)) &&
+ (is_string(str_arg)))
{
- int32_t len;
- char *orig;
- const char *p;
-
- orig = string_value(str_arg);
- p = strchr((const char *)orig, (int)'~');
- if (!p)
+ if ((ops) && (args == 2))
{
- if (s7_is_boolean(port))
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(format_just_newline); /* "just_newline" actually just outputs the control string -- see fixup below */
- }
-
- len = string_length(str_arg);
- if ((len > 1) &&
- (orig[len - 1] == '%') &&
- ((p - orig) == len - 2))
- {
- orig[len - 2] = '\n';
- orig[len - 1] = '\0';
- string_length(str_arg) = len - 1;
- if (s7_is_boolean(port))
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(format_just_newline);
+ int32_t len;
+ char *orig;
+ const char *p;
+
+ orig = string_value(str_arg);
+ p = strchr((const char *)orig, (int)'~');
+ if (!p)
+ {
+ if (s7_is_boolean(port))
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(format_just_newline); /* "just_newline" actually just outputs the control string -- see fixup below */
+ }
+
+ len = string_length(str_arg);
+ if ((len > 1) &&
+ (orig[len - 1] == '%') &&
+ ((p - orig) == len - 2))
+ {
+ orig[len - 2] = '\n';
+ orig[len - 1] = '\0';
+ string_length(str_arg) = len - 1;
+ if (s7_is_boolean(port))
+ set_optimize_op(expr, HOP_SAFE_C_C);
+ return(format_just_newline);
+ }
}
+ /* this used to worry about optimized expr and particular cases -- why? I can't find a broken case */
+ if (!is_columnizing(string_value(str_arg)))
+ return(format_allg_no_column);
+ return(format_allg);
}
- /* this used to worry about optimized expr and particular cases -- why? I can't find a broken case */
- if (!is_columnizing(string_value(str_arg)))
- return(format_allg_no_column);
- return(format_allg);
}
return(f);
}
@@ -56164,20 +56761,20 @@ static s7_pointer g_is_eq_car(s7_scheme *sc, s7_pointer args)
static s7_pointer g_is_eq_car_q(s7_scheme *sc, s7_pointer args)
{
s7_pointer lst;
- lst = find_symbol_unchecked(sc, cadar(args));
+ lst = find_symbol_unchecked(sc, opt_sym2(args));
if (is_pair(lst))
- return(make_boolean(sc, car(lst) == cadadr(args)));
- return(g_is_eq(sc, set_plist_2(sc, g_car(sc, set_plist_1(sc, lst)), cadadr(args))));
+ return(make_boolean(sc, car(lst) == opt_sym3(args)));
+ return(g_is_eq(sc, set_plist_2(sc, g_car(sc, set_plist_1(sc, lst)), opt_sym3(args))));
}
static s7_pointer g_is_eq_caar_q(s7_scheme *sc, s7_pointer args)
{
/* (eq? (caar x) 'y), but x is not guaranteed to be list(list) */
s7_pointer lst;
- lst = find_symbol_unchecked(sc, cadar(args));
+ lst = find_symbol_unchecked(sc, opt_sym2(args));
if ((!is_pair(lst)) || (!is_pair(car(lst))))
- return(g_is_eq(sc, set_plist_2(sc, g_caar(sc, set_plist_1(sc, lst)), cadadr(args))));
- return(make_boolean(sc, caar(lst) == cadadr(args)));
+ return(g_is_eq(sc, set_plist_2(sc, g_caar(sc, set_plist_1(sc, lst)), opt_sym3(args))));
+ return(make_boolean(sc, caar(lst) == opt_sym3(args)));
}
static s7_pointer is_eq_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_pointer expr, bool ops)
@@ -56198,11 +56795,15 @@ static s7_pointer is_eq_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_po
if (c_callee(cadr(expr)) == g_car)
{
set_optimize_op(expr, HOP_SAFE_C_C);
+ set_opt_sym2(cdr(expr), cadr(cadr(expr)));
+ set_opt_sym3(cdr(expr), cadr(caddr(expr)));
return(is_eq_car_q);
}
if (c_callee(cadr(expr)) == g_caar)
{
set_optimize_op(expr, HOP_SAFE_C_C);
+ set_opt_sym2(cdr(expr), cadr(cadr(expr)));
+ set_opt_sym3(cdr(expr), cadr(caddr(expr)));
return(is_eq_caar_q);
}
}
@@ -56211,18 +56812,14 @@ static s7_pointer is_eq_chooser(s7_scheme *sc, s7_pointer f, int32_t args, s7_po
}
-/* also not-chooser for all the ? procs, ss case for not equal? etc
- */
-static s7_pointer not_is_pair, not_is_symbol, not_is_null, not_is_number;
-static s7_pointer not_is_char, not_is_string, not_is_zero, not_is_eq_sq, not_is_eq_ss;
+static s7_pointer not_is_pair_s, not_is_symbol_s, not_is_null_s, not_is_number_s;
+static s7_pointer not_is_zero_s, not_is_eq_sq, not_is_eq_ss;
-static s7_pointer g_not_is_pair(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, is_pair, sc->is_pair_symbol, args);}
-static s7_pointer g_not_is_null(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, is_null, sc->is_null_symbol, args);}
-static s7_pointer g_not_is_symbol(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, is_symbol, sc->is_symbol_symbol, args);}
-static s7_pointer g_not_is_number(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, s7_is_number, sc->is_number_symbol, args);}
-static s7_pointer g_not_is_char(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, s7_is_character, sc->is_char_symbol, args);}
-static s7_pointer g_not_is_string(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, is_string, sc->is_string_symbol, args);}
-static s7_pointer g_not_is_zero(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, s7_is_zero, sc->is_zero_symbol, args);}
+static s7_pointer g_not_is_pair_s(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, is_pair, sc->is_pair_symbol, args);}
+static s7_pointer g_not_is_null_s(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, is_null, sc->is_null_symbol, args);}
+static s7_pointer g_not_is_symbol_s(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, is_symbol, sc->is_symbol_symbol, args);}
+static s7_pointer g_not_is_number_s(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, s7_is_number, sc->is_number_symbol, args);}
+static s7_pointer g_not_is_zero_s(s7_scheme *sc, s7_pointer args) {check_boolean_not_method(sc, s7_is_zero, sc->is_zero_symbol, args);}
/* eq? does not check for methods */
static s7_pointer g_not_is_eq_sq(s7_scheme *sc, s7_pointer args)
@@ -56236,8 +56833,8 @@ static s7_pointer g_not_is_eq_ss(s7_scheme *sc, s7_pointer args)
}
/* here the method finder is in either car or cdr */
-static s7_pointer not_is_pair_car;
-static s7_pointer g_not_is_pair_car(s7_scheme *sc, s7_pointer args)
+static s7_pointer not_is_pair_car_s;
+static s7_pointer g_not_is_pair_car_s(s7_scheme *sc, s7_pointer args)
{
s7_pointer val;
val = find_symbol_unchecked(sc, cadr(cadar(args)));
@@ -56266,17 +56863,17 @@ static s7_pointer not_chooser(s7_scheme *sc, s7_pointer g, int32_t args, s7_poin
if (f == g_is_pair)
{
set_optimize_op(expr, HOP_SAFE_C_C);
- return(not_is_pair);
+ return(not_is_pair_s);
}
if (f == g_is_null)
{
set_optimize_op(expr, HOP_SAFE_C_C);
- return(not_is_null);
+ return(not_is_null_s);
}
if (f == g_is_symbol)
{
set_optimize_op(expr, HOP_SAFE_C_C);
- return(not_is_symbol);
+ return(not_is_symbol_s);
}
/* g_is_number is c_function_call(slot_value(global_slot(sc->is_number_symbol)))
* so if this is changed (via openlet??) the latter is perhaps better??
@@ -56285,23 +56882,13 @@ static s7_pointer not_chooser(s7_scheme *sc, s7_pointer g, int32_t args, s7_poin
if ((f == g_is_number) || (f == g_is_complex))
{
set_optimize_op(expr, HOP_SAFE_C_C);
- return(not_is_number);
+ return(not_is_number_s);
}
if (f == g_is_zero)
{
set_optimize_op(expr, HOP_SAFE_C_C);
- return(not_is_zero);
- }
- if (f == g_is_char)
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(not_is_char);
- }
- if (f == g_is_string)
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(not_is_string);
+ return(not_is_zero_s);
}
}
if ((optimize_op(cadr(expr)) == HOP_SAFE_C_SQ) &&
@@ -56323,8 +56910,8 @@ static s7_pointer not_chooser(s7_scheme *sc, s7_pointer g, int32_t args, s7_poin
if (is_h_safe_c_c(cadr(expr)))
{
set_optimize_op(expr, HOP_SAFE_C_C);
- if (c_callee(cadr(expr)) == g_is_pair_car)
- return(not_is_pair_car);
+ if (c_callee(cadr(expr)) == g_is_pair_car_s)
+ return(not_is_pair_car_s);
return(not_c_c);
}
}
@@ -56358,15 +56945,6 @@ static s7_pointer vector_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t args,
default: return(vector_ref_ic);
}
}
-
- if ((is_pair(arg2)) &&
- (is_safely_optimized(arg2)) &&
- ((c_callee(arg2) == g_add_cs1) || (c_callee(arg2) == g_add_cl1)))
- {
- set_optimize_op(expr, HOP_SAFE_C_C);
- return(vector_ref_add1);
- }
-
if ((is_immutable_symbol(arg1)) &&
(is_slot(local_slot(arg1))))
{
@@ -56452,6 +57030,7 @@ static s7_pointer hash_table_ref_chooser(s7_scheme *sc, s7_pointer f, int32_t ar
(c_callee(caddr(expr)) == g_car))
{
set_optimize_op(expr, HOP_SAFE_C_C);
+ set_opt_sym3(cdr(expr), cadr(caddr(expr)));
return(hash_table_ref_car);
}
}
@@ -57095,11 +57674,11 @@ static s7_pointer g_or_3(s7_scheme *sc, s7_pointer args)
return(c_call(p)(sc, car(p)));
}
-
static s7_pointer and_n, and_2, and_sc, and_3;
static s7_pointer g_and_n(s7_scheme *sc, s7_pointer args)
{
s7_pointer p, x = sc->T;
+
for (p = args; is_pair(p); p = cdr(p))
{
x = c_call(p)(sc, car(p));
@@ -57403,7 +57982,6 @@ static void init_choosers(s7_scheme *sc)
vector_ref_ic_1 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_ic_1, 1, 0, false, "vector-ref opt");
vector_ref_ic_2 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_ic_2, 1, 0, false, "vector-ref opt");
vector_ref_ic_3 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_ic_3, 1, 0, false, "vector-ref opt");
- vector_ref_add1 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_add1, 2, 0, false, "vector-ref opt");
vector_ref_2 = make_function_with_class(sc, f, "vector-ref", g_vector_ref_2, 2, 0, false, "vector-ref opt");
vector_ref_2_direct = make_function_with_class(sc, f, "vector-ref", g_vector_ref_2_direct, 2, 0, false, "vector-ref opt");
@@ -57430,23 +58008,21 @@ static void init_choosers(s7_scheme *sc)
/* not */
f = set_function_chooser(sc, sc->not_symbol, not_chooser);
- not_is_pair = make_function_with_class(sc, f, "not", g_not_is_pair, 1, 0, false, "not opt");
- not_is_null = make_function_with_class(sc, f, "not", g_not_is_null, 1, 0, false, "not opt");
- not_is_symbol = make_function_with_class(sc, f, "not", g_not_is_symbol, 1, 0, false, "not opt");
- not_is_number = make_function_with_class(sc, f, "not", g_not_is_number, 1, 0, false, "not opt");
- not_is_zero = make_function_with_class(sc, f, "not", g_not_is_zero, 1, 0, false, "not opt");
- not_is_string = make_function_with_class(sc, f, "not", g_not_is_string, 1, 0, false, "not opt");
- not_is_char = make_function_with_class(sc, f, "not", g_not_is_char, 1, 0, false, "not opt");
+ not_is_pair_s = make_function_with_class(sc, f, "not", g_not_is_pair_s, 1, 0, false, "not opt");
+ not_is_null_s = make_function_with_class(sc, f, "not", g_not_is_null_s, 1, 0, false, "not opt");
+ not_is_symbol_s = make_function_with_class(sc, f, "not", g_not_is_symbol_s, 1, 0, false, "not opt");
+ not_is_number_s = make_function_with_class(sc, f, "not", g_not_is_number_s, 1, 0, false, "not opt");
+ not_is_zero_s = make_function_with_class(sc, f, "not", g_not_is_zero_s, 1, 0, false, "not opt");
not_is_eq_ss = make_function_with_class(sc, f, "not", g_not_is_eq_ss, 1, 0, false, "not opt");
not_is_eq_sq = make_function_with_class(sc, f, "not", g_not_is_eq_sq, 1, 0, false, "not opt");
- not_is_pair_car = make_function_with_class(sc, f, "not", g_not_is_pair_car, 1, 0, false, "not opt");
+ not_is_pair_car_s = make_function_with_class(sc, f, "not", g_not_is_pair_car_s, 1, 0, false, "not opt");
not_c_c = make_function_with_class(sc, f, "not", g_not_c_c, 1, 0, false, "not opt");
/* pair? */
f = set_function_chooser(sc, sc->is_pair_symbol, is_pair_chooser);
- is_pair_car = make_function_with_class(sc, f, "pair?", g_is_pair_car, 1, 0, false, "pair? opt");
- is_pair_cdr = make_function_with_class(sc, f, "pair?", g_is_pair_cdr, 1, 0, false, "pair? opt");
- is_pair_cadr = make_function_with_class(sc, f, "pair?", g_is_pair_cadr, 1, 0, false, "pair? opt");
+ is_pair_car_s = make_function_with_class(sc, f, "pair?", g_is_pair_car_s, 1, 0, false, "pair? opt");
+ is_pair_cdr_s = make_function_with_class(sc, f, "pair?", g_is_pair_cdr_s, 1, 0, false, "pair? opt");
+ is_pair_cadr_s = make_function_with_class(sc, f, "pair?", g_is_pair_cadr_s, 1, 0, false, "pair? opt");
/* null? */
f = set_function_chooser(sc, sc->is_null_symbol, is_null_chooser);
@@ -57466,10 +58042,12 @@ static void init_choosers(s7_scheme *sc)
/* memq */
f = set_function_chooser(sc, sc->memq_symbol, memq_chooser);
/* is pure-s7, use member here */
+ memq_2 = make_function_with_class(sc, f, "memq", g_memq_2, 2, 0, false, "memq opt");
memq_3 = make_function_with_class(sc, f, "memq", g_memq_3, 2, 0, false, "memq opt");
memq_4 = make_function_with_class(sc, f, "memq", g_memq_4, 2, 0, false, "memq opt");
memq_any = make_function_with_class(sc, f, "memq", g_memq_any, 2, 0, false, "memq opt");
memq_car = make_function_with_class(sc, f, "memq", g_memq_car, 2, 0, false, "memq opt");
+ memq_car_2 = make_function_with_class(sc, f, "memq", g_memq_car_2, 2, 0, false, "memq opt");
/* read-line */
read_line_uncopied = s7_make_function(sc, "read-line", g_read_line_uncopied, 1, 1, false, "read-line opt");
@@ -57638,15 +58216,13 @@ static int32_t combine_ops(s7_scheme *sc, s7_pointer func, s7_pointer expr, comb
set_opt_con2(cdr(expr), caddr(arg));
return(OP_SAFE_C_S_opSCq);
- case OP_SAFE_C_CS:
- /* expr is (* a (- 1 b)), e2 is (- 1 b) */
+ case OP_SAFE_C_CS: /* expr is (* a (- 1 b)), e2 is (- 1 b) */
set_opt_con1(cdr(expr), cadr(arg));
set_opt_sym2(cdr(expr), caddr(arg));
return(OP_SAFE_C_S_opCSq);
case OP_SAFE_C_LL:
- case OP_SAFE_C_SS:
- /* (* a (- b c)) */
+ case OP_SAFE_C_SS: /* (* a (- b c)) */
set_opt_sym1(cdr(expr), cadr(arg));
set_opt_sym2(cdr(expr), caddr(arg));
return(OP_SAFE_C_S_opSSq);
@@ -57698,7 +58274,6 @@ static int32_t combine_ops(s7_scheme *sc, s7_pointer func, s7_pointer expr, comb
case OP_SAFE_C_SC: return(OP_SAFE_C_opSCq_C);
case OP_SAFE_C_opSq: return(OP_SAFE_C_op_opSq_q_C);
case OP_SAFE_C_opSSq: return(OP_SAFE_C_op_opSSq_q_C);
-
case OP_SAFE_C_LL:
case OP_SAFE_C_SS: return(OP_SAFE_C_opSSq_C);
}
@@ -57758,7 +58333,6 @@ static int32_t combine_ops(s7_scheme *sc, s7_pointer func, s7_pointer expr, comb
arg_op = op_no_hop(arg);
switch (arg_op)
{
-
case OP_SAFE_C_S: case OP_SAFE_C_L: case OP_SAFE_CAR_S: case OP_SAFE_CDR_S: case OP_SAFE_CADR_S:
case OP_SAFE_IS_PAIR_S: case OP_SAFE_IS_NULL_S: case OP_SAFE_IS_SYMBOL_S:
if (is_safe_c_s(e1))
@@ -57776,7 +58350,6 @@ static int32_t combine_ops(s7_scheme *sc, s7_pointer func, s7_pointer expr, comb
set_direct_x_opt(expr);
}
}
- /* else fprintf(stderr, "opt: %s\n", DISPLAY_80(expr)); */
return(OP_SAFE_C_opSq_opSq);
}
if ((optimize_op_match(e1, OP_SAFE_C_SS)) || (optimize_op_match(e1, OP_SAFE_C_LL)))
@@ -57888,11 +58461,11 @@ static bool is_lambda(s7_scheme *sc, s7_pointer sym)
static opt_t optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer func, int32_t hop, int32_t pairs, int32_t symbols, int32_t quotes, int32_t bad_pairs, s7_pointer e)
{
s7_pointer arg1;
- /* very often, expr is already optimized */
- /* fprintf(stderr, "opt 1: %s\n", DISPLAY_80(expr)); */
+ /* very often, expr is already optimized, quoted stuff is counted under "bad_pairs"! as well as quotes */
+ /* fprintf(stderr, "opt 1: %s, hop: %d, pairs: %d, symbols: %d, quotes: %d, bad: %d\n", DISPLAY_80(expr), hop, pairs, symbols, quotes, bad_pairs); */
arg1 = cadr(expr);
- if ((bad_pairs == 0) &&
+ if ((bad_pairs == quotes) &&
(is_immutable_symbol(car(expr))))
hop = 1;
@@ -58151,7 +58724,7 @@ static opt_t optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fu
}
else /* pairs == 1 */
{
- if (bad_pairs == 0)
+ if (bad_pairs == quotes)
{
if ((is_optimized(arg1)) &&
(is_all_x_op(optimize_op(arg1))))
@@ -58191,7 +58764,7 @@ static opt_t optimize_func_one_arg(s7_scheme *sc, s7_pointer expr, s7_pointer fu
if (all_x_count(sc, expr) == 1)
{
- /* fprintf(stderr, "%d: %s %d %d\n", __LINE__, DISPLAY(car(expr)), is_local_symbol(expr), safe_case); */
+ set_unsafely_optimized(expr);
if ((safe_case) &&
(is_pair(car(body))) &&
(is_h_safe_c_c(car(body))))
@@ -58362,7 +58935,7 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f
arg1 = cadr(expr);
arg2 = caddr(expr);
- if ((bad_pairs == 0) &&
+ if ((bad_pairs == quotes) &&
(is_immutable_symbol(car(expr))))
hop = 1;
@@ -58614,7 +59187,10 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f
{
set_optimized(expr);
if (is_symbol(arg1))
- set_optimize_op(expr, hop + OP_SAFE_C_SQ);
+ {
+ set_opt_con1(cdr(expr), cadr(caddr(expr)));
+ set_optimize_op(expr, hop + OP_SAFE_C_SQ);
+ }
else set_optimize_op(expr, hop + OP_SAFE_C_QS);
choose_c_function(sc, expr, func, 2);
return(OPT_T);
@@ -58783,7 +59359,11 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f
{
if (car(arg1) == sc->quote_symbol)
set_optimize_op(expr, hop + OP_SAFE_C_QP);
- else set_optimize_op(expr, hop + ((is_optimized(arg1)) ? OP_SAFE_C_ZQ : OP_SAFE_C_PQ));
+ else
+ {
+ set_optimize_op(expr, hop + ((is_optimized(arg1)) ? OP_SAFE_C_ZQ : OP_SAFE_C_PQ));
+ set_opt_con2(cdr(expr), cadr(caddr(expr)));
+ }
set_unsafely_optimized(expr);
choose_c_function(sc, expr, func, 2);
return(OPT_F);
@@ -58808,7 +59388,6 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f
(symbols == 1) &&
(quotes == 0) &&
(!func_is_safe) &&
- /* (is_symbol(arg1)) */
((!is_pair(arg1)) ||
((is_optimized(arg1)) &&
(is_all_x_op(optimize_op(arg1))))))
@@ -58831,10 +59410,20 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f
annotate_arg(sc, cddr(expr), e);
set_unsafe_optimize_op(expr, hop + OP_C_FA);
code = sc->code; /* save old -- not of direct interest here -- just avoiding unexpected clobberage */
- sc->code = cdr(cadr(expr));
+ sc->code = cdadr(expr);
check_lambda(sc);
sc->code = code;
choose_c_function(sc, expr, func, 2);
+ if (((c_call(expr) == g_for_each) || (c_call(expr) == g_map)) &&
+ (is_pair(cadr(arg1))) &&
+ (is_null(cdadr(arg1))) &&
+ (is_pair(cddr(arg1))) &&
+ (is_null(cdddr(arg1))) &&
+ (!is_immutable_symbol(caadr(arg1))))
+ {
+ set_c_call(expr, (c_call(expr) == g_for_each) ? g_for_each_closure : g_map_closure);
+ set_unsafe_optimize_op(expr, HOP_C_FA_1);
+ }
return(OPT_F);
}
@@ -58873,7 +59462,25 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f
set_unsafely_optimized(expr);
if (symbols == 2)
{
- set_optimize_op(expr, hop + ((is_safe_closure(func)) ? OP_SAFE_CLOSURE_SS : ((is_null(cdr(closure_body(func)))) ? OP_CLOSURE_SS_P : OP_CLOSURE_SS)));
+ if (is_safe_closure(func))
+ set_optimize_op(expr, hop + ((is_null(cdr(closure_body(func)))) ? OP_SAFE_CLOSURE_SS : OP_SAFE_CLOSURE_SS_B));
+ else
+ {
+ s7_pointer body;
+ body = closure_body(func);
+ if ((is_null(cdr(body))) &&
+ (is_pair(car(body))) &&
+ (is_syntactic(caar(body))))
+ {
+ set_optimize_op(expr, hop + OP_CLOSURE_SS_P);
+ if (typesflag(car(body)) != SYNTACTIC_PAIR)
+ {
+ pair_set_syntax_op(car(body), symbol_syntax_op(caar(body)));
+ set_syntactic_pair(car(body));
+ }
+ }
+ else set_optimize_op(expr, hop + OP_CLOSURE_SS);
+ }
set_opt_sym2(expr, arg2);
}
else
@@ -58930,7 +59537,7 @@ static opt_t optimize_func_two_args(s7_scheme *sc, s7_pointer expr, s7_pointer f
annotate_arg(sc, cddr(expr), e);
set_unsafe_optimize_op(expr, hop + OP_CLOSURE_FA);
code = sc->code;
- sc->code = cdr(cadr(expr));
+ sc->code = cdadr(expr);
check_lambda(sc);
clear_safe_closure(cdr(sc->code)); /* otherwise we need to fixup the local let for the optimizer */
sc->code = code;
@@ -59039,7 +59646,7 @@ static opt_t optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer
}
/* end of bad symbol wrappers */
- if ((bad_pairs == 0) &&
+ if ((bad_pairs == quotes) &&
(is_immutable_symbol(car(expr))))
hop = 1;
@@ -59191,7 +59798,9 @@ static opt_t optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer
(is_symbol(arg1)) &&
(is_symbol(arg2)))
{
- set_optimize_op(expr, hop + OP_SAFE_C_SSZ);
+ annotate_arg(sc, cdr(expr), e);
+ annotate_arg(sc, cddr(expr), e);
+ set_optimize_op(expr, hop + OP_SAFE_C_AAZ);
}
else
{
@@ -59239,7 +59848,12 @@ static opt_t optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer
set_optimize_op(expr, hop + OP_SAFE_C_ZZA);
annotate_arg(sc, cdddr(expr), e);
}
- else set_optimize_op(expr, hop + OP_SAFE_C_ZZZ);
+ else
+ {
+ set_opt_pair2(cdr(expr), arg2);
+ set_opt_pair1(cdr(expr), arg3);
+ set_optimize_op(expr, hop + OP_SAFE_C_ZZZ);
+ }
}
}
}
@@ -59249,13 +59863,12 @@ static opt_t optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer
return(OPT_T);
}
- /* aap is not better than ssp, sap also saves very little */
- if ((pairs == 1) &&
- (bad_pairs == 1) &&
- (symbols == 2) &&
- (is_pair(arg3)))
+ if ((is_all_x_safe(sc, arg1)) &&
+ (is_all_x_safe(sc, arg2)))
{
- set_unsafe_optimize_op(expr, hop + ((is_optimized(arg3)) ? OP_SAFE_C_SSZ : OP_SAFE_C_SSP));
+ annotate_arg(sc, cdr(expr), e);
+ annotate_arg(sc, cddr(expr), e);
+ set_unsafe_optimize_op(expr, hop + OP_SAFE_C_AAP);
choose_c_function(sc, expr, func, 3);
return(OPT_F);
}
@@ -59303,8 +59916,11 @@ static opt_t optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer
(is_lambda(sc, car(error_lambda))) &&
(is_null(cadr(body_lambda))) &&
(is_not_null(cddr(body_lambda))) &&
- (is_symbol(cadr(error_lambda))) &&
- (!is_immutable_symbol(cadr(error_lambda))) &&
+ (((is_symbol(cadr(error_lambda))) && /* (lambda args ... */
+ (!is_immutable_symbol(cadr(error_lambda)))) ||
+ ((is_pair(cadr(error_lambda))) && /* (lambda (type info) ... */
+ (is_pair(cdadr(error_lambda))) &&
+ (is_null(cddadr(error_lambda))))) &&
(is_not_null(cddr(error_lambda))))
{
s7_pointer error_result;
@@ -59312,14 +59928,17 @@ static opt_t optimize_func_three_args(s7_scheme *sc, s7_pointer expr, s7_pointer
set_unsafely_optimized(expr);
if ((arg1 == sc->T) &&
(is_null(cdddr(error_lambda))) &&
- (!is_symbol(error_result)) &&
- ((!is_pair(error_result)) || (car(error_result) == sc->quote_symbol)))
+ ((!is_symbol(error_result)) || /* (lambda args #f) */
+ ((is_pair(cadr(error_lambda))) &&
+ (error_result == caadr(error_lambda)))) && /* (lambda (type info) type) */
+ ((!is_pair(error_result)) ||
+ (car(error_result) == sc->quote_symbol) || /* (lambda args 'a) */
+ ((car(error_result) == sc->car_symbol) &&
+ (cadr(error_result) == cadr(error_lambda))))) /* (lambda args (car args) -> error-type */
{
set_optimize_op(expr, hop + OP_C_CATCH_ALL);
set_c_function(expr, func);
- if (is_pair(error_result))
- set_opt_con2(expr, cadr(error_result));
- else set_opt_con2(expr, error_result);
+ set_opt_con2(expr, error_result);
set_opt_pair1(cdr(expr), cddr(body_lambda));
if ((is_null(cdddr(body_lambda))) &&
(is_optimized(caddr(body_lambda))))
@@ -59434,7 +60053,7 @@ static opt_t optimize_func_many_args(s7_scheme *sc, s7_pointer expr, s7_pointer
bool func_is_closure;
if (bad_pairs > quotes) return(OPT_F);
- if ((bad_pairs == 0) &&
+ if ((bad_pairs == quotes) &&
(is_immutable_symbol(car(expr))))
hop = 1;
@@ -59519,6 +60138,7 @@ static opt_t optimize_func_many_args(s7_scheme *sc, s7_pointer expr, s7_pointer
(args < GC_TRIGGER_SIZE))
{
bool safe_case;
+ set_unsafely_optimized(expr);
safe_case = is_safe_closure(func);
set_unsafe_optimize_op(expr, hop + ((safe_case) ? OP_SAFE_CLOSURE_ALL_X : OP_CLOSURE_ALL_X));
annotate_args(sc, cdr(expr), e);
@@ -59577,10 +60197,7 @@ static opt_t optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, in
opcode_t op;
s7_pointer p, body;
/* TODO: those not allowed need to be passed back and treated as unsafe symbols (find_uncomplicated_symbol etc) */
-#if 0
- if (!is_pair(cdr(expr))) /* cddr(expr) might be null if, for example, (begin (let ...)) */
- return(OPT_F);
-#endif
+
op = (opcode_t)syntax_opcode(func);
sc->w = e;
body = cdr(expr);
@@ -59885,7 +60502,7 @@ static opt_t optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, in
for (p = cdr(expr); (happy) && (is_pair(p)); p = cdr(p))
happy = is_all_x_safe(sc, car(p));
- if ((happy) &&
+ if ((happy) && /* all_x* will work */
(is_null(p))) /* catch the syntax error later: (or #f . 2) etc */
{
int32_t args, symbols = 0, pairs = 0, rest = 0;
@@ -59907,7 +60524,12 @@ static opt_t optimize_syntax(s7_scheme *sc, s7_pointer expr, s7_pointer func, in
((!is_h_safe_c_s(car(p))) ||
((sym) && (sym != cadar(p)))))
c_s_is_ok = false;
- else sym = cadar(p);
+ else
+ {
+ if (is_pair(cdar(p)))
+ sym = cadar(p);
+ else sym = sc->unspecified;
+ }
}
}
}
@@ -60023,7 +60645,7 @@ static opt_t optimize_expression(s7_scheme *sc, s7_pointer expr, int32_t hop, s7
{
s7_pointer car_expr;
- /* fprintf(stderr, "opt-expr %d %s %s\n", hop, DISPLAY(expr), DISPLAY(e)); */
+ /* fprintf(stderr, "opt-expr %d %s %s\n", hop, DISPLAY_80(expr), DISPLAY(e)); */
/* if (is_checked(expr)) return(OPT_T); */
set_checked(expr);
@@ -60553,8 +61175,7 @@ static s7_pointer check_lambda_star_args(s7_scheme *sc, s7_pointer args, int32_t
return(top);
}
-/* TODO: mark localized and check it
- * sort(etc) lambda form is ok -- maybe unsafe? there are about a dozen of these
+/* sort(etc) lambda form is ok -- maybe unsafe? there are about a dozen of these
* in tsort does do init (vc i) cause trouble (vc is arg) -- not localizable?
*/
@@ -60599,10 +61220,7 @@ static void cancel_sym(s7_scheme *sc, s7_pointer symbol, slist *top)
{
for (p = top; p; p = p->next)
if (p->sym == symbol)
- {
- /* fprintf(stderr, "%d: cancel %s in %s\n", line, DISPLAY(symbol), DISPLAY(x)); */
- p->sym = sc->gc_nil;
- }
+ p->sym = sc->gc_nil;
}
}
@@ -61240,7 +61858,7 @@ static s7_pointer optimize_lambda(s7_scheme *sc, bool unstarred_lambda, s7_point
(is_pair(cdr(arg))) && /* is not a ridiculous improper list */
((is_symbol(cadr(arg))) || /* if default value might involve eval in any way, it isn't simple */
((is_pair(cadr(arg))) && /* pair as default only ok if it is (quote ...) */
- (car(cadr(arg)) != sc->quote_symbol))))
+ (caadr(arg) != sc->quote_symbol))))
{
happy = false;
break;
@@ -61342,9 +61960,9 @@ static s7_pointer check_case(s7_scheme *sc)
eval_error(sc, "case has no clauses?: ~A", sc->code);
if (!is_pair(cadr(sc->code))) /* (case 1 1) */
eval_error(sc, "case clause is not a list? ~A", sc->code);
- set_opt_else(sc->code, sc->unspecified);
+ set_opt_any3(sc->code, sc->unspecified);
- for (x = cdr(sc->code); is_not_null(x); x = cdr(x))
+ for (x = cdr(sc->code); is_pair(x); x = cdr(x))
{
s7_pointer y, car_x;
if ((!is_pair(x)) || /* (case 1 ((2) 1) . 1) */
@@ -61368,19 +61986,26 @@ static s7_pointer check_case(s7_scheme *sc)
eval_error(sc, "case clause key list ~A is not a proper list or 'else'", y);
if (is_not_null(cdr(x))) /* (case 1 (else 1) ((2) 1)) */
eval_error(sc, "case 'else' clause, ~A, is not the last clause", x);
- if (is_pair(cddr(car_x)))
+ if (is_null(cdr(car_x))) /* (else) so return selector */
{
- set_opt_else(sc->code, cdr(car_x));
- /* fprintf(stderr, "else not simple\n"); */
- bodies_simple = false;
+ /* opt_any3?? */
}
else
{
- if ((bodies_simple) &&
- (keys_single))
- set_opt_else(sc->code, cadr(car_x));
- else set_opt_else(sc->code, cdr(car_x));
- set_opt_clause(x, cadr(car_x));
+ if (is_pair(cddr(car_x)))
+ {
+ set_opt_any3(sc->code, cdr(car_x));
+ /* fprintf(stderr, "else not simple\n"); */
+ bodies_simple = false;
+ }
+ else
+ {
+ if ((bodies_simple) &&
+ (keys_single))
+ set_opt_any3(sc->code, cadr(car_x));
+ else set_opt_any3(sc->code, cdr(car_x));
+ set_opt_clause(x, cadr(car_x));
+ }
}
}
else
@@ -61397,17 +62022,19 @@ static s7_pointer check_case(s7_scheme *sc)
key_type = NUM_TYPES;
}
- for (y = cdr(y); is_not_null(y); y = cdr(y))
+ for (y = cdr(y); is_pair(y); y = cdr(y))
{
- if (!is_pair(y)) /* (case () ((1 . 2) . hi) . hi) */
- eval_error(sc, "case key list is improper? ~A", x);
if (!is_simple(car(y)))
keys_simple = false;
if (key_type != type(car(y)))
key_type = NUM_TYPES;
}
+ if (!is_null(y)) /* (case () ((1 . 2) . hi) . hi) */
+ eval_error(sc, "case key list is improper? ~A", x);
}
y = car_x;
+ if (!s7_is_proper_list(sc, cdr(y)))
+ eval_error(sc, "case: stray dot? ~A", y);
if ((is_pair(cdr(y))) &&
(cadr(y) == sc->feed_to_symbol) &&
(s7_symbol_value(sc, sc->feed_to_symbol) == sc->undefined))
@@ -61419,6 +62046,8 @@ static s7_pointer check_case(s7_scheme *sc)
eval_error(sc, "case: '=>' has too many targets: ~A", y);
}
}
+ if (is_not_null(x)) /* (case x ((1 2)) . 1) */
+ eval_error(sc, "case: stray dot? ~A", sc->code);
if ((is_overlaid(sc->code)) &&
(has_opt_back(sc->code)))
@@ -61428,10 +62057,10 @@ static s7_pointer check_case(s7_scheme *sc)
{
for (x = cdr(sc->code); is_not_null(x); x = cdr(x))
{
- set_opt_key(x, caar(x));
- if (is_pair(opt_key(x)))
+ set_opt_any2(x, caar(x));
+ if (is_pair(opt_any2(x)))
{
- set_opt_key(x, car(opt_key(x)));
+ set_opt_any2(x, car(opt_any2(x)));
if (is_pair(cdar(x)))
set_opt_clause(x, cadar(x));
}
@@ -61441,8 +62070,8 @@ static s7_pointer check_case(s7_scheme *sc)
{
for (x = cdr(sc->code); is_not_null(x); x = cdr(x))
{
- set_opt_key(x, caar(x));
- if ((is_pair(opt_key(x))) &&
+ set_opt_any2(x, caar(x));
+ if ((is_pair(opt_any2(x))) &&
(is_pair(cdar(x))))
set_opt_clause(x, cadar(x));
}
@@ -61709,9 +62338,7 @@ static s7_pointer check_let(s7_scheme *sc)
set_local(y);
}
- /* we accept (let ((:hi 1)) :hi)
- * (let ('1) quote) [guile accepts this]
- */
+ /* (let ('1) quote) -> 1 */
if (is_not_null(x)) /* (let* ((a 1) . b) a) */
eval_error(sc, "let var list improper?: ~A", sc->code);
@@ -61885,7 +62512,7 @@ static s7_pointer check_let_star(s7_scheme *sc)
else
{
pair_set_syntax_symbol(sc->code, sc->named_let_star_symbol);
- set_opt_con2(sc->code, cadr(car(cadr(sc->code))));
+ set_opt_con2(sc->code, cadr(caadr(sc->code)));
}
return(sc->code);
}
@@ -61911,7 +62538,7 @@ static s7_pointer check_let_star(s7_scheme *sc)
if (is_pair(cadr(x)))
{
if ((!is_all_x_safe(sc, cadr(x))) &&
- (car(cadr(x)) != sc->quote_symbol))
+ (caadr(x) != sc->quote_symbol))
{
if (p == car(sc->code))
op = sc->let_star_a2_symbol;
@@ -62184,14 +62811,21 @@ static void set_if_opts(s7_scheme *sc, bool one_branch, bool reversed)
{
pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_and2, one_branch, reversed, not_case));
set_opt_pair2(sc->code, cdr(test));
- set_opt_and_2_test(sc->code, cddr(test));
+ set_opt_pair3(sc->code, cddr(test));
+ return;
+ }
+ if (c_callee(test) == g_and_3)
+ {
+ pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_and3, one_branch, reversed, not_case));
+ set_opt_pair2(sc->code, cdr(test));
+ set_opt_pair3(sc->code, cddr(test));
return;
}
if (c_callee(test) == g_or_2)
{
pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_or2, one_branch, reversed, not_case));
set_opt_pair2(sc->code, cdr(test));
- set_opt_and_2_test(sc->code, cddr(test));
+ set_opt_pair3(sc->code, cddr(test));
return;
}
set_opt_pair2(sc->code, cdr(test));
@@ -62201,20 +62835,14 @@ static void set_if_opts(s7_scheme *sc, bool one_branch, bool reversed)
if (is_h_safe_c_s(test))
{
- /* these miss methods? */
- if (car(test) == sc->is_pair_symbol)
- pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_is_pair, one_branch, reversed, not_case));
- else
+ uint8_t typ;
+ typ = symbol_type(car(test));
+ if (typ > 0)
{
- if (car(test) == sc->is_null_symbol)
- pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_is_null, one_branch, reversed, not_case));
- else
- {
- if (car(test) == sc->is_symbol_symbol)
- pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_is_symbol, one_branch, reversed, not_case));
- else pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_cs, one_branch, reversed, not_case));
- }
+ pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_is_type_s, one_branch, reversed, not_case));
+ set_opt_con3(sc->code, typ);
}
+ else pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_cs, one_branch, reversed, not_case));
set_opt_sym2(sc->code, cadr(test));
return;
}
@@ -62250,9 +62878,20 @@ static void set_if_opts(s7_scheme *sc, bool one_branch, bool reversed)
}
if (optimize_op(test) == HOP_SAFE_C_opSq)
{
- pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_opsq, one_branch, reversed, not_case));
- set_opt_pair2(sc->code, cadr(test));
- set_opt_sym3(sc->code, cadadr(test));
+ uint8_t typ;
+ typ = symbol_type(car(test));
+ if (typ > 0)
+ {
+ pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_is_type_opsq, one_branch, reversed, not_case));
+ set_opt_sym2(sc->code, cadadr(test));
+ set_opt_con3(sc->code, typ);
+ }
+ else
+ {
+ pair_set_syntax_symbol(sc->code, choose_if_opt(sc->if_opsq, one_branch, reversed, not_case));
+ set_opt_pair2(sc->code, cadr(test));
+ set_opt_sym3(sc->code, cadadr(test));
+ }
return;
}
if (is_all_x_safe(sc, test))
@@ -62347,6 +62986,11 @@ static s7_pointer check_when(s7_scheme *sc)
eval_error(sc, "when has no expression or body: ~A", sc->code);
if (!is_pair(cdr(sc->code))) /* (when 1) or (when 1 . 1) */
eval_error(sc, "when has no body?: ~A", sc->code);
+ else
+ {
+ if (!s7_is_proper_list(sc, cddr(sc->code)))
+ eval_error(sc, "when: stray dot?", sc->code);
+ }
if ((is_overlaid(sc->code)) &&
(has_opt_back(sc->code)))
@@ -62383,6 +63027,11 @@ static s7_pointer check_unless(s7_scheme *sc)
eval_error(sc, "unless has no expression or body: ~A", sc->code);
if (!is_pair(cdr(sc->code))) /* (unless 1) or (unless 1 . 1) */
eval_error(sc, "unless has no body?: ~A", sc->code);
+ else
+ {
+ if (!s7_is_proper_list(sc, cddr(sc->code)))
+ eval_error(sc, "unless: stray dot?", sc->code);
+ }
if ((is_overlaid(sc->code)) &&
(has_opt_back(sc->code)))
@@ -62414,15 +63063,15 @@ static s7_pointer check_define(s7_scheme *sc)
bool starred;
int32_t arity = CLOSURE_ARITY_NOT_SET;
- starred = (sc->op == OP_DEFINE_STAR);
+ starred = (sc->cur_op == OP_DEFINE_STAR);
if (starred)
{
caller = sc->define_star_symbol;
- sc->op = OP_DEFINE_STAR_UNCHECKED;
+ sc->cur_op = OP_DEFINE_STAR_UNCHECKED;
}
else
{
- if (sc->op == OP_DEFINE)
+ if (sc->cur_op == OP_DEFINE)
caller = sc->define_symbol;
else caller = sc->define_constant_symbol;
}
@@ -62488,7 +63137,7 @@ static s7_pointer check_define(s7_scheme *sc)
if ((is_overlaid(sc->code)) &&
(has_opt_back(sc->code)))
{
- if (sc->op == OP_DEFINE)
+ if (sc->cur_op == OP_DEFINE)
{
if ((is_pair(car(sc->code))) &&
(!symbol_has_accessor(func)) &&
@@ -62508,10 +63157,10 @@ static s7_pointer check_define(s7_scheme *sc)
static int32_t define_unchecked_ex(s7_scheme *sc)
{
- if (sc->op == OP_DEFINE_STAR_UNCHECKED)
+ if (sc->cur_op == OP_DEFINE_STAR_UNCHECKED)
{
s7_pointer x;
- uint32_t typ;
+ uint64_t typ;
if (is_safe_closure(cdr(sc->code)))
typ = T_CLOSURE_STAR | T_SAFE_CLOSURE;
else typ = T_CLOSURE_STAR;
@@ -62545,14 +63194,15 @@ static int32_t define_unchecked_ex(s7_scheme *sc)
}
else
{
- s7_pointer x;
+ s7_pointer x,args;
/* a closure. If we called this same code earlier (a local define), the only thing
* that is new here is the environment -- we can't blithely save the closure object
* in opt2 somewhere, and pick it up the next time around (since call/cc might take
* us back to the previous case). We also can't re-use opt2(sc->code) because opt2
* is not cleared in the gc.
*/
- make_closure_with_let(sc, x, cdar(sc->code), cdr(sc->code), sc->envir);
+ args = cdar(sc->code);
+ make_closure_with_let(sc, x, args, cdr(sc->code), sc->envir, (is_null(args)) ? 0 : CLOSURE_ARITY_NOT_SET);
sc->value = _NFre(x);
sc->code = caar(sc->code);
}
@@ -62652,11 +63302,11 @@ static s7_pointer check_define_macro(s7_scheme *sc, opcode_t op)
for ( ; is_pair(y); y = cdr(y))
if ((!is_symbol(car(y))) &&
- ((sc->op == OP_DEFINE_MACRO) || (sc->op == OP_DEFINE_BACRO) || (sc->op == OP_DEFINE_EXPANSION)))
+ ((op == OP_DEFINE_MACRO) || (op == OP_DEFINE_BACRO) || (op == OP_DEFINE_EXPANSION)))
return(s7_error(sc, sc->syntax_error_symbol, /* (define-macro (mac 1) ...) */
set_elist_3(sc, s7_make_string_wrapper(sc, "define-macro ~A argument name is not a symbol: ~S"), x, y)));
- if ((sc->op == OP_DEFINE_MACRO_STAR) || (sc->op == OP_DEFINE_BACRO_STAR))
+ if ((op == OP_DEFINE_MACRO_STAR) || (op == OP_DEFINE_BACRO_STAR))
set_cdar(sc->code, check_lambda_star_args(sc, cdar(sc->code), NULL));
else check_lambda_args(sc, cdar(sc->code), NULL);
@@ -62665,7 +63315,7 @@ static s7_pointer check_define_macro(s7_scheme *sc, opcode_t op)
static int32_t expansion_ex(s7_scheme *sc)
{
- int32_t loc;
+ int64_t loc;
s7_pointer caller;
/* read-time macro expansion:
@@ -62790,16 +63440,24 @@ static s7_pointer check_cond(s7_scheme *sc)
{
s7_pointer y;
y = car(x);
- if ((!is_pair(cdr(y))) && (!is_null(cdr(y)))) /* (cond (1 . 2)) */
- eval_error(sc, "cond: stray dot? ~A", sc->code);
- if ((cadr(y) == sc->feed_to_symbol) &&
- (s7_symbol_value(sc, sc->feed_to_symbol) == sc->undefined))
+ if (!s7_is_proper_list(sc, cdr(y)))
+ eval_error(sc, "stray dot? ~A", y);
+ if (is_pair(cdr(y)))
{
- has_feed_to = true;
- if (!is_pair(cddr(y))) /* (cond (#t =>)) or (cond (#t => . 1)) */
- eval_error(sc, "cond: '=>' target missing? ~A", x);
- if (is_pair(cdddr(y))) /* (cond (1 => + abs)) */
- eval_error(sc, "cond: '=>' has too many targets: ~A", x);
+ if ((cadr(y) == sc->feed_to_symbol) &&
+ (s7_symbol_value(sc, sc->feed_to_symbol) == sc->undefined))
+ {
+ has_feed_to = true;
+ if (!is_pair(cddr(y))) /* (cond (#t =>)) or (cond (#t => . 1)) */
+ eval_error(sc, "cond: '=>' target missing? ~A", x);
+ if (is_pair(cdddr(y))) /* (cond (1 => + abs)) */
+ eval_error(sc, "cond: '=>' has too many targets: ~A", x);
+ }
+ }
+ else
+ {
+ if (!is_null(cdr(y))) /* (cond (1 . 2)) */
+ eval_error(sc, "cond: stray dot? ~A", sc->code);
}
/* currently we accept:
* (cond (1 2) (=> . =>)) and all variants thereof, e.g. (cond (1 2) (=> 1 . 2) (1 2)) or
@@ -62896,8 +63554,8 @@ static int32_t feed_to(s7_scheme *sc)
if ((is_c_function(func)) &&
(is_safe_procedure(func)))
{
- if (((int)c_function_required_args(func) <= 1) &&
- ((int)c_function_all_args(func) >= 1))
+ if (((int32_t)c_function_required_args(func) <= 1) &&
+ ((int32_t)c_function_all_args(func) >= 1))
{
sc->value = c_function_call(func)(sc, set_plist_1(sc, sc->value));
return(goto_START);
@@ -63033,7 +63691,7 @@ static s7_pointer check_set(s7_scheme *sc)
}
else
{
- if ((car(cadr(inner)) == sc->quote_symbol) &&
+ if ((caadr(inner) == sc->quote_symbol) &&
(is_symbol(car(inner))) &&
((is_symbol(value)) || (is_all_x_safe(sc, value))))
{
@@ -63140,42 +63798,41 @@ static s7_pointer check_set(s7_scheme *sc)
pair_set_syntax_symbol(sc->code, sc->set_symbol_a_symbol);
annotate_arg(sc, cdr(sc->code), sc->envir);
}
- if (is_callable_c_op(optimize_op(value)))
+ if ((is_callable_c_op(optimize_op(value))) &&
+ (is_pair(cdr(value))) &&
+ (settee == cadr(value)) &&
+ (!is_null(cddr(value))))
{
- if ((settee == cadr(value)) &&
- (!is_null(cddr(value))))
+ if (is_null(cdddr(value)))
{
- if (is_null(cdddr(value)))
+ if (is_all_x_safe(sc, caddr(value)))
{
- if (is_all_x_safe(sc, caddr(value)))
- {
- /* this appears to give a slight savings over the SZ case */
- pair_set_syntax_symbol(sc->code, sc->increment_sa_symbol);
- annotate_arg(sc, cddr(value), sc->envir); /* this sets c_callee(arg) */
- set_opt_pair2(sc->code, cddr(value));
- }
- else
- {
- if (is_optimized(caddr(value)))
- {
- pair_set_syntax_symbol(sc->code, sc->increment_sz_symbol);
- set_opt_pair2(sc->code, caddr(value));
- }
- }
+ /* this appears to give a slight savings over the SZ case */
+ pair_set_syntax_symbol(sc->code, sc->increment_sa_symbol);
+ annotate_arg(sc, cddr(value), sc->envir); /* this sets c_callee(arg) */
+ set_opt_pair2(sc->code, cddr(value));
}
else
{
- if ((is_null(cddddr(value))) &&
- (is_all_x_safe(sc, caddr(value))) &&
- (is_all_x_safe(sc, cadddr(value))))
+ if (is_optimized(caddr(value)))
{
- pair_set_syntax_symbol(sc->code, sc->increment_saa_symbol);
- annotate_arg(sc, cddr(value), sc->envir);
- annotate_arg(sc, cdddr(value), sc->envir);
- set_opt_pair2(sc->code, cddr(value));
+ pair_set_syntax_symbol(sc->code, sc->increment_sz_symbol);
+ set_opt_pair2(sc->code, caddr(value));
}
}
}
+ else
+ {
+ if ((is_null(cddddr(value))) &&
+ (is_all_x_safe(sc, caddr(value))) &&
+ (is_all_x_safe(sc, cadddr(value))))
+ {
+ pair_set_syntax_symbol(sc->code, sc->increment_saa_symbol);
+ annotate_arg(sc, cddr(value), sc->envir);
+ annotate_arg(sc, cdddr(value), sc->envir);
+ set_opt_pair2(sc->code, cddr(value));
+ }
+ }
}
}
}
@@ -63243,7 +63900,7 @@ static bool set_pair_p_3(s7_scheme *sc, s7_pointer obj, s7_pointer arg, s7_point
case T_C_OBJECT:
set_car(sc->t2_1, arg);
set_car(sc->t2_2, value);
- sc->value = (*(c_object_set(obj)))(sc, obj, sc->t2_1);
+ sc->value = (*(c_object_set(sc, obj)))(sc, obj, sc->t2_1);
break;
/* some of these are wasteful -- we know the object type! (list hash-table) */
@@ -63512,7 +64169,7 @@ static int32_t set_pair_ex(s7_scheme *sc)
val = find_symbol_checked(sc, val);
set_car(sc->t2_1, index);
set_car(sc->t2_2, val);
- sc->value = (*(c_object_set(cx)))(sc, cx, sc->t2_1);
+ sc->value = (*(c_object_set(sc, cx)))(sc, cx, sc->t2_1);
return(goto_START);
}
push_op_stack(sc, sc->object_set_function);
@@ -64202,6 +64859,7 @@ static bool do_is_safe(s7_scheme *sc, s7_pointer body, s7_pointer steppers, s7_p
case OP_CASE:
{
s7_pointer cp;
+ if (!is_pair(cdr(expr))) return(false);
if (!do_is_safe(sc, cadr(expr), steppers, var_list, has_set))
return(false);
for (cp = cddr(expr); is_pair(cp); cp = cdr(cp))
@@ -64241,6 +64899,12 @@ static bool do_is_safe(s7_scheme *sc, s7_pointer body, s7_pointer steppers, s7_p
/* (hash-table-set! ht i 0) -- caddr is being saved, so this is not safe
* similarly (vector-set! v 0 i) etc
*/
+ if (is_null(cdr(expr))) /* (vector) for example */
+ {
+ return((x == sc->vector_symbol) ||
+ (x == sc->list_symbol) ||
+ (x == sc->string_symbol));
+ }
if (!direct_memq(cadr(expr), var_list)) /* non-local is being changed */
{
if ((direct_memq(cadr(expr), steppers)) || /* stepper is being set? */
@@ -64292,6 +64956,22 @@ static bool is_simple_expression(s7_scheme *sc, s7_pointer x)
(car(x) != sc->quote_symbol)));
}
+static bool tree_has_definers(s7_scheme *sc, s7_pointer tree)
+{
+ clear_symbol_list(sc);
+ add_symbol_to_list(sc, sc->define_symbol);
+ add_symbol_to_list(sc, sc->define_macro_symbol);
+ add_symbol_to_list(sc, sc->define_bacro_symbol);
+ add_symbol_to_list(sc, sc->define_star_symbol);
+ add_symbol_to_list(sc, sc->define_macro_star_symbol);
+ add_symbol_to_list(sc, sc->define_bacro_star_symbol);
+ add_symbol_to_list(sc, sc->define_expansion_symbol);
+ add_symbol_to_list(sc, sc->define_constant_symbol);
+ add_symbol_to_list(sc, sc->varlet_symbol);
+ add_symbol_to_list(sc, sc->provide_symbol); /* local *features*! */
+ return(tree_set_memq(sc, tree));
+}
+
static s7_pointer check_do(s7_scheme *sc)
{
s7_pointer x;
@@ -64326,13 +65006,16 @@ static s7_pointer check_do(s7_scheme *sc)
if (is_pair(cdr(y)))
{
- if ((!is_pair(cddr(y))) &&
- (is_not_null(cddr(y)))) /* (do ((i 0 . 1)) ...) */
- eval_error(sc, "do: step variable info is an improper list?: ~A", x);
-
- if ((is_pair(cddr(y))) &&
- (is_not_null(cdddr(y)))) /* (do ((i 0 1 (+ i 1))) ...) */
- eval_error(sc, "do: step variable info has extra stuff after the increment: ~A", x);
+ if (!is_pair(cddr(y)))
+ {
+ if (is_not_null(cddr(y))) /* (do ((i 0 . 1)) ...) */
+ eval_error(sc, "do: step variable info is an improper list?: ~A", x);
+ }
+ else
+ {
+ if (is_not_null(cdddr(y))) /* (do ((i 0 1 (+ i 1))) ...) */
+ eval_error(sc, "do: step variable info has extra stuff after the increment: ~A", x);
+ }
}
else eval_error(sc, "do: step variable has no initial value: ~A", x);
set_local(car(y));
@@ -64369,7 +65052,7 @@ static s7_pointer check_do(s7_scheme *sc)
return(sc->code);
if (is_simple_expression(sc, car(end)))
set_x_call(end, all_x_eval(sc, end, sc->envir, let_symbol_is_safe));
- else return(sc->code); /* if end is not a" PRIx64 "able, give up */
+ else return(sc->code); /* if end is not allxable, give up */
vars = car(sc->code);
if (is_null(vars))
@@ -64380,17 +65063,12 @@ static s7_pointer check_do(s7_scheme *sc)
/* an annoying kludge -- define in the body can clobber the step expressions set up below!
* (let ((x 2)) (do ((i 0 (+ i x))) ((= i 4)) (define x 1) (display i)) (newline)) -- steps by 1
- * perhaps add a frame at the body so defines can't leak into the steppers?
- * or add a check at define -- if optimized do let interpose a let?
- * walking the tree here is expensive, and no one ever actually does this, so I'll wait.
*/
body = cddr(sc->code);
- if ((is_pair(body)) &&
- (is_pair(car(body))) &&
- (caar(body) == sc->define_symbol))
+ if (tree_has_definers(sc, body))
return(sc->code);
- /* TODO: set up init/step a" PRIx64 " choices */
+ /* TODO: set up init/step choices */
for (nvars = 0, p = vars; is_pair(p); nvars++, p = cdr(p))
if (is_pair(cddar(p)))
{
@@ -64437,14 +65115,13 @@ static s7_pointer check_do(s7_scheme *sc)
}
}
- /* inits all non-pair, or all a" PRIx64 ", or any */
- /* steppers a" PRIx64 ", +1 -1 cdr */
+ /* inits all non-pair, or all allx, or any */
+ /* steppers allx, +1 -1 cdr */
}
#endif
-
/* 1/1 is of course the biggy -- can 1/n share its code? */
- /* need to start: do_op_1step_no_opt[_1] = set up frame goto check end, then push _1, set code, goto begin1, step via a" PRIx64 "
+ /* need to start: do_op_1step_no_opt[_1] = set up frame goto check end, then push _1, set code, goto begin1, step via allx
* :set frame non-steppers, then stepper at front, goto CHECK
* _1: step, CHECK: check end, push, code=, go begin1
*
@@ -64452,13 +65129,12 @@ static s7_pointer check_do(s7_scheme *sc)
* all the safe-stepper mutable ints and so on
*/
- /* are inits a" PRIx64 "able, are steppers a" PRIx64 "able, +/- by 1 by int, cdr, are there shadowing problems
+ /* are inits allxable, are steppers allxable, +/- by 1 by int, cdr, are there shadowing problems
* (=|>= end lim) where end is stepper or (null? stp)
* is body safe, 1 expr
* return null or constant or 1-expr
*/
-
/* -------------------------------------------------------------------------------- */
/* old version from here */
@@ -64478,7 +65154,9 @@ static s7_pointer check_do(s7_scheme *sc)
*/
s7_pointer v;
v = car(vars);
- if ((safe_list_length(sc, v) == 3) &&
+ if ((is_pair(car(body))) &&
+ (is_symbol(caar(body))) &&
+ (safe_list_length(sc, v) == 3) &&
((!is_pair(cadr(v))) ||
(is_h_safe_c_c(cadr(v)))))
{
@@ -64487,7 +65165,9 @@ static s7_pointer check_do(s7_scheme *sc)
if ((is_optimized(step_expr)) &&
(((optimize_op(step_expr) == HOP_SAFE_C_SC) && (car(v) == cadr(step_expr))) ||
- ((is_h_safe_c_c(step_expr)) && (car(v) == cadr(step_expr)) &&
+ ((is_h_safe_c_c(step_expr)) &&
+ (is_pair(cdr(step_expr))) && /* ((v 0 (+))) */
+ (car(v) == cadr(step_expr)) &&
((opt_cfunc(step_expr) == add_cs1) || (opt_cfunc(step_expr) == add_cl1) ||
(opt_cfunc(step_expr) == subtract_cs1) || (opt_cfunc(step_expr) == subtract_cl1))) ||
((optimize_op(step_expr) == HOP_SAFE_C_CS) && (car(v) == caddr(step_expr)))))
@@ -64498,6 +65178,7 @@ static s7_pointer check_do(s7_scheme *sc)
if ((is_optimized(end)) &&
(car(v) == cadr(end)) &&
+ (is_pair(cddr(end))) && /* end: (zero? n) */
(cadr(end) != caddr(end)) &&
#if (!WITH_GMP)
((opt_any1(end) == equal_s_ic) ||
@@ -64532,6 +65213,7 @@ static s7_pointer check_do(s7_scheme *sc)
set_optimize_op(end, HOP_SAFE_C_SC);
}
#endif
+
pair_set_syntax_symbol(sc->code, sc->simple_do_symbol); /* simple_do: 1 var easy step/end */
if ((one_line) &&
@@ -64635,7 +65317,7 @@ static s7_pointer check_do(s7_scheme *sc)
clear_match_symbol(caar(p));
/* end and steps look ok! */
- pair_set_syntax_symbol(sc->code, sc->dox_symbol); /* dox: vars/end are a" PRIx64 "able */
+ pair_set_syntax_symbol(sc->code, sc->dox_symbol); /* dox: vars/end are allxable */
/* each step expr is safe so not an explicit set!
* the symbol_is_safe check in all_x_eval needs to see the do envir, not the caller's
@@ -64722,28 +65404,39 @@ static bool has_safe_steppers(s7_scheme *sc, s7_pointer frame)
s7_pointer step_expr, val;
val = slot_value(slot);
step_expr = slot_expression(slot);
- if ((!is_pair(step_expr)) ||
- (is_safe_stepper(step_expr)))
+
+ if (!is_pair(step_expr))
{
- if (is_t_integer(val)) /* a temporary kludge */
- {
- sc->pc = 0;
- if (int_optimize(sc, step_expr))
- set_safe_stepper(slot);
- else clear_safe_stepper(slot);
- }
- else
+ if ((is_null(step_expr)) ||
+ (type(step_expr) == type(val)))
+ set_safe_stepper(slot);
+ else clear_safe_stepper(slot);
+ }
+ else
+ {
+ if (is_safe_stepper(step_expr))
{
- if (is_real(val)) /* a temporary kludge */
+ if (is_t_integer(val)) /* a temporary kludge */
{
sc->pc = 0;
- if (float_optimize(sc, step_expr))
+ if (int_optimize(sc, step_expr))
set_safe_stepper(slot);
else clear_safe_stepper(slot);
- }
- else set_safe_stepper(slot);
+ }
+ else
+ {
+ if (is_real(val)) /* a temporary kludge */
+ {
+ sc->pc = 0;
+ if (float_optimize(sc, step_expr))
+ set_safe_stepper(slot);
+ else clear_safe_stepper(slot);
+ }
+ else set_safe_stepper(slot); /* ?? shouldn't this check types ?? */
+ }
}
}
+
if (!is_safe_stepper(slot))
return(false);
}
@@ -64769,7 +65462,7 @@ static int32_t dox_ex(s7_scheme *sc)
*/
if (!pair_no_opt(sc->code))
{
- endf = s7_optimize(sc, cons(sc, cons(sc, sc->do_symbol, sc->code), sc->nil));
+ endf = s7_optimize(sc, cons_unchecked(sc, cons(sc, sc->do_symbol, sc->code), sc->nil));
if (endf)
{
sc->value = endf(sc, sc->code);
@@ -65001,11 +65694,11 @@ static int32_t dox_ex(s7_scheme *sc)
push_stack_no_args(sc, OP_DOX_STEP_P, sc->code);
if (typesflag(code) == SYNTACTIC_PAIR)
- sc->op = (opcode_t)pair_syntax_op(code);
+ sc->cur_op = (opcode_t)pair_syntax_op(code);
else
{
- sc->op = (opcode_t)symbol_syntax_op(car(code));
- pair_set_syntax_op(code, sc->op);
+ sc->cur_op = (opcode_t)symbol_syntax_op(car(code));
+ pair_set_syntax_op(code, sc->cur_op);
set_syntactic_pair(code);
}
sc->code = cdr(code);
@@ -65025,9 +65718,14 @@ static int32_t simple_do_ex(s7_scheme *sc, s7_pointer code)
/* fprintf(stderr, "%s: %s\n", __func__, DISPLAY_80(opt_pair2(code))); */
body = car(opt_pair2(code));
+
+#if DEBUGGING
if (!is_symbol(car(body)))
- return(fall_through);
- /* TODO: check_do for this */
+ {
+ fprintf(stderr, "simple_do_ex car(body) not symbol: %s\n", DISPLAY_80(code));
+ return(fall_through);
+ }
+#endif
if (!pair_no_opt(opt_pair2(code)))
{
@@ -65423,7 +66121,7 @@ static int32_t do_let(s7_scheme *sc, s7_pointer step_slot, s7_pointer scc, bool
}
sc->envir = old_e;
sc->value = sc->T;
- sc->code = cdr(cadr(scc));
+ sc->code = cdadr(scc);
return(goto_SAFE_DO_END_CLAUSES);
}
sc->envir = old_e;
@@ -65497,14 +66195,14 @@ static int32_t safe_dotimes_ex(s7_scheme *sc)
{
numerator(slot_value(sc->args)) = s7_integer(end_val);
sc->value = sc->T;
- sc->code = cdr(cadr(code));
+ sc->code = cdadr(code);
return(goto_SAFE_DO_END_CLAUSES);
}
if (s7_integer(init_val) == s7_integer(end_val))
{
sc->value = sc->T;
- sc->code = cdr(cadr(code));
+ sc->code = cdadr(code);
return(goto_SAFE_DO_END_CLAUSES);
}
@@ -65525,11 +66223,11 @@ static int32_t safe_dotimes_ex(s7_scheme *sc)
}
push_stack(sc, OP_SAFE_DOTIMES_STEP_P, sc->args, code);
if (typesflag(sc->code) == SYNTACTIC_PAIR)
- sc->op = (opcode_t)pair_syntax_op(sc->code);
+ sc->cur_op = (opcode_t)pair_syntax_op(sc->code);
else
{
- sc->op = (opcode_t)symbol_syntax_op(car(sc->code));
- pair_set_syntax_op(sc->code, sc->op);
+ sc->cur_op = (opcode_t)symbol_syntax_op(car(sc->code));
+ pair_set_syntax_op(sc->code, sc->cur_op);
set_syntactic_pair(sc->code);
}
sc->code = cdr(sc->code);
@@ -65589,7 +66287,7 @@ static int32_t safe_do_ex(s7_scheme *sc)
init_val = c_call(init_val)(sc, cdr(init_val));
}
- end = caddr(car(cadr(code)));
+ end = caddr(caadr(code));
if (is_symbol(end))
end_val = find_symbol_checked(sc, end);
else end_val = end;
@@ -65606,10 +66304,10 @@ static int32_t safe_do_ex(s7_scheme *sc)
if ((s7_integer(init_val) == s7_integer(end_val)) ||
((s7_integer(init_val) > s7_integer(end_val)) &&
- (opt_cfunc(car(cadr(code))) == geq_2)))
+ (opt_cfunc(caadr(code)) == geq_2)))
{
sc->value = sc->T;
- sc->code = cdr(cadr(code));
+ sc->code = cdadr(code);
return(goto_SAFE_DO_END_CLAUSES);
}
@@ -65875,10 +66573,8 @@ static int32_t unknown_ex(s7_scheme *sc, s7_pointer f)
{
if (is_safe_closure(f))
{
- int32_t outer_hop;
s7_pointer body;
body = closure_body(f);
- outer_hop = (is_local_symbol(code)) ? 2 : 0;
set_optimize_op(code, hop + OP_SAFE_THUNK);
if (is_null(cdr(body)))
{
@@ -65889,7 +66585,7 @@ static int32_t unknown_ex(s7_scheme *sc, s7_pointer f)
if ((is_pair(car(body))) &&
(is_syntactic_symbol(caar(body))))
{
- set_optimize_op(code, hop + outer_hop + OP_SAFE_THUNK_P);
+ set_optimize_op(code, hop + ((is_local_symbol(code)) ? OP_SAFE_LTHUNK_P : OP_SAFE_THUNK_P));
if (typesflag(car(body)) != SYNTACTIC_PAIR)
{
pair_set_syntax_op(car(body), symbol_syntax_op(caar(body)));
@@ -65963,7 +66659,6 @@ static int32_t unknown_g_ex(s7_scheme *sc, s7_pointer f)
break;
case T_CLOSURE:
- /* fprintf(stderr, "unknown_g_ex: %s: %s %d %s\n", DISPLAY(code), DISPLAY(f), is_safe_closure(f), opt_names[optimize_op(code)]); */
if ((!has_methods(f)) &&
(closure_arity_to_int(sc, f) == 1))
{
@@ -65980,9 +66675,7 @@ static int32_t unknown_g_ex(s7_scheme *sc, s7_pointer f)
(is_pair(car(body))) &&
(is_syntactic_symbol(caar(body))))
{
- int32_t outer_hop;
- outer_hop = ((is_local_symbol(code)) && (is_local_symbol(cdr(code)))) ? 2 : 0;
- set_optimize_op(code, hop + outer_hop + OP_SAFE_CLOSURE_S_P);
+ set_optimize_op(code, hop + (((is_local_symbol(code)) && (is_local_symbol(cdr(code)))) ? OP_SAFE_LCLOSURE_L_P : OP_SAFE_CLOSURE_S_P));
if (typesflag(car(body)) != SYNTACTIC_PAIR)
{
pair_set_syntax_op(car(body), symbol_syntax_op(caar(body)));
@@ -66115,8 +66808,29 @@ static int32_t unknown_gg_ex(s7_scheme *sc, s7_pointer f)
if (s1)
{
if (is_safe_closure(f))
- set_optimize_op(code, hop + ((s2) ? OP_SAFE_CLOSURE_SS : OP_SAFE_CLOSURE_SC));
- else set_optimize_op(code, hop + ((s2) ? ((is_null(cdr(closure_body(f)))) ? OP_CLOSURE_SS_P : OP_CLOSURE_SS) : OP_CLOSURE_SC));
+ set_optimize_op(code, hop + ((s2) ? ((is_null(cdr(closure_body(f)))) ? OP_SAFE_CLOSURE_SS : OP_SAFE_CLOSURE_SS_B) : OP_SAFE_CLOSURE_SC));
+ else
+ {
+ if (!s2)
+ set_optimize_op(code, hop + OP_CLOSURE_SC);
+ else
+ {
+ s7_pointer body;
+ body = closure_body(f);
+ if ((is_null(cdr(body))) &&
+ (is_pair(car(body))) &&
+ (is_syntactic(caar(body))))
+ {
+ set_optimize_op(code, hop + OP_CLOSURE_SS_P);
+ if (typesflag(car(body)) != SYNTACTIC_PAIR)
+ {
+ pair_set_syntax_op(car(body), symbol_syntax_op(caar(body)));
+ set_syntactic_pair(car(body));
+ }
+ }
+ else set_optimize_op(code, hop + OP_CLOSURE_SS);
+ }
+ }
}
else
{
@@ -66166,8 +66880,8 @@ static int32_t unknown_all_s_ex(s7_scheme *sc, s7_pointer f)
{
case T_C_FUNCTION:
case T_C_RST_ARGS_FUNCTION:
- if (((int)c_function_required_args(f) > num_args) ||
- ((int)c_function_all_args(f) < num_args))
+ if (((int32_t)c_function_required_args(f) > num_args) ||
+ ((int32_t)c_function_all_args(f) < num_args))
break;
case T_C_OPT_ARGS_FUNCTION:
@@ -66249,7 +66963,8 @@ static int32_t unknown_a_ex(s7_scheme *sc, s7_pointer f)
(closure_arity_to_int(sc, f) == 1))
{
if (is_safe_closure(f))
- set_optimize_op(code, hop + (OP_SAFE_CLOSURE_A + ((is_local_symbol(code)) ? ((is_null(cdr(closure_body(f)))) ? 4 : 2) : 0)));
+ set_optimize_op(code, hop + (((is_local_symbol(code)) ?
+ ((is_null(cdr(closure_body(f)))) ? OP_SAFE_LCLOSURE_A_P : OP_SAFE_LCLOSURE_A) : OP_SAFE_CLOSURE_A)));
else
{
set_optimize_op(code, hop + OP_CLOSURE_A);
@@ -66363,25 +67078,12 @@ static int32_t unknown_all_x_ex(s7_scheme *sc, s7_pointer f)
hop = (is_immutable_symbol(car(code))) ? 1 : 0;
num_args = integer(arglist_length(code));
-#if DEBUGGING && 0
- {
- s7_pointer p;
- int32_t i;
- for (i = 1, p = cdr(code); is_pair(p); i++, p = cdr(p))
- if (!has_all_x(p))
- {
- fprintf(stderr, "oops_all_x%d: %s %s\n", i, DISPLAY_80(code), opt_names[optimize_op(code)]);
- /* abort(); */
- }
- }
-#endif
-
switch (type(f))
{
case T_C_FUNCTION:
case T_C_RST_ARGS_FUNCTION:
- if (((int)c_function_required_args(f) > num_args) ||
- ((int)c_function_all_args(f) < num_args))
+ if (((int32_t)c_function_required_args(f) > num_args) ||
+ ((int32_t)c_function_all_args(f) < num_args))
break;
case T_C_OPT_ARGS_FUNCTION:
@@ -66524,7 +67226,7 @@ static int32_t read_s_ex(s7_scheme *sc)
else
{
push_input_port(sc, port);
- push_stack(sc, OP_READ_DONE, sc->nil, sc->nil); /* this stops the internal read process so we only get one form */
+ push_stack_op(sc, OP_READ_DONE); /* this stops the internal read process so we only get one form */
sc->tok = token(sc);
switch (sc->tok)
{
@@ -66555,12 +67257,12 @@ static void eval_string_1_ex(s7_scheme *sc)
if (c != 0)
{
backchar(c, sc->input_port);
- push_stack(sc, OP_EVAL_STRING_1, sc->nil, sc->value);
- push_stack(sc, OP_READ_INTERNAL, sc->nil, sc->nil);
+ push_stack_no_args(sc, OP_EVAL_STRING_1, sc->value);
+ push_stack_op_let(sc, OP_READ_INTERNAL);
}
- else push_stack(sc, OP_EVAL_STRING_2, sc->nil, sc->nil);
+ else push_stack_op_let(sc, OP_EVAL_STRING_2);
}
- else push_stack(sc, OP_EVAL_STRING_2, sc->nil, sc->nil);
+ else push_stack_op_let(sc, OP_EVAL_STRING_2);
sc->code = sc->value;
}
@@ -66795,19 +67497,21 @@ static void apply_c_macro(s7_scheme *sc) /* -------- C-bas
{
int32_t len;
/* fprintf(stderr, "apply_c_macro: args: %s %s\n", DISPLAY(sc->args), type_name(sc, car(sc->args), NO_ARTICLE)); */
- len = s7_list_length(sc, sc->args);
+ len = safe_list_length(sc, sc->args);
- if (len < (int)c_macro_required_args(sc->code))
+ if (len < (int32_t)c_macro_required_args(sc->code))
s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->not_enough_arguments_string, sc->code, sc->args));
- if ((int)c_macro_all_args(sc->code) < len)
+ if ((int32_t)c_macro_all_args(sc->code) < len)
s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, sc->code, sc->args));
/* fprintf(stderr, "code: %s, args: %s\n", DISPLAY(sc->code), DISPLAY(sc->args)); */
sc->code = c_macro_call(sc->code)(sc, sc->args);
- /* fprintf(stderr, " code: %s\n", DISPLAY(sc->code)); */
if (is_multiple_value(sc->code)) /* can this happen? s7_values splices before returning, and `(values ...) is handled later */
{
+#if DEBUGGING
+ fprintf(stderr, "%d unexpected mv code: %s\n", __LINE__, DISPLAY(sc->code));
+#endif
push_stack(sc, OP_EVAL_MACRO_MV, sc->nil, cdr(sc->code));
sc->code = car(sc->code);
}
@@ -66815,7 +67519,7 @@ static void apply_c_macro(s7_scheme *sc) /* -------- C-bas
static void apply_syntax(s7_scheme *sc) /* -------- syntactic keyword as applicable object -------- */
{ /* current reader-cond macro uses this via (map quote ...) */
- int32_t len; /* ((apply lambda '((x) (+ x 1))) 4) */
+ int32_t len; /* ((apply lambda '((x) (+ x 1))) 4) */
if (is_pair(sc->args))
{
len = s7_list_length(sc, sc->args);
@@ -66830,7 +67534,7 @@ static void apply_syntax(s7_scheme *sc) /* -------- s
(syntax_max_args(sc->code) != -1))
s7_error(sc, sc->wrong_number_of_args_symbol, set_elist_3(sc, sc->too_many_arguments_string, sc->code, sc->args));
- sc->op = (opcode_t)syntax_opcode(sc->code); /* (apply begin '((define x 3) (+ x 2))) */
+ sc->cur_op = (opcode_t)syntax_opcode(sc->code); /* (apply begin '((define x 3) (+ x 2))) */
/* I used to have elaborate checks here for embedded circular lists, but now i think that is the caller's problem */
sc->code = sc->args;
}
@@ -66857,7 +67561,8 @@ static void apply_vector(s7_scheme *sc) /* -------- v
static void apply_string(s7_scheme *sc) /* -------- string as applicable object -------- */
{
- if (is_null(cdr(sc->args)))
+ if ((is_pair(sc->args)) &&
+ (is_null(cdr(sc->args))))
{
if (s7_is_integer(car(sc->args)))
{
@@ -66916,9 +67621,12 @@ static void apply_let(s7_scheme *sc) /* -------- e
{
if (is_null(sc->args))
sc->value = s7_let_ref(sc, sc->code, sc->F); /* why #f and not ()? both are ok in s7test */
- else sc->value = s7_let_ref(sc, sc->code, car(sc->args));
- if (is_pair(cdr(sc->args)))
- sc->value = implicit_index(sc, sc->value, cdr(sc->args));
+ else
+ {
+ sc->value = s7_let_ref(sc, sc->code, car(sc->args));
+ if (is_pair(cdr(sc->args)))
+ sc->value = implicit_index(sc, sc->value, cdr(sc->args));
+ }
/* (let ((v #(1 2 3))) (let ((e (curlet))) ((e 'v) 1))) -> 2
* so (let ((v #(1 2 3))) (let ((e (curlet))) (e 'v 1))) -> 2
*/
@@ -67295,7 +68003,7 @@ static inline void apply_continuation(s7_scheme *sc) /* -------- c
static void apply_c_object(s7_scheme *sc) /* -------- applicable (new-type) object -------- */
{
- sc->value = (*(c_object_ref(sc->code)))(sc, sc->code, sc->args);
+ sc->value = (*(c_object_ref(sc, sc->code)))(sc, sc->code, sc->args);
}
@@ -67328,10 +68036,16 @@ static int32_t define1_ex(s7_scheme *sc)
if (is_slot(global_slot(sc->code)))
x = global_slot(sc->code);
- else x = local_slot(sc->code); /* added 18-May-17 */
- if ((!is_slot(x)) ||
- (type(sc->value) != unchecked_type(slot_value(x))) ||
- (!s7_is_morally_equal(sc, sc->value, slot_value(x)))) /* if value is unchanged, just ignore this (re)definition */
+ else x = find_symbol(sc, sc->code); /* local_slot can be free even if sc->code is immutable (local constant now defunct) */
+ if (!is_slot(x))
+ {
+ if ((is_slot(local_slot(sc->code))) &&
+ (type(sc->value) == unchecked_type(slot_value(local_slot(sc->code)))))
+ x = local_slot(sc->code);
+ }
+ if (!((is_slot(x)) &&
+ (type(sc->value) == unchecked_type(slot_value(x))) &&
+ (s7_is_morally_equal(sc, sc->value, slot_value(x))))) /* if value is unchanged, just ignore this (re)definition */
eval_error_no_return(sc, sc->syntax_error_symbol, "define: ~S is immutable", sc->code); /* can't use s7_is_equal because value might be NaN, etc */
}
if (symbol_has_accessor(sc->code))
@@ -67441,13 +68155,24 @@ static void profile(s7_scheme *sc, s7_pointer expr)
if (val == sc->F)
{
bool old_short_print;
+ s7_pointer env;
+ int32_t tx1, tx2;
+
old_short_print = sc->short_print;
sc->short_print = true;
- s7_hash_table_set(sc, sc->profile_info, key,
- cons(sc,
- make_mutable_integer(sc, 1),
- g_object_to_string(sc, set_plist_3(sc, expr, sc->T, small_int(120)))));
+ env = find_closure_let(sc, sc->envir);
+
+ tx1 = next_tx(sc);
+ tx2 = next_tx(sc);
+ sc->t_temps[tx1] = g_object_to_string(sc, set_plist_3(sc, expr, sc->T, small_int(120)));
+ sc->t_temps[tx2] = (is_let(env)) ? g_object_to_string(sc, set_plist_1(sc, funclet_function(env))) : sc->nil;
+
+ s7_hash_table_set(sc, sc->profile_info, key,
+ cons(sc, make_mutable_integer(sc, 1),
+ cons(sc, sc->t_temps[tx1], sc->t_temps[tx2])));
+ sc->t_temps[tx1] = sc->nil;
+ sc->t_temps[tx2] = sc->nil;
sc->short_print = old_short_print;
}
/* can't save the actual expr here -- it can be stepped on */
@@ -67511,22 +68236,9 @@ static s7_pointer check_for_cyclic_code(s7_scheme *sc, s7_pointer code)
static s7_pointer profile_at_start = NULL;
#endif
-#if DEBUGGING
-#define overwrite_check(Val, Code) \
- do { \
- push_stack(sc, OP_NO_OP, Val, sc->code); \
- Code; \
- pop_stack(sc); \
- if (Val != sc->args) fprintf(stderr, "%d: aa trouble: %s %s\n", __LINE__, DISPLAY(sc->args), DISPLAY(Val)); \
- } while (0)
-#else
-#define overwrite_check(Val, Code) Code
-#endif
-
-
static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
{
- sc->op = first_op;
+ sc->cur_op = first_op;
/* this procedure can be entered recursively (via s7_call for example), so it's no place for a setjmp
* I don't think the recursion can hurt our continuations because s7_call is coming from hooks and
@@ -67540,26 +68252,15 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
START:
pop_stack(sc);
- /* syntax_opcode can be optimize_op, the field can be set at read time, we could
- * probably combine the optimized and normal case statements, jump here if eval (eval_pair, opt_eval),
- * and thereby save the is_syntactic and is_pair check in op_eval, op_begin would explicitly jump back here, no op_eval,
- * current trailers would be outside? and where would eval args go? Huge change, might save 1% if lucky.
- * see end of file -- I think this is too pessimistic and given rearrangement of the s7_cell layout,
- * can be done without an increase in size.
- *
- * about half the cases don't care about args or op, but it's not simple to distribute the sc->args
- * setting throughout this switch statement. Lots of branches fall through to the next and there
- * are many internal goto's to branches, so the code becomes a mess. sc->op is even worse because
- * we use it in several cases for error information or choice of next op, etc.
- */
-
START_WITHOUT_POP_STACK:
- /* fprintf(stderr, "%s (%d) %s\n", op_names[sc->op], (int)(sc->op), DISPLAY_80(sc->code)); */
+ /* fprintf(stderr, "%s (%d) %s\n", op_names[sc->cur_op], (int)(sc->cur_op), DISPLAY_80(sc->code)); */
+
#if WITH_PROFILE
profile_at_start = sc->code;
profile(sc, sc->code);
#endif
- switch (sc->op)
+
+ switch (sc->cur_op)
{
case OP_NO_OP:
case OP_GC_PROTECT:
@@ -67590,7 +68291,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
/* (eval-string "'a ; b") gets here with 'a -> a, so we need to squelch the pending eval.
* another approach would read-ahead in eval_string_1_ex, but this seems less messy.
*/
- int32_t top;
+ int64_t top;
top = s7_stack_top(sc) - 1;
if (stack_op(sc->stack, top) == OP_EVAL_STRING_1)
vector_element(sc->stack, top) = (s7_pointer)OP_EVAL_STRING_2;
@@ -67630,8 +68331,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_LOAD_RETURN_IF_EOF: /* loop here until eof (via push stack below) */
if (sc->tok != TOKEN_EOF)
{
- push_stack(sc, OP_LOAD_RETURN_IF_EOF, sc->nil, sc->nil);
- push_stack(sc, OP_READ_INTERNAL, sc->nil, sc->nil);
+ push_stack_op_let(sc, OP_LOAD_RETURN_IF_EOF);
+ push_stack_op_let(sc, OP_READ_INTERNAL);
sc->code = sc->value;
goto EVAL; /* we read an expression, now evaluate it, and return to read the next */
}
@@ -67645,11 +68346,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_LOAD_CLOSE_AND_POP_IF_EOF:
if (sc->tok != TOKEN_EOF)
{
- push_stack(sc, OP_LOAD_CLOSE_AND_POP_IF_EOF, sc->nil, sc->nil); /* was push args, code */
+ push_stack_op_let(sc, OP_LOAD_CLOSE_AND_POP_IF_EOF); /* was push args, code */
if ((!is_string_port(sc->input_port)) ||
(port_position(sc->input_port) < port_data_size(sc->input_port)))
{
- push_stack(sc, OP_READ_INTERNAL, sc->nil, sc->nil);
+ push_stack_op_let(sc, OP_READ_INTERNAL);
}
else sc->tok = TOKEN_EOF;
sc->code = sc->value;
@@ -67911,6 +68612,60 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto APPLY;
}
+ case OP_MAP_GATHER_2:
+ case OP_MAP_GATHER_3:
+ if (sc->value != sc->no_value)
+ {
+ if (is_multiple_value(sc->value))
+ counter_set_result(sc->args, revappend(sc, multiple_value(sc->value), counter_result(sc->args)));
+ else counter_set_result(sc->args, cons(sc, sc->value, counter_result(sc->args)));
+ }
+ case OP_MAP_2:
+ {
+ s7_pointer x, c, p, code;
+ code = sc->code;
+ c = sc->args;
+ p = counter_list(c);
+ if (!is_pair(p))
+ {
+ sc->value = safe_reverse_in_place(sc, counter_result(c));
+ free_cell(sc, sc->args);
+ sc->args = sc->nil;
+ goto START;
+ }
+ x = car(p);
+ counter_set_list(c, cdr(p));
+
+ if (sc->cur_op == OP_MAP_GATHER_3)
+ {
+ closure_set_setter(code, cdr(closure_setter(code)));
+ /* this depends on code (the function) being non-recursive, else closure_setter gets stepped on */
+ if (closure_setter(code) == counter_list(c))
+ {
+ sc->value = safe_reverse_in_place(sc, counter_result(c));
+ free_cell(sc, c);
+ sc->args = sc->nil;
+ goto START;
+ }
+ push_stack(sc, OP_MAP_GATHER_2, c, code);
+ }
+ else push_stack(sc, OP_MAP_GATHER_3, c, code);
+
+ if (counter_capture(c) != sc->capture_let_counter)
+ {
+ new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), x);
+ counter_set_let(c, sc->envir);
+ counter_set_slots(c, let_slots(sc->envir));
+ counter_set_capture(c, sc->capture_let_counter);
+ }
+ else
+ {
+ let_set_slots(counter_let(c), counter_slots(c));
+ sc->envir = old_frame_with_slot(sc, counter_let(c), x);
+ }
+ sc->code = car(closure_body(code));
+ goto EVAL;
+ }
/* -------------------------------- FOR-EACH -------------------------------- */
case OP_FOR_EACH:
@@ -67918,7 +68673,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
s7_pointer x, y, iterators, saved_args;
iterators = car(sc->args);
saved_args = cdr(sc->args);
- /* fprintf(stderr, "op_for_each: %s %s\n", DISPLAY(iterators), DISPLAY(saved_args)); */
for (x = saved_args, y = iterators; is_pair(x); x = cdr(x), y = cdr(y))
{
set_car(x, s7_iterate(sc, car(y)));
@@ -67930,12 +68684,10 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
}
- /* fprintf(stderr, "push %s %s\n", DISPLAY(sc->args), DISPLAY(sc->code)); */
push_stack(sc, OP_FOR_EACH, sc->args, sc->code);
sc->args = saved_args;
if (needs_copied_args(sc->code))
sc->args = copy_list(sc, sc->args);
- /* fprintf(stderr, "goto apply: %s %s\n", DISPLAY(sc->code), DISPLAY(sc->args)); */
goto APPLY;
}
@@ -67994,7 +68746,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
code = _TClo(sc->code);
arg = car(lst);
counter_set_list(c, cdr(lst));
- if (sc->op == OP_FOR_EACH_3)
+ if (sc->cur_op == OP_FOR_EACH_3)
{
counter_set_result(c, cdr(counter_result(c)));
if (counter_result(c) == counter_list(c))
@@ -68041,7 +68793,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
set_opt_fast(sc->args, cdr(opt_fast(sc->args))); /* cdr down arg list */
- if (sc->op == OP_MEMBER_IF1)
+ if (sc->cur_op == OP_MEMBER_IF1)
{
/* circular list check */
if (opt_fast(sc->args) == opt_slow(sc->args))
@@ -68078,7 +68830,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
set_opt_fast(sc->args, cdr(opt_fast(sc->args))); /* cdr down arg list */
- if (sc->op == OP_ASSOC_IF1)
+ if (sc->cur_op == OP_ASSOC_IF1)
{
/* circular list check */
if (opt_fast(sc->args) == opt_slow(sc->args))
@@ -68139,7 +68891,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
s7_pointer endp;
endf = c_call(end);
endp = car(end);
- while (!is_true(sc, sc->value = endf(sc, endp)));
+ while (!is_true(sc, sc->value = endf(sc, endp))); /* the assignment is (normally) in the noise */
sc->code = cdr(end);
goto DO_END_CLAUSES;
}
@@ -68171,7 +68923,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_DO_NO_VARS_NO_OPT_1:
do_all_x_end(cadr(sc->code));
push_stack_no_args(sc, OP_DO_NO_VARS_NO_OPT_1, sc->code);
- sc->code = cddr(sc->code);
+ sc->code = _TPair(cddr(sc->code));
goto BEGIN1;
@@ -68271,12 +69023,12 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (numerator(arg) == denominator(arg))
{
sc->value = sc->T;
- sc->code = cdr(cadr(sc->code));
+ sc->code = cdadr(sc->code);
goto DO_END_CLAUSES;
}
push_stack(sc, OP_SAFE_DOTIMES_STEP_P, sc->args, sc->code);
sc->code = opt_pair2(sc->code);
- sc->op = (opcode_t)pair_syntax_op(sc->code);
+ sc->cur_op = (opcode_t)pair_syntax_op(sc->code);
sc->code = cdr(sc->code);
goto START_WITHOUT_POP_STACK;
}
@@ -68289,7 +69041,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (numerator(arg) == denominator(arg))
{
sc->value = sc->T;
- sc->code = cdr(cadr(sc->code));
+ sc->code = cdadr(sc->code);
goto DO_END_CLAUSES;
}
push_stack(sc, OP_SAFE_DOTIMES_STEP_O, sc->args, sc->code);
@@ -68305,7 +69057,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (numerator(arg) == denominator(arg))
{
sc->value = sc->T;
- sc->code = cdr(cadr(sc->code));
+ sc->code = cdadr(sc->code);
goto DO_END_CLAUSES;
}
push_stack(sc, OP_SAFE_DOTIMES_STEP, sc->args, sc->code);
@@ -68366,7 +69118,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
* TODO: make this decision in check_do
*/
s7_pointer init, end, code;
- /* fprintf(stderr, "%d %s\n", __LINE__, DISPLAY(sc->code)); */
code = sc->code;
sc->envir = new_frame_in_env(sc, sc->envir);
@@ -68437,13 +69188,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->value = c_call(caadr(code))(sc, sc->t2_1);
if (is_true(sc, sc->value))
{
- sc->code = cdr(cadr(code));
+ sc->code = cdadr(code);
goto DO_END_CLAUSES;
}
- push_stack(sc, sc->op, sc->args, code);
+ push_stack(sc, OP_SIMPLE_DO_STEP, sc->args, code);
#if DEBUGGING
- if (sc->op != OP_SIMPLE_DO_STEP)
- fprintf(stderr, "simple_do_step: %s\n", op_names[sc->op]);
+ if (sc->cur_op != OP_SIMPLE_DO_STEP)
+ fprintf(stderr, "simple_do_step: %s\n", op_names[sc->cur_op]);
#endif
sc->code = _TPair(opt_pair2(code));
goto BEGIN1;
@@ -68513,7 +69264,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
push_stack(sc, OP_DOTIMES_STEP_P, sc->args, code);
code = caddr(code);
set_current_code(sc, code);
- sc->op = (opcode_t)pair_syntax_op(code);
+ sc->cur_op = (opcode_t)pair_syntax_op(code);
sc->code = cdr(code);
goto START_WITHOUT_POP_STACK;
}
@@ -68569,7 +69320,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
push_stack_no_args(sc, OP_DOX_STEP_P, sc->code);
sc->code = caddr(sc->code);
- sc->op = (opcode_t)pair_syntax_op(sc->code);
+ sc->cur_op = (opcode_t)pair_syntax_op(sc->code);
sc->code = cdr(sc->code);
goto START_WITHOUT_POP_STACK;
}
@@ -68671,7 +69422,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (op == sc->do_no_vars_symbol) goto DO_NO_VARS;
if (op == sc->dotimes_one_step_symbol) goto DOTIMES_ONE_STEP;
-
goto SIMPLE_DO;
}
@@ -68749,6 +69499,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
}
/* might be => here as in cond and case */
+ if (is_null(cdr(sc->code)))
+ {
+ sc->code = car(sc->code);
+ goto EVAL;
+ }
if ((car(sc->code) == sc->feed_to_symbol) &&
(s7_symbol_value(sc, sc->feed_to_symbol) == sc->undefined))
{
@@ -68758,7 +69513,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (res == goto_APPLY) goto APPLY;
goto EVAL;
}
- goto BEGIN1;
+ push_stack_no_args(sc, OP_BEGIN1, cdr(sc->code));
+ sc->code = car(sc->code);
+ goto EVAL;
}
goto DO_END2;
@@ -68804,20 +69561,15 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_BEGIN:
if (!s7_is_proper_list(sc, sc->code)) /* proper list includes () */
eval_error(sc, "unexpected dot? ~A", sc->code);
-
- if ((!is_null(sc->code)) && /* so check for it here */
- (!is_null(cdr(sc->code))) &&
- (is_overlaid(sc->code)) &&
- (has_opt_back(sc->code)))
- pair_set_syntax_symbol(sc->code, sc->begin_unchecked_symbol);
-
- case OP_BEGIN_UNCHECKED:
if (is_null(sc->code)) /* (begin) -> () */
{
sc->value = sc->nil;
goto START;
}
-
+ if ((is_overlaid(sc->code)) &&
+ (has_opt_back(sc->code)))
+ pair_set_syntax_symbol(sc->code, sc->begin1_symbol);
+
case OP_BEGIN1:
if ((sc->begin_hook) && (call_begin_hook(sc))) return(sc->F);
BEGIN1:
@@ -68829,19 +69581,20 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
EVAL:
case OP_EVAL:
+
/* main part of evaluation
* at this point, it's sc->code we care about; sc->args is not set yet.
*/
/* fprintf(stderr, " eval: %s\n", DISPLAY_80(sc->code)); */
- if (typesflag(sc->code) == SYNTACTIC_PAIR) /* xor is not faster here */
+ if (typesflag(sc->code) == SYNTACTIC_PAIR) /* xor is not faster here, and bit check is slower */
{
#if WITH_PROFILE
if (sc->code != profile_at_start)
profile(sc, sc->code);
#endif
set_current_code(sc, sc->code); /* in case an error occurs, this helps tell us where we are */
- sc->op = (opcode_t)pair_syntax_op(sc->code);
+ sc->cur_op = (opcode_t)pair_syntax_op(sc->code);
sc->code = cdr(sc->code);
goto START_WITHOUT_POP_STACK;
}
@@ -68895,9 +69648,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_AND2:
code = cdr(code);
- sc->value = c_call(code)(sc, car(code));
- if (is_false(sc, sc->value))
- goto START;
+ if (is_false(sc, c_call(code)(sc, car(code))))
+ {
+ sc->value = sc->F;
+ goto START;
+ }
code = cdr(code);
sc->value = c_call(code)(sc, car(code));
goto START;
@@ -69054,14 +69809,10 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_SAFE_C_SQ:
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_SQ:
- {
- s7_pointer args;
- args = cdr(code);
- set_car(sc->t2_1, find_symbol_unchecked(sc, car(args)));
- set_car(sc->t2_2, cadadr(args));
- sc->value = c_call(code)(sc, sc->t2_1);
- goto START;
- }
+ set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(code)));
+ set_car(sc->t2_2, opt_con1(cdr(code)));
+ sc->value = c_call(code)(sc, sc->t2_1);
+ goto START;
case OP_SAFE_C_QS:
if (!c_function_is_ok(sc, code)) break;
@@ -69118,21 +69869,21 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
*/
case HOP_SAFE_C_Z:
check_stack_size(sc);
- push_stack(sc, OP_SAFE_C_P_1, sc->nil, code);
+ push_stack_no_args(sc, OP_SAFE_C_P_1, code);
sc->code = _TPair(cadr(code));
goto OPT_EVAL_CHECKED;
case OP_SAFE_C_P:
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_P:
- push_stack(sc, OP_SAFE_C_P_1, sc->nil, code);
+ push_stack_no_args(sc, OP_SAFE_C_P_1, code);
sc->code = _TPair(cadr(code));
goto EVAL;
case OP_NOT_P:
if (!c_function_is_ok(sc, code)) break;
case HOP_NOT_P:
- push_stack(sc, OP_NOT_P_1, sc->nil, code);
+ push_stack_no_args(sc, OP_NOT_P_1, code);
sc->code = _TPair(cadr(code));
goto EVAL;
@@ -69146,7 +69897,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
* the reader protects us, but a call/cc can replace the original stack with a much smaller one.
* How to minimize the cost of this check?
*/
- push_stack(sc, OP_SAFE_C_SZ_1, cadr(code), code);
+ push_stack(sc, OP_EVAL_ARGS_P_2, cadr(code), code);
sc->code = _TPair(caddr(code));
goto OPT_EVAL_CHECKED;
@@ -69154,15 +69905,16 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_ZC:
check_stack_size(sc);
- push_stack(sc, OP_SAFE_C_ZC_1, caddr(code), code); /* need ZC_1 here in case multiple values encountered */
+ push_stack(sc, OP_EVAL_ARGS_P_4, caddr(code), code);
sc->code = _TPair(cadr(code));
goto OPT_EVAL_CHECKED;
case OP_SAFE_C_SZ:
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_SZ:
+ /* about 10% appear to be local symbols */
check_stack_size(sc);
- push_stack(sc, OP_SAFE_C_SZ_1, find_symbol_unchecked(sc, cadr(code)), code);
+ push_stack(sc, OP_EVAL_ARGS_P_2, find_symbol_unchecked(sc, cadr(code)), code);
sc->code = _TPair(caddr(code)); /* splitting out the all_x cases here and elsewhere saves nothing */
goto OPT_EVAL_CHECKED;
@@ -69170,7 +69922,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_ZS:
check_stack_size(sc);
- push_stack(sc, OP_EVAL_ARGS_P_3, sc->nil, code);
+ push_stack_no_args(sc, OP_EVAL_ARGS_P_3, code);
sc->code = _TPair(cadr(code));
goto OPT_EVAL_CHECKED;
@@ -69190,11 +69942,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_opAAq:
{
- s7_pointer arg;
+ s7_pointer arg, val;
arg = cadr(code);
- set_car(sc->a2_1, c_call(cdr(arg))(sc, cadr(arg)));
- overwrite_check(car(sc->a2_1),
- set_car(sc->a2_2, c_call(cddr(arg))(sc, caddr(arg))));
+ val = c_call(cdr(arg))(sc, cadr(arg));
+ set_car(sc->a2_2, c_call(cddr(arg))(sc, caddr(arg)));
+ set_car(sc->a2_1, val);
set_car(sc->t1_1, c_call(arg)(sc, sc->a2_1));
sc->value = c_call(code)(sc, sc->t1_1);
goto START;
@@ -69204,13 +69956,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_opAAAq:
{
- s7_pointer arg;
+ s7_pointer arg, val1, val2;
arg = cadr(code);
- set_car(sc->a3_1, c_call(cdr(arg))(sc, cadr(arg)));
- overwrite_check(car(sc->a3_1),
- set_car(sc->a3_2, c_call(cddr(arg))(sc, caddr(arg))));
- overwrite_check(car(sc->a3_2),
- set_car(sc->a3_3, c_call(cdddr(arg))(sc, cadddr(arg))));
+ val1 = c_call(cdr(arg))(sc, cadr(arg));
+ val2 = c_call(cddr(arg))(sc, caddr(arg));
+ set_car(sc->a3_3, c_call(cdddr(arg))(sc, cadddr(arg)));
+ set_car(sc->a3_1, val1);
+ set_car(sc->a3_2, val2);
set_car(sc->t1_1, c_call(arg)(sc, sc->a3_1));
sc->value = c_call(code)(sc, sc->t1_1);
goto START;
@@ -69233,11 +69985,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_S_opAAq:
{
- s7_pointer arg;
+ s7_pointer arg, val1;
arg = caddr(code);
- set_car(sc->a2_1, c_call(cdr(arg))(sc, cadr(arg)));
- overwrite_check(car(sc->a2_1),
- set_car(sc->a2_2, c_call(cddr(arg))(sc, caddr(arg))));
+ val1 = c_call(cdr(arg))(sc, cadr(arg));
+ set_car(sc->a2_2, c_call(cddr(arg))(sc, caddr(arg)));
+ set_car(sc->a2_1, val1);
set_car(sc->t2_2, c_call(arg)(sc, sc->a2_1));
set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(code)));
sc->value = c_call(code)(sc, sc->t2_1);
@@ -69248,16 +70000,16 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_S_opAAAq:
{
- s7_pointer arg, p;
+ s7_pointer arg, p, val1, val2;
p = caddr(code);
arg = cdr(p);
- set_car(sc->a3_1, c_call(arg)(sc, car(arg)));
+ val1 = c_call(arg)(sc, car(arg));
arg = cdr(arg);
- overwrite_check(car(sc->a3_1),
- set_car(sc->a3_2, c_call(arg)(sc, car(arg))));
+ val2 = c_call(arg)(sc, car(arg));
arg = cdr(arg);
- overwrite_check(car(sc->a3_2),
- set_car(sc->a3_3, c_call(arg)(sc, car(arg))));
+ set_car(sc->a3_3, c_call(arg)(sc, car(arg)));
+ set_car(sc->a3_1, val1);
+ set_car(sc->a3_2, val2);
set_car(sc->t2_2, c_call(p)(sc, sc->a3_1));
set_car(sc->t2_1, find_symbol_unchecked(sc, cadr(code)));
sc->value = c_call(code)(sc, sc->t2_1);
@@ -69277,7 +70029,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
{
s7_pointer val;
val = c_call(cdr(code))(sc, cadr(code));
- push_stack(sc, OP_SAFE_C_SZ_1, val, code);
+ push_stack(sc, OP_EVAL_ARGS_P_2, val, code);
sc->code = _TPair(caddr(code));
goto OPT_EVAL_CHECKED;
}
@@ -69286,7 +70038,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_ZA:
/* here we can't use ZS order because we sometimes assume left->right arg evaluation (binary-io.scm for example) */
- push_stack(sc, OP_SAFE_C_ZA_1, sc->nil, code);
+ push_stack_no_args(sc, OP_SAFE_C_ZA_1, code);
sc->code = _TPair(cadr(code));
goto OPT_EVAL_CHECKED;
@@ -69296,7 +70048,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
/* most of the component Z's here are very complex:
* 264600: (+ (* even-amp (oscil (vector-ref evens k) (+ even-freq val))) (* odd-amp...
*/
- push_stack(sc, OP_SAFE_C_ZZ_1, sc->nil, code);
+ push_stack_no_args(sc, OP_SAFE_C_ZZ_1, code);
sc->code = _TPair(cadr(code));
goto OPT_EVAL_CHECKED;
@@ -69305,8 +70057,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case HOP_SAFE_C_opCq_Z:
{
s7_pointer val;
- val = c_call(cadr(code))(sc, cdr(cadr(code)));
- push_stack(sc, OP_SAFE_C_ZZ_2, val, code);
+ val = c_call(cadr(code))(sc, cdadr(code));
+ push_stack(sc, OP_EVAL_ARGS_P_2, val, code);
sc->code = _TPair(caddr(code));
goto OPT_EVAL_CHECKED;
}
@@ -69314,9 +70066,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_SAFE_C_ZAA:
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_ZAA:
- push_stack(sc, OP_SAFE_C_ZAA_1, sc->nil, code);
- sc->code = _TPair(cadr(code));
- goto OPT_EVAL_CHECKED;
+ {
+ s7_pointer val;
+ val = c_call(cddr(code))(sc, caddr(code));
+ push_stack(sc, OP_SAFE_C_ZAA_1, val, code);
+ sc->code = _TPair(cadr(code));
+ goto OPT_EVAL_CHECKED;
+ }
case OP_SAFE_C_AZA:
if (!c_function_is_ok(sc, code)) break;
@@ -69326,16 +70082,10 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
val = c_call(cdr(code))(sc, cadr(code));
push_stack(sc, OP_SAFE_C_AZA_1, val, code);
sc->code = _TPair(caddr(code));
+ /* mostly stuff like h_safe_c_aaa */
goto OPT_EVAL_CHECKED;
}
- case OP_SAFE_C_SSZ:
- if (!c_function_is_ok(sc, code)) break;
- case HOP_SAFE_C_SSZ:
- push_stack(sc, OP_SAFE_C_SSZ_1, find_symbol_unchecked(sc, cadr(code)), code);
- sc->code = _TPair(cadddr(code));
- goto OPT_EVAL_CHECKED;
-
case OP_SAFE_C_AAZ:
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_AAZ:
@@ -69352,7 +70102,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_SAFE_C_ZZA:
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_ZZA:
- push_stack(sc, OP_SAFE_C_ZZA_1, sc->nil, code);
+ push_stack_no_args(sc, OP_SAFE_C_ZZA_1, code);
sc->code = _TPair(cadr(code));
goto OPT_EVAL_CHECKED;
@@ -69377,7 +70127,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_SAFE_C_ZZZ:
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_ZZZ:
- push_stack(sc, OP_SAFE_C_ZZZ_1, sc->nil, code);
+ push_stack_no_args(sc, OP_SAFE_C_ZZZ_1, code);
sc->code = _TPair(cadr(code));
goto OPT_EVAL_CHECKED;
@@ -69404,26 +70154,35 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_SAFE_C_AA:
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_AA:
- set_car(sc->a2_1, c_call(cdr(code))(sc, cadr(code)));
- overwrite_check(car(sc->a2_1),
- set_car(sc->a2_2, c_call(cddr(code))(sc, caddr(code))));
- sc->value = c_call(code)(sc, sc->a2_1);
- goto START;
+ {
+ s7_pointer val;
+ val = c_call(cdr(code))(sc, cadr(code));
+ sc->temp4 = val;
+ set_car(sc->a2_2, c_call(cddr(code))(sc, caddr(code)));
+ set_car(sc->a2_1, val);
+ sc->value = c_call(code)(sc, sc->a2_1);
+ sc->temp4 = sc->nil;
+ goto START;
+ }
case OP_SAFE_C_AAA:
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_AAA:
{
- s7_pointer arg;
+ s7_pointer arg, val1, val2;
arg = cdr(code);
- set_car(sc->a3_1, c_call(arg)(sc, car(arg)));
+ val1 = c_call(arg)(sc, car(arg));
+ sc->temp4 = val1;
arg = cdr(arg);
- overwrite_check(car(sc->a3_1) ,
- set_car(sc->a3_2, c_call(arg)(sc, car(arg))));
+ val2 = c_call(arg)(sc, car(arg));
+ sc->temp11 = val2;
arg = cdr(arg);
- overwrite_check(car(sc->a3_2) ,
- set_car(sc->a3_3, c_call(arg)(sc, car(arg))));
- sc->value = c_call(code)(sc, sc->a3_1);
+ set_car(sc->t3_3, c_call(arg)(sc, car(arg)));
+ set_car(sc->t3_1, val1);
+ set_car(sc->t3_2, val2);
+ sc->value = c_call(code)(sc, sc->t3_1);
+ sc->temp4 = sc->nil;
+ sc->temp11 = sc->nil;
goto START;
}
@@ -69431,13 +70190,15 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_SSA:
{
- s7_pointer arg;
+ s7_pointer arg, val1, val2;
arg = cdr(code);
- set_car(sc->a3_1, find_symbol_unchecked(sc, car(arg)));
+ val1 = find_symbol_unchecked(sc, car(arg));
arg = cdr(arg);
- set_car(sc->a3_2, find_symbol_unchecked(sc, car(arg)));
+ val2 = find_symbol_unchecked(sc, car(arg));
arg = cdr(arg);
set_car(sc->a3_3, c_call(arg)(sc, car(arg)));
+ set_car(sc->a3_1, val1);
+ set_car(sc->a3_2, val2);
sc->value = c_call(code)(sc, sc->a3_1);
goto START;
}
@@ -69491,19 +70252,25 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_AAAA:
{
- s7_pointer arg;
+ s7_pointer arg, val1, val2, val3;
arg = cdr(code);
- set_car(sc->a4_1, c_call(arg)(sc, car(arg)));
+ val1 = c_call(arg)(sc, car(arg));
+ sc->temp4 = val1;
arg = cdr(arg);
- overwrite_check(car(sc->a4_1),
- set_car(sc->a4_2, c_call(arg)(sc, car(arg))));
+ val2 = c_call(arg)(sc, car(arg));
+ sc->temp11 = val2;
arg = cdr(arg);
- overwrite_check(car(sc->a4_2),
- set_car(sc->a4_3, c_call(arg)(sc, car(arg))));
+ val3 = c_call(arg)(sc, car(arg));
+ sc->temp5 = val3;
arg = cdr(arg);
- overwrite_check(car(sc->a4_3),
- set_car(sc->a4_4, c_call(arg)(sc, car(arg))));
+ set_car(sc->a4_4, c_call(arg)(sc, car(arg)));
+ set_car(sc->a4_1, val1);
+ set_car(sc->a4_2, val2);
+ set_car(sc->a4_3, val3);
sc->value = c_call(code)(sc, sc->a4_1);
+ sc->temp4 = sc->nil;
+ sc->temp5 = sc->nil;
+ sc->temp11 = sc->nil;
goto START;
}
@@ -69703,7 +70470,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_SAFE_C_PS:
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_PS:
- push_stack(sc, OP_EVAL_ARGS_P_3, sc->nil, code); /* gotta wait in this case */
+ push_stack_no_args(sc, OP_EVAL_ARGS_P_3, code); /* gotta wait in this case */
sc->code = cadr(code);
goto EVAL;
@@ -69717,14 +70484,14 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_SAFE_C_PQ:
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_PQ:
- push_stack(sc, OP_EVAL_ARGS_P_4, cadr(caddr(code)), code); /* was P_5, but that's the same as P_4 */
+ push_stack(sc, OP_EVAL_ARGS_P_4, opt_con2(cdr(code)), code); /* was P_5, but that's the same as P_4 */
sc->code = cadr(code);
goto EVAL;
case OP_SAFE_C_ZQ:
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_ZQ:
- push_stack(sc, OP_EVAL_ARGS_P_4, cadr(caddr(code)), code);
+ push_stack(sc, OP_EVAL_ARGS_P_4, opt_con2(cdr(code)), code);
sc->code = cadr(code);
goto OPT_EVAL_CHECKED;
@@ -69768,17 +70535,21 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (!c_function_is_ok(sc, code)) break;
case HOP_SAFE_C_PP:
check_stack_size(sc);
- push_stack(sc, OP_SAFE_C_PP_1, sc->nil, code);
+ push_stack_no_args(sc, OP_SAFE_C_PP_1, code);
sc->code = cadr(code);
goto EVAL;
- case OP_SAFE_C_SSP:
+ case OP_SAFE_C_AAP:
if (!c_function_is_ok(sc, code)) break;
- case HOP_SAFE_C_SSP:
- check_stack_size(sc);
- push_stack(sc, OP_EVAL_ARGS_SSP_1, sc->nil, code);
- sc->code = cadddr(code);
- goto EVAL;
+ case HOP_SAFE_C_AAP:
+ {
+ s7_pointer val;
+ check_stack_size(sc);
+ val = c_call(cdr(code))(sc, cadr(code));
+ push_stack(sc, OP_EVAL_ARGS_AAP_1, val, code);
+ sc->code = cadddr(code);
+ goto EVAL;
+ }
case OP_SAFE_C_opSSq:
if (!c_function_is_ok_cadr(sc, code)) break;
@@ -70254,7 +71025,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
check_stack_size(sc);
set_car(sc->t1_1, find_symbol_unchecked(sc, cadr(args)));
val = c_call(args)(sc, sc->t1_1);
- push_stack(sc, OP_SAFE_C_opSq_P_1, val, sc->code);
+ push_stack(sc, OP_EVAL_ARGS_P_2, val, sc->code);
sc->code = caddr(code);
goto EVAL;
}
@@ -70294,7 +71065,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
s7_pointer args, val;
args = cdr(code);
val = find_symbol_unchecked(sc, cadr(args));
- set_car(sc->t2_1, c_call(car(args))(sc, cdr(car(args))));
+ set_car(sc->t2_1, c_call(car(args))(sc, cdar(args)));
set_car(sc->t2_2, val);
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
@@ -70306,7 +71077,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
{
s7_pointer args;
args = cdr(code);
- set_car(sc->t2_1, c_call(car(args))(sc, cdr(car(args))));
+ set_car(sc->t2_1, c_call(car(args))(sc, cdar(args)));
set_car(sc->t2_2, cadr(args)); /* the second C stands for 1 arg? */
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
@@ -70368,8 +71139,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
int32_t tx;
tx = next_tx(sc);
args = cdr(code);
- sc->t_temps[tx] = c_call(car(args))(sc, cdr(car(args)));
- set_car(sc->t2_2, c_call(cadr(args))(sc, cdr(cadr(args)))); /* this can clobber sc->t2_1! */
+ sc->t_temps[tx] = c_call(car(args))(sc, cdar(args));
+ set_car(sc->t2_2, c_call(cadr(args))(sc, cdadr(args))); /* this can clobber sc->t2_1! */
set_car(sc->t2_1, sc->t_temps[tx]);
sc->value = c_call(code)(sc, sc->t2_1);
goto START;
@@ -70400,7 +71171,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
int32_t tx;
tx = next_tx(sc);
args = cdr(code);
- sc->t_temps[tx] = c_call(car(args))(sc, cdr(car(args)));
+ sc->t_temps[tx] = c_call(car(args))(sc, cdar(args));
set_car(sc->t1_1, find_symbol_unchecked(sc, cadadr(args)));
set_car(sc->t2_2, c_call(cadr(args))(sc, sc->t1_1));
set_car(sc->t2_1, sc->t_temps[tx]);
@@ -70417,7 +71188,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
tx = next_tx(sc);
/* code: (/ (+ bn 1) (+ bn an)) */
args = cdr(code);
- sc->t_temps[tx] = c_call(car(args))(sc, cdr(car(args)));
+ sc->t_temps[tx] = c_call(car(args))(sc, cdar(args));
args = cdr(args);
set_car(sc->t2_1, find_symbol_unchecked(sc, cadar(args)));
set_car(sc->t2_2, find_symbol_unchecked(sc, caddar(args)));
@@ -70559,14 +71330,14 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_C_Z:
if (!c_function_is_ok(sc, code)) break;
case HOP_C_Z:
- push_stack(sc, OP_C_P_1, sc->nil, code);
+ push_stack_no_args(sc, OP_C_P_1, code);
sc->code = _TPair(cadr(code));
goto OPT_EVAL_CHECKED;
case OP_C_P:
if (!c_function_is_ok(sc, code)) break;
case HOP_C_P:
- push_stack(sc, OP_C_P_1, sc->nil, code);
+ push_stack_no_args(sc, OP_C_P_1, code);
sc->code = _TPair(cadr(code));
goto EVAL;
@@ -70589,16 +71360,25 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto EVAL;
}
- case OP_C_FA:
+ case OP_C_FA: /* op_c_fs was not faster if all_x_s below */
if (!c_function_is_ok(sc, code)) break;
case HOP_C_FA:
- sc->code = cdr(cadr(code));
- /* need to check lambda if not done already */
- make_closure_with_let(sc, sc->value, car(sc->code), cdr(sc->code), sc->envir); /* sc->value=new closure cell, car=args, cdr=body */
+ sc->code = cdadr(code);
+ make_closure_with_let(sc, sc->value, car(sc->code), cdr(sc->code), sc->envir, CLOSURE_ARITY_NOT_SET);
+ /* sc->value=new closure cell, car=args, cdr=body */
sc->args = list_2(sc, sc->value, c_call(cddr(code))(sc, caddr(code)));
sc->value = c_call(code)(sc, sc->args);
goto START;
+ case OP_C_FA_1:
+ if (!c_function_is_ok(sc, code)) break;
+ case HOP_C_FA_1:
+ sc->code = cdadr(code);
+ make_closure_with_let(sc, sc->value, car(sc->code), cdr(sc->code), sc->envir, CLOSURE_ARITY_NOT_SET);
+ sc->value = c_call(code)(sc, set_plist_2(sc, sc->value, c_call(cddr(code))(sc, caddr(code))));
+ set_plist_2(sc, sc->nil, sc->nil); /* hooboy -- GC protects plists */
+ goto START;
+
case OP_C_AA:
if (!c_function_is_ok(sc, code)) break;
case HOP_C_AA:
@@ -70611,9 +71391,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_APPLY_SS:
if (!c_function_is_ok(sc, code)) break;
case HOP_APPLY_SS:
- sc->code = find_symbol_unchecked(sc, cadr(code)); /* global search here was slower */
+ sc->code = find_symbol_unchecked(sc, cadr(code)); /* global search here was slower */
sc->args = find_symbol_unchecked(sc, opt_sym2(code)); /* is this right if code=macro? */
- if (!s7_is_proper_list(sc, sc->args)) /* (apply + #f) etc */
+ if (!s7_is_proper_list(sc, sc->args)) /* (apply + #f) etc */
return(apply_list_error(sc, sc->args));
if (needs_copied_args(sc->code))
sc->args = copy_list(sc, sc->args);
@@ -70699,10 +71479,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
*/
s7_pointer p, f, args, tag;
args = cddr(code);
-
+
/* defer making the error lambda */
- /* z = cdadr(args); make_closure_with_let(sc, y, car(z), cdr(z), sc->envir); */
-
/* check catch tag */
f = cadr(code);
if (!is_pair(f)) /* (catch #t ...) or (catch sym ...) */
@@ -70716,7 +71494,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
new_cell(sc, p, T_CATCH); /* the catch object sitting on the stack */
catch_tag(p) = tag;
catch_goto_loc(p) = s7_stack_top(sc);
- catch_op_loc(p) = (int)(sc->op_stack_now - sc->op_stack);
+ catch_op_loc(p) = (int32_t)(sc->op_stack_now - sc->op_stack);
catch_handler(p) = cdadr(args); /* not yet a closure... */
push_stack(sc, OP_CATCH_1, code, p); /* code ignored here, except by GC */
@@ -70727,24 +71505,14 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_C_CATCH_ALL:
if (!c_function_is_ok(sc, code)) break;
- case HOP_C_CATCH_ALL:
+ case HOP_C_CATCH_ALL: /* (catch #t (lambda () ...) (lambda args #f) */
{
- /* (catch #t (lambda () ...) (lambda args #f) */
s7_pointer p;
new_frame(sc, sc->envir, sc->envir);
- /* catch_all needs 3 pieces of info: the goto/op locs and the result
- * the locs are uint32_ts, so this fits in the new frame's trailing fields.
- * we could store the result in sc->args, push_stacked below and recovered
- * in catch_all_function, and have a free list of empty lets, holding
- * sc->capture_let_counter in the result slot. But there's no gain in
- * speed -- the gc time saved is exactly offset by the empty-let list
- * handling. The current choice is simpler, though gc pauses are worse.
- */
p = sc->envir;
catch_all_set_goto_loc(p, s7_stack_top(sc));
- catch_all_set_op_loc(p, (int)(sc->op_stack_now - sc->op_stack));
- catch_all_set_result(p, opt_con2(code));
- push_stack_no_args(sc, OP_CATCH_ALL, code);
+ catch_all_set_op_loc(p, sc->op_stack_now - sc->op_stack);
+ push_stack(sc, OP_CATCH_ALL, opt_con2(code), code);
sc->code = _TPair(opt_pair1(cdr(code))); /* the body of the first lambda */
goto BEGIN1;
}
@@ -70757,9 +71525,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
new_frame(sc, sc->envir, sc->envir);
p = sc->envir;
catch_all_set_goto_loc(p, s7_stack_top(sc));
- catch_all_set_op_loc(p, (int)(sc->op_stack_now - sc->op_stack));
- catch_all_set_result(p, opt_con2(code));
- push_stack_no_args(sc, OP_CATCH_ALL, code);
+ catch_all_set_op_loc(p, sc->op_stack_now - sc->op_stack);
+ push_stack(sc, OP_CATCH_ALL, opt_con2(code), code);
sc->code = _TPair(car(opt_pair1(cdr(code))));
goto OPT_EVAL_CHECKED;
}
@@ -70804,7 +71571,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_S_A:
case HOP_S_A:
- /* fprintf(stderr, "s_a: %s\n", DISPLAY(code)); */
sc->code = find_symbol_unchecked(sc, car(code));
if (dont_eval_args(sc->code))
sc->args = cdr(code);
@@ -70896,7 +71662,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case HOP_SAFE_LTHUNK_P:
sc->envir = closure_let(opt_lambda(code));
sc->code = car(closure_body(opt_lambda(code)));
- sc->op = (opcode_t)pair_syntax_op(sc->code);
+ sc->cur_op = (opcode_t)pair_syntax_op(sc->code);
sc->code = cdr(sc->code);
goto START_WITHOUT_POP_STACK;
@@ -70925,7 +71691,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case HOP_SAFE_CLOSURE_S_P:
sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), find_symbol_unchecked(sc, opt_sym2(code)));
sc->code = car(closure_body(opt_lambda(code)));
- sc->op = (opcode_t)pair_syntax_op(sc->code);
+ sc->cur_op = (opcode_t)pair_syntax_op(sc->code);
sc->code = cdr(sc->code);
goto START_WITHOUT_POP_STACK;
@@ -70934,7 +71700,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case HOP_SAFE_LCLOSURE_L_P:
sc->envir = old_frame_with_slot(sc, closure_let(opt_lambda(code)), local_symbol_value(opt_sym2(code)));
sc->code = car(closure_body(opt_lambda(code)));
- sc->op = (opcode_t)pair_syntax_op(sc->code);
+ sc->cur_op = (opcode_t)pair_syntax_op(sc->code);
sc->code = cdr(sc->code);
goto START_WITHOUT_POP_STACK;
@@ -71015,8 +71781,19 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)),
find_symbol_unchecked(sc, cadr(code)),
find_symbol_unchecked(sc, opt_sym2(code)));
- sc->code = _TPair(closure_body(opt_lambda(code)));
- goto BEGIN1;
+ sc->code = car(closure_body(opt_lambda(code)));
+ goto EVAL;
+
+ case OP_SAFE_CLOSURE_SS_B:
+ if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
+ case HOP_SAFE_CLOSURE_SS_B:
+ sc->envir = old_frame_with_two_slots(sc, closure_let(opt_lambda(code)),
+ find_symbol_unchecked(sc, cadr(code)),
+ find_symbol_unchecked(sc, opt_sym2(code)));
+ sc->code = closure_body(opt_lambda(code));
+ push_stack_no_args(sc, OP_BEGIN1, _TPair(cdr(sc->code)));
+ sc->code = car(sc->code);
+ goto EVAL;
case OP_SAFE_CLOSURE_SC:
if (!closure_is_ok(sc, code, MATCH_SAFE_CLOSURE, 2)) {if (unknown_gg_ex(sc, sc->last_function) == goto_OPT_EVAL) goto OPT_EVAL; break;}
@@ -71148,7 +71925,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
else slot_set_value(x, sc->F);
symbol_set_local(slot_symbol(x), let_id(sc->envir), x);
}
- sc->code = closure_body(opt_lambda(sc->code));
+ sc->code = _TPair(closure_body(opt_lambda(sc->code)));
goto BEGIN1;
}
@@ -71238,9 +72015,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case HOP_SAFE_CLOSURE_STAR_ALL_X:
{
s7_pointer p, old_args;
-
- /* fprintf(stderr, "safe *: %s\n", DISPLAY(code)); */
-
sc->w = cdr(code); /* args aren't evaluated yet */
sc->args = make_list(sc, integer(arglist_length(code)), sc->F);
for (p = sc->args, old_args = sc->w; is_pair(p); p = cdr(p), old_args = cdr(old_args))
@@ -71310,7 +72084,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
set_car(p, c_call(old_args)(sc, car(old_args)));
sc->w = sc->nil;
sc->code = opt_lambda(code);
- /* fprintf(stderr, "opt: %s %s\n", DISPLAY(sc->code), DISPLAY(closure_args(sc->code))); */
new_frame_with_slot(sc, closure_let(sc->code), sc->envir, closure_args(sc->code), sc->args);
sc->code = _TPair(closure_body(sc->code));
goto BEGIN1;
@@ -71351,7 +72124,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
code = opt_lambda(code);
new_frame_with_slot(sc, closure_let(code), sc->envir, car(closure_args(code)), sc->value);
code = car(closure_body(code));
- sc->op = (opcode_t)pair_syntax_op(code);
+ sc->cur_op = (opcode_t)pair_syntax_op(code);
sc->code = cdr(code);
goto START_WITHOUT_POP_STACK;
@@ -71376,7 +72149,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
new_frame_with_two_slots(sc, closure_let(f), sc->envir,
car(args), find_symbol_unchecked(sc, cadr(code)),
cadr(args), find_symbol_unchecked(sc, opt_sym2(code)));
- sc->code = closure_body(f);
+ sc->code = _TPair(closure_body(f));
goto BEGIN1;
}
@@ -71392,7 +72165,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
car(args), find_symbol_unchecked(sc, cadr(code)),
cadr(args), find_symbol_unchecked(sc, opt_sym2(code)));
sc->code = car(closure_body(func));
- goto EVAL;
+ sc->cur_op = (opcode_t)pair_syntax_op(sc->code);
+ sc->code = cdr(sc->code);
+ goto START_WITHOUT_POP_STACK;
}
case OP_CLOSURE_SC:
@@ -71404,7 +72179,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
f = opt_lambda(sc->code);
args = closure_args(f);
new_frame_with_two_slots(sc, closure_let(f), sc->envir, car(args), find_symbol_unchecked(sc, cadr(code)), cadr(args), opt_con2(code));
- sc->code = closure_body(f);
+ sc->code = _TPair(closure_body(f));
goto BEGIN1;
}
@@ -71417,7 +72192,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
f = opt_lambda(sc->code);
args = closure_args(f);
new_frame_with_two_slots(sc, closure_let(f), sc->envir, car(args), cadr(code), cadr(args), find_symbol_unchecked(sc, opt_sym2(code)));
- sc->code = closure_body(f);
+ sc->code = _TPair(closure_body(f));
goto BEGIN1;
}
@@ -71434,7 +72209,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
f = opt_lambda(sc->code);
args = closure_args(f);
new_frame_with_two_slots(sc, closure_let(f), sc->envir, car(args), sc->t_temps[tx], cadr(args), c_call(cdr(a_args))(sc, cadr(a_args)));
- sc->code = closure_body(f);
+ sc->code = _TPair(closure_body(f));
goto BEGIN1;
}
@@ -71465,9 +72240,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case HOP_CLOSURE_FA:
{
s7_pointer farg, larg, aarg, func, func_args;
- farg = cdr(cadr(code));
+ farg = cdadr(code);
aarg = c_call(cddr(code))(sc, caddr(code));
- make_closure_with_let(sc, larg, car(farg), cdr(farg), sc->envir); /* arg func */
+ make_closure_with_let(sc, larg, car(farg), cdr(farg), sc->envir, CLOSURE_ARITY_NOT_SET);
check_stack_size(sc);
func = opt_lambda(sc->code); /* outer func */
func_args = closure_args(func);
@@ -71483,7 +72258,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto OPT_EVAL;
break;
}
-
case HOP_CLOSURE_ALL_S:
{
s7_pointer args, p, func, e;
@@ -71598,7 +72372,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
let_set_slots(e, z);
z = args;
}
- sc->code = closure_body(sc->code);
+ sc->code = _TPair(closure_body(sc->code));
}
goto BEGIN1;
}
@@ -71793,7 +72567,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
break;
}
set_car(sc->t1_1, c_call(cdr(code))(sc, cadr(code)));
- sc->value = (*(c_object_ref(c)))(sc, c, sc->t1_1);
+ sc->value = (*(c_object_ref(sc, c)))(sc, c, sc->t1_1);
goto START;
}
@@ -71826,11 +72600,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
* all list-values, define
* lg:
* trail: safe_c_aa c-function (fnc (car lst) (cdr lst))
- * trail: unknown_gg function (letstar outer-vars inner-vars)
- * trail: unknown_all_s function (letstar outer-vars inner-vars inner1-vars)
- * trail: unknown_all_s function (letstar outer-vars inner-vars inner1-vars inner2-vars)
* trail: safe_closure_all_x function (f args form env)
- * letstar is (f . x) -- need support for dotted arg
*/
clear_all_optimizations(sc, code);
/* and fall into the normal evaluator */
@@ -71839,19 +72609,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
{
s7_pointer code, carc;
code = sc->code;
-
- /* lint: p 81272 s 319845 r ~100000
- * b: 651000 321000 ~700000
- * sndf: 50187717 1298152 ~350000
- */
-
if (is_pair(code))
{
#if WITH_PROFILE
if (sc->code != profile_at_start)
profile(sc, code);
#endif
- /* fprintf(stderr, "trail: %s\n", DISPLAY(sc->code)); */
+ /* fprintf(stderr, "trail: %s\n", DISPLAY_80(sc->code)); */
set_current_code(sc, code);
carc = car(code);
@@ -71860,8 +72624,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
{
set_syntactic_pair(code); /* leave other bits (T_LINE_NUMBER) intact */
set_car(code, syntax_symbol(slot_value(initial_slot(carc)))); /* clear possible optimization confusion */
- sc->op = (opcode_t)symbol_syntax_op(carc);
- pair_set_syntax_op(code, sc->op);
+ sc->cur_op = (opcode_t)symbol_syntax_op(carc);
+ pair_set_syntax_op(code, sc->cur_op);
sc->code = cdr(code);
goto START_WITHOUT_POP_STACK;
}
@@ -71896,7 +72660,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
((!is_pair(cdr(carc))) || /* ((quote . #\h) (2 . #\i)) ! */
(is_syntactic(cadr(carc)))))
return(apply_error(sc, (is_pair(cdr(carc))) ? cadr(carc) : carc, cdr(code)));
- sc->op = (opcode_t)symbol_syntax_op(car(carc));
+ sc->cur_op = (opcode_t)symbol_syntax_op(car(carc));
sc->code = cdr(carc);
goto START_WITHOUT_POP_STACK;
}
@@ -71917,26 +72681,16 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
else /* sc->code is not a pair */
{
if (is_symbol(code))
- {
- sc->value = find_symbol_checked(sc, code);
- pop_stack(sc);
- if (sc->op != OP_EVAL_ARGS)
- goto START_WITHOUT_POP_STACK;
- /* drop into OP_EVAL_ARGS */
- }
- else
- {
- /* sc->code is not a pair or a symbol */
- sc->value = _NFre(code);
- goto START;
- }
+ sc->value = find_symbol_checked(sc, code);
+ else sc->value = _NFre(code);
+ goto START;
}
- /* sc->value is car=something applicable
- * sc->code = rest of expression
- * sc->args is nil (set by the drop-through cases above -- perhaps clearer to bring that down?)
- */
}
-
+
+ /* sc->value is car=something applicable
+ * sc->code = rest of expression
+ * sc->args is nil (set by the drop-through cases above -- perhaps clearer to bring that down?)
+ */
case OP_EVAL_ARGS:
if (dont_eval_args(sc->value))
{
@@ -71950,7 +72704,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
/* (define progn begin) (progn (display "hi") (+ 1 23)) */
if (!is_syntax(sc->value))
eval_error(sc, "attempt to evaluate: ~A?", sc->code);
- sc->op = (opcode_t)syntax_opcode(sc->value);
+ sc->cur_op = (opcode_t)syntax_opcode(sc->value);
goto START_WITHOUT_POP_STACK;
}
@@ -71986,8 +72740,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto APPLY;
}
- case OP_EVAL_ARGS2:
- /* sc->value is the last arg, [so if is_null(cdr(sc->code) and current is pair, push args2] */
+ case OP_EVAL_ARGS2: /* sc->value is the last arg, [so if is_null(cdr(sc->code) and current is pair, push args2] */
{
s7_pointer x;
sc->code = pop_op_stack(sc);
@@ -72002,9 +72755,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
/* tricky cases here all involve values (i.e. multiple-values) */
case OP_EVAL_ARGS_P_2:
- /* from HOP_SAFE_C_SP||CP|QP, handled like P_1 case above
- * primarily involves generators: (outa i (nrcos gen)) etc
- */
set_car(sc->t2_1, sc->args);
set_car(sc->t2_2, sc->value);
sc->value = c_call(sc->code)(sc, sc->t2_1);
@@ -72015,34 +72765,16 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->code = c_function_base(opt_cfunc(sc->code));
goto APPLY;
- case OP_EVAL_ARGS_SSP_1:
- /* from HOP_SAFE_C_SSP */
- set_car(sc->t3_3, sc->value);
- set_car(sc->t3_1, find_symbol_unchecked(sc, cadr(sc->code)));
- set_car(sc->t3_2, find_symbol_unchecked(sc, caddr(sc->code)));
- sc->value = c_call(sc->code)(sc, sc->t3_1);
- break;
-
- case OP_EVAL_ARGS_SSP_MV:
- sc->args = cons(sc, find_symbol_unchecked(sc, cadr(sc->code)),
- cons(sc, find_symbol_unchecked(sc, caddr(sc->code)),
- sc->value));
- sc->code = c_function_base(opt_cfunc(sc->code));
- goto APPLY;
-
case OP_EVAL_ARGS_P_3:
set_car(sc->t2_2, find_symbol_unchecked(sc, caddr(sc->code)));
- /* we have to wait because we say the evaluation order is always left to right
+ /* we have to wait because we say the evaluation order is left to right (in lambda*)
* and the first arg's evaluation might change the value of the second arg.
*/
set_car(sc->t2_1, sc->value);
sc->value = c_call(sc->code)(sc, sc->t2_1);
break;
- case OP_EVAL_ARGS_P_3_MV:
- /* (define (hi a) (+ (values 1 2) a))
- * (define (hi a) (log (values 1 2) a))
- */
+ case OP_EVAL_ARGS_P_3_MV: /* (define (hi a) (+ (values 1 2) a)) */
sc->w = sc->value;
sc->args = cons(sc, find_symbol_unchecked(sc, caddr(sc->code)), sc->w);
sc->code = c_function_base(opt_cfunc(sc->code));
@@ -72054,23 +72786,29 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->value = c_call(sc->code)(sc, sc->t2_1);
break;
- case OP_EVAL_ARGS_P_4_MV: /* same as P_2_MV) */
- sc->args = cons(sc, sc->args, sc->value);
- sc->code = c_function_base(opt_cfunc(sc->code));
- goto APPLY; /* (define (hi) (log (values 1 2) 3)) ? */
-
- case OP_SAFE_C_ZC_1:
- set_car(sc->t2_1, sc->value);
- set_car(sc->t2_2, sc->args);
- sc->value = c_call(sc->code)(sc, sc->t2_1);
- break;
-
- case OP_SAFE_C_SZ_1:
- set_car(sc->t2_1, sc->args);
- set_car(sc->t2_2, sc->value);
- sc->value = c_call(sc->code)(sc, sc->t2_1);
- break;
+ case OP_EVAL_ARGS_AAP_1: /* from OP_SAFE_C_AAP */
+ {
+ s7_pointer val1, val3;
+ val1 = sc->args;
+ val3 = sc->value;
+ set_car(sc->t3_2, c_call(cddr(sc->code))(sc, caddr(sc->code)));
+ set_car(sc->t3_1, val1);
+ set_car(sc->t3_3, val3);
+ sc->value = c_call(sc->code)(sc, sc->t3_1);
+ break;
+ }
+ case OP_EVAL_ARGS_AAP_MV:
+ {
+ s7_pointer val1, val2, val3;
+ val1 = sc->args;
+ val3 = sc->value;
+ val2 = c_call(cddr(sc->code))(sc, caddr(sc->code));
+ sc->args = cons(sc, val1, cons(sc, val2, val3));
+ sc->code = c_function_base(opt_cfunc(sc->code));
+ goto APPLY;
+ }
+
case OP_SAFE_C_SZ_SZ:
/* S_opSZq actually, in (nominal second, only actual) SZ, S=args, Z=value,
* SZ from the SP combiner for SZ
@@ -72089,22 +72827,21 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
break;
case OP_SAFE_C_ZZ_1:
- push_stack(sc, OP_SAFE_C_ZZ_2, sc->value, sc->code);
+ push_stack(sc, OP_EVAL_ARGS_P_2, sc->value, sc->code);
sc->code = _TPair(caddr(sc->code));
goto OPT_EVAL;
- case OP_SAFE_C_ZZ_2:
- set_car(sc->t2_1, sc->args);
- set_car(sc->t2_2, sc->value);
- sc->value = c_call(sc->code)(sc, sc->t2_1);
- break;
-
case OP_SAFE_C_ZAA_1:
- set_car(sc->a3_1, sc->value);
- set_car(sc->a3_2, c_call(cddr(sc->code))(sc, caddr(sc->code)));
- set_car(sc->a3_3, c_call(cdddr(sc->code))(sc, cadddr(sc->code)));
- sc->value = c_call(sc->code)(sc, sc->a3_1);
- break;
+ {
+ s7_pointer val1, val2;
+ val1 = sc->value;
+ val2 = sc->args;
+ set_car(sc->a3_3, c_call(cdddr(sc->code))(sc, cadddr(sc->code)));
+ set_car(sc->a3_1, val1);
+ set_car(sc->a3_2, val2);
+ sc->value = c_call(sc->code)(sc, sc->a3_1);
+ break;
+ }
case OP_SAFE_C_AZA_1:
set_car(sc->t3_3, c_call(cdddr(sc->code))(sc, cadddr(sc->code)));
@@ -72113,13 +72850,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->value = c_call(sc->code)(sc, sc->t3_1);
break;
- case OP_SAFE_C_SSZ_1:
- set_car(sc->t3_1, sc->args);
- set_car(sc->t3_3, sc->value);
- set_car(sc->t3_2, find_symbol_unchecked(sc, caddr(sc->code)));
- sc->value = c_call(sc->code)(sc, sc->t3_1);
- break;
-
case OP_SAFE_C_AAZ_1:
set_car(sc->t3_1, pop_op_stack(sc));
set_car(sc->t3_2, sc->args);
@@ -72145,18 +72875,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
s7_pointer val;
push_op_stack(sc, sc->value);
val = c_call(cddr(sc->code))(sc, caddr(sc->code));
- push_stack(sc, OP_SAFE_C_ZAZ_2, val, sc->code);
+ push_stack(sc, OP_SAFE_C_AAZ_1, val, sc->code);
sc->code = _TPair(cadddr(sc->code));
goto OPT_EVAL_CHECKED;
}
-
- case OP_SAFE_C_ZAZ_2:
- set_car(sc->t3_1, pop_op_stack(sc));
- set_car(sc->t3_2, sc->args);
- set_car(sc->t3_3, sc->value);
- sc->value = c_call(sc->code)(sc, sc->t3_1);
- break;
-
+
case OP_SAFE_C_AZZ_1:
push_op_stack(sc, sc->value);
push_stack(sc, OP_SAFE_C_AZZ_2, sc->args, sc->code);
@@ -72172,54 +72895,16 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_SAFE_C_ZZZ_1:
push_stack(sc, OP_SAFE_C_ZZZ_2, sc->value, sc->code);
- sc->code = _TPair(caddr(sc->code));
+ sc->code = opt_pair2(cdr(sc->code));
goto OPT_EVAL_CHECKED;
case OP_SAFE_C_ZZZ_2:
push_op_stack(sc, sc->value);
- push_stack(sc, OP_SAFE_C_ZZZ_3, sc->args, sc->code);
- sc->code = _TPair(cadddr(sc->code));
+ push_stack(sc, OP_SAFE_C_AZZ_2, sc->args, sc->code);
+ sc->code = opt_pair1(cdr(sc->code));
goto OPT_EVAL_CHECKED;
- case OP_SAFE_C_ZZZ_3:
- set_car(sc->t3_1, sc->args);
- set_car(sc->t3_2, pop_op_stack(sc));
- set_car(sc->t3_3, sc->value);
- sc->value = c_call(sc->code)(sc, sc->t3_1);
- break;
-
- case OP_SAFE_C_opSq_P_1:
- /* this is the no-multiple-values case */
- set_car(sc->t2_1, sc->args);
- set_car(sc->t2_2, sc->value);
- sc->value = c_call(sc->code)(sc, sc->t2_1);
- break;
-
- case OP_SAFE_C_opSq_P_MV:
- /* here we need an argnum check since values could have appended any number of args
- */
- sc->args = cons(sc, sc->args, sc->value);
-
- /* can values return an improper or circular list? I don't think so:
- * (values 1 . 2) -> improper arg list error (same with apply values)
- *
- * currently (values) does not simply erase itself:
- * :(let () (define (arg2 a) (let ((b 1)) (set! b (+ a b)) (values))) (define (hi c) (expt (abs c) (arg2 2))) (hi 2))
- * ;expt power, argument 2, #<unspecified>, is an untyped but should be a number
- * :(s7-version (values))
- * ;s7-version: too many arguments: (#<unspecified>)
- * :(exp (values) 0.0)
- * ;exp: too many arguments: (#<unspecified> 0.0)
- *
- * map is explicitly a special case, and surely it is more confusing to have (values) scattered at random.
- * also this is consistent with the unoptimized version
- */
- sc->code = c_function_base(opt_cfunc(sc->code));
- goto APPLY; /* (define (hi a) (+ (abs a) (values 1 2 3))) */
-
- case OP_EVAL_ARGS3:
- /* sc->value is the next-to-last arg, and we know the last arg is not a list (so values can't mess us up!)
- */
+ case OP_EVAL_ARGS3: /* sc->value is the next-to-last arg, and we know the last arg is not a list (so values can't mess us up!) */
{
s7_pointer x, y, val;
@@ -72423,12 +73108,12 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case T_MACRO:
/* this is not from the reader, so treat expansions here as normal macros */
- push_stack(sc, OP_EVAL_MACRO, sc->nil, sc->nil);
+ push_stack_op_let(sc, OP_EVAL_MACRO);
new_frame(sc, closure_let(sc->code), sc->envir);
goto APPLY_LAMBDA;
case T_BACRO:
- push_stack(sc, OP_EVAL_MACRO, sc->nil, sc->nil);
+ push_stack_op_let(sc, OP_EVAL_MACRO);
new_frame(sc, sc->envir, sc->envir); /* like let* -- we'll be adding macro args, so might as well sequester things here */
goto APPLY_LAMBDA;
@@ -72438,13 +73123,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto APPLY_LAMBDA;
case T_MACRO_STAR:
- push_stack(sc, OP_EVAL_MACRO, sc->nil, sc->nil);
+ push_stack_op_let(sc, OP_EVAL_MACRO);
new_frame(sc, closure_let(sc->code), sc->envir);
if (apply_lambda_star(sc) == goto_EVAL) goto EVAL;
goto BEGIN1;
case T_BACRO_STAR:
- push_stack(sc, OP_EVAL_MACRO, sc->nil, sc->nil);
+ push_stack_op_let(sc, OP_EVAL_MACRO);
new_frame(sc, sc->envir, sc->envir);
if (apply_lambda_star(sc) == goto_EVAL) goto EVAL;
goto BEGIN1;
@@ -72493,7 +73178,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (is_pair(caar(sc->code))) /* (macroexpand ((symbol->value 'mac) (+ 1 2))) */
{
- push_stack(sc, OP_MACROEXPAND_1, sc->nil, sc->code);
+ push_stack_no_args(sc, OP_MACROEXPAND_1, sc->code);
sc->code = caar(sc->code);
goto EVAL;
}
@@ -72565,7 +73250,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->value = find_symbol_checked(sc, car(sc->code));
goto START;
}
- push_stack(sc, OP_DEFINE_CONSTANT1, sc->nil, sc->code);
+ push_stack_no_args(sc, OP_DEFINE_CONSTANT1, sc->code);
case OP_DEFINE_STAR:
case OP_DEFINE:
@@ -73119,7 +73804,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_IF1:
if (is_true(sc, sc->value))
sc->code = car(sc->code);
- else sc->code = cadr(sc->code); /* even pre-optimization, (if #f #f) ==> #<unspecified> because unique_car(sc->nil) = sc->unspecified */
+ else sc->code = unchecked_car(cdr(sc->code)); /* even pre-optimization, (if #f #f) ==> #<unspecified> because unique_car(sc->nil) = sc->unspecified */
if (is_pair(sc->code))
goto EVAL;
if (is_symbol(sc->code))
@@ -73146,18 +73831,16 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
IF_CASE(OP_IF_C,
if (is_true(sc, c_call(car(sc->code))(sc, opt_pair2(sc->code)))),
if (is_false(sc, c_call(cadar(sc->code))(sc, opt_pair2(sc->code)))))
-
- IF_CASE(OP_IF_IS_PAIR,
- if (is_pair(find_symbol_unchecked(sc, opt_sym2(sc->code)))),
- if (!is_pair(find_symbol_unchecked(sc, opt_sym2(sc->code)))))
- IF_CASE(OP_IF_IS_NULL,
- if (is_null(find_symbol_unchecked(sc, opt_sym2(sc->code)))),
- if (!is_null(find_symbol_unchecked(sc, opt_sym2(sc->code)))))
+ IF_CASE(OP_IF_IS_TYPE_S,
+ if (type(find_symbol_unchecked(sc, opt_sym2(sc->code))) == opt_con3(sc->code)),
+ if (type(find_symbol_unchecked(sc, opt_sym2(sc->code))) != opt_con3(sc->code)))
- IF_CASE(OP_IF_IS_SYMBOL,
- if (is_symbol(find_symbol_unchecked(sc, opt_sym2(sc->code)))),
- if (!is_symbol(find_symbol_unchecked(sc, opt_sym2(sc->code)))))
+ IF_CASE(OP_IF_IS_TYPE_opSq,
+ set_car(sc->t1_1, find_symbol_unchecked(sc, opt_sym2(sc->code))); \
+ if (type(c_call(cadar(sc->code))(sc, sc->t1_1)) == opt_con3(sc->code)),
+ set_car(sc->t1_1, find_symbol_unchecked(sc, opt_sym2(sc->code))); \
+ if (type(c_call(cadr(cadar(sc->code)))(sc, sc->t1_1)) != opt_con3(sc->code)))
IF_CASE(OP_IF_CS,
set_car(sc->t1_1, find_symbol_unchecked(sc, opt_sym2(sc->code))); if (is_true(sc, c_call(car(sc->code))(sc, sc->t1_1))),
@@ -73205,15 +73888,23 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
IF_CASE(OP_IF_AND2,
if ((is_true(sc, c_call(opt_pair2(sc->code))(sc, car(opt_pair2(sc->code))))) && \
- (is_true(sc, c_call(opt_and_2_test(sc->code))(sc, car(opt_and_2_test(sc->code)))))),
+ (is_true(sc, c_call(opt_pair3(sc->code))(sc, car(opt_pair3(sc->code)))))),
if ((is_false(sc, c_call(opt_pair2(sc->code))(sc, car(opt_pair2(sc->code))))) || \
- (is_false(sc, c_call(opt_and_2_test(sc->code))(sc, car(opt_and_2_test(sc->code)))))))
+ (is_false(sc, c_call(opt_pair3(sc->code))(sc, car(opt_pair3(sc->code)))))))
+
+ IF_CASE(OP_IF_AND3,
+ if ((is_true(sc, c_call(opt_pair2(sc->code))(sc, car(opt_pair2(sc->code))))) && \
+ (is_true(sc, c_call(opt_pair3(sc->code))(sc, car(opt_pair3(sc->code))))) && \
+ (is_true(sc, c_call(cdr(opt_pair3(sc->code)))(sc, cadr(opt_pair3(sc->code)))))),
+ if ((is_false(sc, c_call(opt_pair2(sc->code))(sc, car(opt_pair2(sc->code))))) || \
+ (is_false(sc, c_call(opt_pair3(sc->code))(sc, car(opt_pair3(sc->code))))) || \
+ (is_false(sc, c_call(cdr(opt_pair3(sc->code)))(sc, cadr(opt_pair3(sc->code)))))))
IF_CASE(OP_IF_OR2,
if ((is_true(sc, c_call(opt_pair2(sc->code))(sc, car(opt_pair2(sc->code))))) || \
- (is_true(sc, c_call(opt_and_2_test(sc->code))(sc, car(opt_and_2_test(sc->code)))))),
+ (is_true(sc, c_call(opt_pair3(sc->code))(sc, car(opt_pair3(sc->code)))))),
if ((is_false(sc, c_call(opt_pair2(sc->code))(sc, car(opt_pair2(sc->code))))) && \
- (is_false(sc, c_call(opt_and_2_test(sc->code))(sc, car(opt_and_2_test(sc->code)))))))
+ (is_false(sc, c_call(opt_pair3(sc->code))(sc, car(opt_pair3(sc->code)))))))
case OP_IF_P_P: push_stack_no_args(sc, OP_IF_PP, cadr(sc->code)); sc->code = car(sc->code); goto EVAL;
case OP_IF_P_N: push_stack_no_args(sc, OP_IF_PR, cadr(sc->code)); sc->code = cadar(sc->code); goto EVAL;
@@ -73265,7 +73956,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_WHEN_PP:
if (is_true(sc, sc->value))
- goto BEGIN1;
+ {
+ push_stack_no_args(sc, OP_BEGIN1, _TPair(cdr(sc->code)));
+ sc->code = car(sc->code);
+ goto EVAL;
+ }
sc->value = sc->unspecified;
break;
@@ -73307,8 +74002,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_WHEN_S:
if (is_true(sc, find_symbol_unchecked(sc, car(sc->code))))
{
- sc->code = _TPair(cdr(sc->code));
- goto BEGIN1;
+ push_stack_no_args(sc, OP_BEGIN1, _TPair(cddr(sc->code)));
+ sc->code = cadr(sc->code);
+ goto EVAL;
}
sc->value = sc->unspecified;
break;
@@ -73316,8 +74012,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_WHEN_A:
if (is_true(sc, c_call(sc->code)(sc, car(sc->code))))
{
- sc->code = _TPair(cdr(sc->code));
- goto BEGIN1;
+ push_stack_no_args(sc, OP_BEGIN1, _TPair(cddr(sc->code)));
+ sc->code = cadr(sc->code);
+ goto EVAL;
}
sc->value = sc->unspecified;
break;
@@ -73344,8 +74041,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_UNLESS_S:
if (is_false(sc, find_symbol_unchecked(sc, car(sc->code))))
{
- sc->code = _TPair(cdr(sc->code));
- goto BEGIN1;
+ push_stack_no_args(sc, OP_BEGIN1, _TPair(cddr(sc->code)));
+ sc->code = cadr(sc->code);
+ goto EVAL;
}
sc->value = sc->unspecified;
break;
@@ -73353,8 +74051,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_UNLESS_A:
if (is_false(sc, c_call(sc->code)(sc, car(sc->code))))
{
- sc->code = _TPair(cdr(sc->code));
- goto BEGIN1;
+ push_stack_no_args(sc, OP_BEGIN1, _TPair(cddr(sc->code)));
+ sc->code = cadr(sc->code);
+ goto EVAL;
}
sc->value = sc->unspecified;
break;
@@ -73406,19 +74105,12 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
*
* I think safe_c_ppp would require 18 branches (or maybe just collect the args and concatenate at the end?)
*/
- push_stack(sc, OP_SAFE_C_PP_2, sc->value, sc->code); /* mv -> 3 */
+ push_stack(sc, OP_EVAL_ARGS_P_2, sc->value, sc->code); /* mv -> 3 */
sc->code = caddr(sc->code);
if (is_optimized(sc->code))
goto OPT_EVAL;
goto EVAL;
-
- case OP_SAFE_C_PP_2:
- /* we get here only if neither arg returned multiple values, so sc->args is the first value, and sc->value the second */
- set_car(sc->t2_1, sc->args);
- set_car(sc->t2_2, sc->value);
- sc->value = c_call(sc->code)(sc, sc->t2_1);
- break;
-
+
case OP_SAFE_C_PP_3:
/* we get here if the first arg returned multiple values */
push_stack(sc, OP_SAFE_C_PP_5, sc->value, sc->code);
@@ -73427,12 +74119,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto OPT_EVAL;
goto EVAL;
- case OP_SAFE_C_PP_4:
- /* we get here if the first arg result was normal, but the second had multiple values */
- sc->args = cons(sc, sc->args, sc->value);
- sc->code = c_function_base(opt_cfunc(sc->code));
- goto APPLY;
-
case OP_SAFE_C_PP_5:
/* 1 mv, 2, normal */
sc->args = s7_append(sc, sc->args, list_1(sc, sc->value));
@@ -73464,7 +74150,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto APPLY;
case OP_CLOSURE_AP_1:
- /* sc->value is presumably the "P" argument value, "S" is sc->args */
+ /* sc->value is presumably the "P" argument value, "A" is sc->args */
check_stack_size(sc);
sc->code = opt_lambda(sc->code);
new_frame_with_two_slots(sc, closure_let(sc->code), sc->envir,
@@ -73493,7 +74179,6 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto APPLY;
case OP_CLOSURE_P_MV:
- /* fprintf(stderr, "closure p mv: %s\n", DISPLAY(sc->code)); */
sc->code = opt_lambda(sc->code);
sc->args = copy_list(sc, sc->value);
goto APPLY;
@@ -73501,13 +74186,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_C_AP_1:
sc->value = c_call(sc->code)(sc, list_2(sc, sc->args, sc->value));
break;
-
- case OP_C_AP_2:
- /* op_c_ap_1 -> mv case: (map + (values '(1 2 3) #(1 2 3))) */
- sc->code = c_function_base(opt_cfunc(sc->code));
- sc->args = cons(sc, sc->args, copy_list(sc, sc->value));
- goto APPLY;
-
+
/* -------------------------------- LET -------------------------------- */
case OP_LET_NO_VARS:
new_frame(sc, sc->envir, sc->envir);
@@ -73515,11 +74194,16 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto BEGIN1;
case OP_NAMED_LET_NO_VARS:
- new_frame(sc, sc->envir, sc->envir);
- sc->args = make_closure(sc, sc->nil, cddr(sc->code), T_CLOSURE); /* sc->args is a temp here */
- make_slot_1(sc, sc->envir, car(sc->code), sc->args);
- sc->code = _TPair(cddr(sc->code));
- goto BEGIN1;
+ {
+ s7_pointer body;
+ new_frame(sc, sc->envir, sc->envir);
+ body = cddr(sc->code);
+ sc->args = make_closure(sc, sc->nil, body, T_CLOSURE | T_COPY_ARGS | ((is_safe_closure(body)) ? T_SAFE_CLOSURE : 0), 0);
+ /* sc->args is a temp here */
+ make_slot_1(sc, sc->envir, car(sc->code), sc->args);
+ sc->code = _TPair(body);
+ goto BEGIN1;
+ }
case OP_LET_C:
{
@@ -73562,7 +74246,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
set_car(sc->t1_1, find_symbol_unchecked(sc, opt_sym2(sc->code)));
sc->value = c_call(cadr(binding))(sc, sc->t1_1);
new_frame_with_slot(sc, sc->envir, sc->envir, car(binding), sc->value);
- push_stack_no_args(sc, OP_BEGIN1, cddr(sc->code));
+ push_stack_no_args(sc, OP_BEGIN1, _TPair(cddr(sc->code)));
sc->code = cadr(sc->code);
goto EVAL;
}
@@ -73574,7 +74258,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
val = find_symbol_unchecked(sc, opt_sym2(sc->code));
sc->value = (is_pair(val)) ? car(val) : g_car(sc, set_plist_1(sc, val));
new_frame_with_slot(sc, sc->envir, sc->envir, car(binding), sc->value);
- push_stack_no_args(sc, OP_BEGIN1, cddr(sc->code));
+ push_stack_no_args(sc, OP_BEGIN1, _TPair(cddr(sc->code)));
sc->code = cadr(sc->code);
goto EVAL;
}
@@ -73792,12 +74476,15 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
new_frame(sc, sc->envir, sc->envir);
if (named_let)
{
- sc->x = make_closure(sc, sc->nil, cddr(sc->code), T_CLOSURE); /* args = () in new closure, see NAMED_LET_NO_VARS above */
+ s7_pointer body;
+ body = cddr(sc->code);
+ sc->x = make_closure(sc, sc->nil, body, T_CLOSURE | T_COPY_ARGS | ((is_safe_closure(body)) ? T_SAFE_CLOSURE : 0), 0);
+ /* args = () in new closure, see NAMED_LET_NO_VARS above */
/* if this is a safe closure, we can build its env in advance and name it (a thunk in this case) */
set_funclet(closure_let(sc->x));
funclet_set_function(closure_let(sc->x), car(sc->code));
make_slot_1(sc, sc->envir, car(sc->code), sc->x);
- sc->code = _TPair(cddr(sc->code));
+ sc->code = _TPair(body);
sc->x = sc->nil;
}
else sc->code = _TPair(cdr(sc->code));
@@ -73858,25 +74545,27 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
* is in eval -- goto BEGIN1;, all the eval switches, etc -- probably 500 of the 700
* can be regained directly.
*/
- s7_pointer let_name;
+ s7_pointer let_name, body;
+ int32_t n;
let_name = car(sc->code);
+ body = cddr(sc->code);
sc->envir = new_frame_in_env(sc, sc->envir);
sc->w = sc->nil;
- for (x = cadr(sc->code); is_pair(x); x = cdr(x))
+ for (n = 0, x = cadr(sc->code); is_pair(x); n++, x = cdr(x))
sc->w = cons(sc, caar(x), sc->w);
- sc->x = make_closure(sc, sc->w = safe_reverse_in_place(sc, sc->w), cddr(sc->code), T_CLOSURE);
- if (is_safe_closure(sc->x))
+ if (is_safe_closure(body))
{
s7_pointer arg, new_env;
- /* fprintf(stderr, "%s is safe\n", DISPLAY_80(sc->x)); */
+ sc->x = make_closure(sc, sc->w = safe_reverse_in_place(sc, sc->w), body, T_CLOSURE | T_SAFE_CLOSURE | T_COPY_ARGS, n);
new_env = new_frame_in_env(sc, sc->envir);
closure_set_let(sc->x, new_env);
for (arg = closure_args(sc->x); is_pair(arg); arg = cdr(arg))
make_slot_1(sc, new_env, car(arg), sc->nil);
let_set_slots(new_env, reverse_slots(sc, let_slots(new_env)));
}
+ else sc->x = make_closure(sc, sc->w = safe_reverse_in_place(sc, sc->w), body, T_CLOSURE | T_COPY_ARGS, n);
make_slot_1(sc, sc->envir, let_name, sc->x);
/* sc->x = sc->nil; */
@@ -73896,7 +74585,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
y = args;
}
- sc->code = _TPair(cddr(sc->code));
+ sc->code = _TPair(body);
sc->w = sc->nil;
sc->x = sc->nil;
}
@@ -73996,7 +74685,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
{
sc->envir = new_frame_in_env(sc, sc->envir);
sc->code = _TPair(cdr(sc->value));
- make_slot_1(sc, sc->envir, cx, make_closure(sc, sc->nil, sc->code, T_CLOSURE_STAR));
+ make_slot_1(sc, sc->envir, cx, make_closure(sc, sc->nil, sc->code, T_CLOSURE_STAR | ((is_safe_closure(sc->code)) ? T_SAFE_CLOSURE : 0), 0));
goto BEGIN1;
}
}
@@ -74060,8 +74749,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (is_symbol(car(sc->code)))
{
/* now we need to declare the new function */
- make_slot_1(sc, sc->envir, car(sc->code), make_closure(sc, cadr(sc->code), cddr(sc->code), T_CLOSURE_STAR));
- sc->code = cddr(sc->code);
+ s7_pointer body, args;
+ body = cddr(sc->code);
+ args = cadr(sc->code);
+ make_slot_1(sc, sc->envir, car(sc->code), make_closure(sc, args, body,
+ T_CLOSURE_STAR | ((is_safe_closure(body)) ? T_SAFE_CLOSURE : 0),
+ (is_null(args)) ? 0 : CLOSURE_ARITY_NOT_SET));
+ sc->code = body;
}
else sc->code = _TPair(cdr(sc->code));
goto BEGIN1;
@@ -74226,10 +74920,10 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
while (is_pair(car(sc->args)))
{
s7_pointer settee, new_value;
- settee = car(car(sc->args));
+ settee = caar(sc->args);
new_value = car(cadddr(sc->args));
cadddr(sc->args) = cdr(cadddr(sc->args));
- car(sc->args) = cdr(car(sc->args));
+ car(sc->args) = cdar(sc->args);
if ((!is_symbol(settee)) ||
(symbol_has_accessor(settee)) ||
(is_pair(new_value)))
@@ -74258,10 +74952,10 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
while (is_pair(car(sc->args)))
{
s7_pointer settee, old_value;
- settee = car(car(sc->args));
- old_value = car(caddr(sc->args));
- caddr(sc->args) = cdr(caddr(sc->args));
- car(sc->args) = cdr(car(sc->args));
+ settee = caar(sc->args);
+ old_value = caaddr(sc->args);
+ caddr(sc->args) = cdaddr(sc->args);
+ car(sc->args) = cdar(sc->args);
if ((!is_symbol(settee)) ||
(symbol_has_accessor(settee)))
{
@@ -74285,12 +74979,12 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
check_cond(sc);
case OP_COND_UNCHECKED:
- push_stack(sc, OP_COND1, sc->nil, sc->code);
+ push_stack_no_args(sc, OP_COND1, sc->code);
sc->code = caar(sc->code);
goto EVAL;
case OP_COND_UNCHECKED_Z:
- push_stack(sc, OP_COND1, sc->nil, sc->code);
+ push_stack_no_args(sc, OP_COND1, sc->code);
sc->code = caar(sc->code);
goto OPT_EVAL_CHECKED;
@@ -74299,16 +74993,14 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
{
COND1:
sc->code = cdar(sc->code);
- if (is_null(sc->code))
- {
- if (is_multiple_value(sc->value)) /* (+ 1 (cond ((values 2 3)))) */
- sc->value = splice_in_values(sc, multiple_value(sc->value));
- /* no result clause, so return test, (cond (#t)) -> #t, (cond ((+ 1 2))) -> 3 */
- goto START;
- }
-
if (is_pair(sc->code))
{
+ if (is_null(cdr(sc->code)))
+ {
+ sc->code = car(sc->code);
+ goto EVAL;
+ }
+ /* check_cond catches stray dots */
if ((car(sc->code) == sc->feed_to_symbol) &&
(s7_symbol_value(sc, sc->feed_to_symbol) == sc->undefined))
{
@@ -74318,9 +75010,17 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (res == goto_APPLY) goto APPLY;
goto EVAL;
}
- goto BEGIN1;
+ push_stack_no_args(sc, OP_BEGIN1, _TPair(cdr(sc->code)));
+ sc->code = car(sc->code);
+ goto EVAL;
+ }
+ if (is_null(sc->code))
+ {
+ if (is_multiple_value(sc->value)) /* (+ 1 (cond ((values 2 3)))) */
+ sc->value = splice_in_values(sc, multiple_value(sc->value));
+ /* no result clause, so return test, (cond (#t)) -> #t, (cond ((+ 1 2))) -> 3 */
+ goto START;
}
- eval_error(sc, "cond: unexpected dot? ~A", sc->code); /* (cond (#t . 1)) etc */
}
sc->code = cdr(sc->code);
if (is_null(sc->code))
@@ -74519,16 +75219,20 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_AND_AP:
/* we know c_callee is set on sc->code, and there are only two branches */
- sc->value = c_call(sc->code)(sc, car(sc->code));
- if (is_false(sc, sc->value))
- goto START;
+ if (is_false(sc, c_call(sc->code)(sc, car(sc->code))))
+ {
+ sc->value = sc->F;
+ goto START;
+ }
sc->code = cadr(sc->code);
goto EVAL;
case OP_AND_AZ:
- sc->value = c_call(sc->code)(sc, car(sc->code));
- if (is_false(sc, sc->value))
- goto START;
+ if (is_false(sc, c_call(sc->code)(sc, car(sc->code))))
+ {
+ sc->value = sc->F;
+ goto START;
+ }
sc->code = cadr(sc->code);
goto OPT_EVAL_CHECKED;
@@ -74703,7 +75407,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
(!is_pair(car(sc->code))) ||
(!is_symbol(caar(sc->code))))
eval_error(sc, "define-macro: ~S does not look like a macro?", sc->code);
- sc->value = make_macro(sc);
+ sc->value = make_macro(sc, sc->cur_op);
break;
case OP_DEFINE_BACRO:
@@ -74711,7 +75415,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case OP_DEFINE_EXPANSION:
case OP_DEFINE_MACRO:
case OP_DEFINE_MACRO_STAR:
- check_define_macro(sc, sc->op);
+ check_define_macro(sc, sc->cur_op);
if (symbol_has_accessor(caar(sc->code)))
{
s7_pointer x;
@@ -74725,21 +75429,21 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
sc->code = sc->value;
}
}
- sc->value = make_macro(sc);
+ sc->value = make_macro(sc, sc->cur_op);
break;
case OP_LAMBDA:
check_lambda(sc);
case OP_LAMBDA_UNCHECKED: /* pre-calculating type/arity in check_lambda was slower?? */
- make_closure_with_let(sc, sc->value, car(sc->code), cdr(sc->code), sc->envir); /* sc->value=new closure cell, car=args, cdr=body */
+ make_closure_with_let(sc, sc->value, car(sc->code), cdr(sc->code), sc->envir, CLOSURE_ARITY_NOT_SET); /* sc->value=new closure cell, car=args, cdr=body */
break;
case OP_LAMBDA_STAR:
check_lambda_star(sc);
case OP_LAMBDA_STAR_UNCHECKED:
- sc->value = make_closure(sc, car(sc->code), cdr(sc->code), T_CLOSURE_STAR);
+ sc->value = make_closure(sc, car(sc->code), cdr(sc->code), T_CLOSURE_STAR | ((is_safe_closure(cdr(sc->code))) ? T_SAFE_CLOSURE : 0), CLOSURE_ARITY_NOT_SET);
break;
@@ -74805,6 +75509,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (is_null(sc->code)) /* sc->value is already the selector */
goto START;
+ if (is_null(cdr(sc->code)))
+ {
+ sc->code = car(sc->code);
+ goto EVAL;
+ }
/* check for => */
if ((car(sc->code) == sc->feed_to_symbol) &&
(s7_symbol_value(sc, sc->feed_to_symbol) == sc->undefined))
@@ -74888,13 +75597,13 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (is_simple(selector))
{
for (x = cdr(sc->code); is_pair(x); x = cdr(x))
- if (opt_key(x) == selector)
+ if (opt_any2(x) == selector)
{
sc->code = opt_clause(x);
goto EVAL;
}
}
- sc->code = opt_else(sc->code);
+ sc->code = opt_any3(sc->code);
goto EVAL;
}
break;
@@ -74908,7 +75617,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
{
s7_pointer x, selector, else_clause;
selector = sc->value;
- else_clause = opt_else(sc->code);
+ else_clause = opt_any3(sc->code);
if (else_clause != sc->unspecified)
{
if (is_integer(selector))
@@ -74917,9 +75626,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
val = integer(selector);
for (x = cdr(sc->code); is_pair(x); x = cdr(x))
{
- if (is_integer(opt_key(x)))
+ if (is_integer(opt_any2(x)))
{
- if (integer(opt_key(x)) == val)
+ if (integer(opt_any2(x)) == val)
{
sc->code = opt_clause(x);
goto EVAL;
@@ -74939,7 +75648,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
val = integer(selector);
for (x = cdr(sc->code); is_pair(x); x = cdr(x))
{
- if (integer(opt_key(x)) == val)
+ if (integer(opt_any2(x)) == val)
{
sc->code = opt_clause(x);
goto EVAL;
@@ -74961,12 +75670,12 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
s7_pointer x, selector;
selector = sc->value;
for (x = cdr(sc->code); is_pair(x); x = cdr(x))
- if (s7_is_eqv(opt_key(x), selector))
+ if (s7_is_eqv(opt_any2(x), selector))
{
sc->code = opt_clause(x);
goto EVAL;
}
- sc->code = opt_else(sc->code);
+ sc->code = opt_any3(sc->code);
goto EVAL;
}
break;
@@ -74984,7 +75693,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
{
for (x = cdr(sc->code); is_pair(x); x = cdr(x))
{
- y = opt_key(x);
+ y = opt_any2(x);
if (!is_pair(y))
goto ELSE_CASE_1;
do {
@@ -74996,7 +75705,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
else
{
- sc->code = opt_else(sc->code);
+ sc->code = opt_any3(sc->code);
if (is_pair(sc->code))
goto ELSE_CASE_2;
goto START;
@@ -75010,6 +75719,11 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto START;
ELSE_CASE_2:
+ if (is_null(cdr(sc->code)))
+ {
+ sc->code = car(sc->code);
+ goto EVAL;
+ }
/* check for => */
if ((car(sc->code) == sc->feed_to_symbol) &&
(s7_symbol_value(sc, sc->feed_to_symbol) == sc->undefined))
@@ -75021,7 +75735,9 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto EVAL;
/* sc->code = list_2(sc, cadr(sc->code), list_2(sc, sc->quote_symbol, sc->value)); */
}
- goto BEGIN1;
+ push_stack_no_args(sc, OP_BEGIN1, _TPair(cdr(sc->code)));
+ sc->code = car(sc->code);
+ goto EVAL;
}
sc->value = sc->unspecified;
}
@@ -75043,8 +75759,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
* get confused.
*/
stack_reset(sc); /* is this necessary? */
- push_stack(sc, OP_ERROR_QUIT, sc->nil, sc->nil); /* added 3-Dec-16: try to make sure we actually exit! */
- sc->op = OP_ERROR_QUIT;
+ push_stack_op(sc, OP_ERROR_QUIT); /* added 3-Dec-16: try to make sure we actually exit! */
+ sc->cur_op = OP_ERROR_QUIT;
if (sc->longjmp_ok) longjmp(sc->goto_start, ERROR_QUIT_JUMP);
#if DEBUGGING
fprintf(stderr, "%d: op_error_hook_quit did not jump, returns %s\n", __LINE__, DISPLAY(sc->value));
@@ -75161,7 +75877,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
}
else
{
- push_stack(sc, OP_WITH_LET1, sc->nil, cdr(sc->code));
+ push_stack_no_args(sc, OP_WITH_LET1, cdr(sc->code));
sc->code = sc->value; /* eval env arg */
goto EVAL;
}
@@ -75192,7 +75908,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
/* -------------------------------- the reader -------------------------------- */
POP_READ_LIST:
- /* push-stack OP_READ_LIST is always no_code and sc->op is always OP_READ_LIST (and not used), sc->envir is apparently not needed here
+ /* push-stack OP_READ_LIST is always no_code and op is always OP_READ_LIST (and not used), sc->envir is apparently not needed here
*/
sc->stack_end -= 4;
sc->args = sc->stack_end[2];
@@ -75240,7 +75956,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
{
s7_pointer x;
sc->strbuf[0] = c;
- push_stack_no_code(sc, OP_READ_LIST, sc->args);
+ push_stack_no_let_no_code(sc, OP_READ_LIST, sc->args);
check_stack_size(sc);
sc->value = port_read_name(pt)(sc, pt);
new_cell(sc, x, T_PAIR);
@@ -75258,7 +75974,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (sc->tok == TOKEN_ATOM)
{
s7_pointer x;
- push_stack_no_code(sc, OP_READ_LIST, sc->args);
+ push_stack_no_let_no_code(sc, OP_READ_LIST, sc->args);
check_stack_size(sc);
sc->value = port_read_name(pt)(sc, pt);
new_cell(sc, x, T_PAIR);
@@ -75287,8 +76003,8 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if (sc->tok == TOKEN_EOF)
return(missing_close_paren_error(sc));
- push_stack_no_code(sc, OP_READ_LIST, sc->args);
- push_stack_no_code(sc, OP_READ_LIST, sc->nil);
+ push_stack_no_let_no_code(sc, OP_READ_LIST, sc->args);
+ push_stack_no_let_no_code(sc, OP_READ_LIST, sc->nil);
check_stack_size(sc);
sc->value = read_expression(sc);
if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
@@ -75304,7 +76020,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case '\'':
sc->tok = TOKEN_QUOTE;
- push_stack_no_code(sc, OP_READ_LIST, sc->args);
+ push_stack_no_let_no_code(sc, OP_READ_LIST, sc->args);
sc->value = read_expression(sc);
goto START;
@@ -75324,14 +76040,14 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
case '`':
sc->tok = TOKEN_BACK_QUOTE;
- push_stack_no_code(sc, OP_READ_LIST, sc->args);
+ push_stack_no_let_no_code(sc, OP_READ_LIST, sc->args);
sc->value = read_expression(sc);
if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
goto START;
case ',':
sc->tok = read_comma(sc, pt); /* at_mark or comma */
- push_stack_no_code(sc, OP_READ_LIST, sc->args);
+ push_stack_no_let_no_code(sc, OP_READ_LIST, sc->args);
sc->value = read_expression(sc);
goto START;
@@ -75364,7 +76080,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
if ((is_expansion(car(sc->value))) &&
(expansion_ex(sc) == goto_APPLY))
{
- push_stack(sc, OP_EXPANSION, sc->nil, sc->nil);
+ push_stack(sc, OP_EXPANSION, sc->nil, sc->gc_nil);
new_frame(sc, closure_let(sc->code), sc->envir);
goto APPLY_LAMBDA;
}
@@ -75408,14 +76124,14 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
goto READ_LIST;
case TOKEN_DOT:
- push_stack_no_code(sc, OP_READ_DOT, sc->args);
+ push_stack_no_let_no_code(sc, OP_READ_DOT, sc->args);
sc->tok = token(sc);
sc->value = read_expression(sc);
break;
default:
/* by far the main case here is TOKEN_LEFT_PAREN, but it doesn't save anything to move it to this level */
- push_stack_no_code(sc, OP_READ_LIST, sc->args);
+ push_stack_no_let_no_code(sc, OP_READ_LIST, sc->args);
sc->value = read_expression(sc);
/* check for op_read_list here and explicit pop_stack are slower */
break;
@@ -75444,6 +76160,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
* something is fishy
*/
sc->value = reverse_in_place(sc, sc->value, sc->args);
+ pair_set_dotted(sc->value);
if (main_stack_op(sc) == OP_READ_LIST) goto POP_READ_LIST;
break;
@@ -75470,7 +76187,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
break;
case OP_READ_VECTOR:
- if (!s7_is_proper_list(sc, sc->value)) /* #(1 . 2) */
+ if (is_dotted_pair(sc->value)) /* #(1 . 2) */
return(read_error(sc, "vector constant data is not a proper list"));
sc->v = sc->value;
if (sc->args == small_int(1)) /* sc->args was sc->w earlier from read_sharp */
@@ -75483,7 +76200,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
break;
case OP_READ_INT_VECTOR:
- if (!s7_is_proper_list(sc, sc->value))
+ if (is_dotted_pair(sc->value))
return(read_error(sc, "vector constant data is not a proper list"));
sc->v = sc->value;
if (sc->args == small_int(1)) /* sc->args was sc->w earlier from read_sharp */
@@ -75495,7 +76212,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
break;
case OP_READ_FLOAT_VECTOR:
- if (!s7_is_proper_list(sc, sc->value))
+ if (is_dotted_pair(sc->value))
return(read_error(sc, "vector constant data is not a proper list"));
sc->v = sc->value;
if (sc->args == small_int(1)) /* sc->args was sc->w earlier from read_sharp */
@@ -75507,7 +76224,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
break;
case OP_READ_BYTE_VECTOR:
- if (!s7_is_proper_list(sc, sc->value))
+ if (is_dotted_pair(sc->value))
return(read_error(sc, "byte-vector constant data is not a proper list"));
sc->v = sc->value;
sc->value = g_byte_vector(sc, sc->value);
@@ -75530,7 +76247,7 @@ static s7_pointer eval(s7_scheme *sc, opcode_t first_op)
break;
default:
- fprintf(stderr, "unknown operator: " INT_FORMAT " in %s\n", sc->op, DISPLAY(current_code(sc)));
+ fprintf(stderr, "unknown operator: %" PRIdPTR " in %s\n", sc->cur_op, DISPLAY(current_code(sc)));
#if DEBUGGING
fprintf(stderr, "stack size: %u\n", sc->stack_size);
if (sc->stack_end < sc->stack_start)
@@ -75622,7 +76339,7 @@ static char *mpfr_to_string(mpfr_t val, int32_t radix)
* but we don't know the exponent or the string length until after we call mpfr_get_str.
*/
str = str1;
- ep = (int)expptr;
+ ep = (int32_t)expptr;
len = safe_strlen(str);
/* remove trailing 0's */
@@ -79421,7 +80138,9 @@ static s7_pointer big_gcd(s7_scheme *sc, s7_pointer args)
bool rats = false;
s7_pointer x, lst;
- for (x = args; is_not_null(x); x = cdr(x))
+ if (is_null(args)) return(small_int(0));
+
+ for (x = args; is_pair(x); x = cdr(x))
{
if (!is_rational_via_method(sc, car(x)))
return(wrong_type_argument_with_type(sc, sc->gcd_symbol, position_of(x, args), car(x), a_rational_string));
@@ -79513,7 +80232,9 @@ static s7_pointer big_lcm(s7_scheme *sc, s7_pointer args)
s7_pointer x, lst;
bool rats = false;
- for (x = args; is_not_null(x); x = cdr(x))
+ if (is_null(args)) return(small_int(1));
+
+ for (x = args; is_pair(x); x = cdr(x))
{
if (!is_rational_via_method(sc, car(x)))
return(wrong_type_argument_with_type(sc, sc->lcm_symbol, position_of(x, args), car(x), a_rational_string));
@@ -79898,21 +80619,27 @@ static void init_s7_let(s7_scheme *sc)
static s7_pointer describe_memory_usage(s7_scheme *sc)
{
- /* heap, permanent, stack?, doc strings, sigs, c_func structs (and ports etc), vcts, mx_alloc, output bufs,
+ /* heap, permanent, stack?, doc strings, sigs, c_func structs (and ports etc), mx_alloc, output bufs,
* sinc_tables, c-objects, rc_data, strbuf/tmpbuf[reallocs], autoload tables, hash_entrys, symbol_table,
- * small_ints?
+ * small_ints?=permanent
*/
- int32_t i, syms = 0, len;
+ int32_t i, syms = 0, len, n;
s7_pointer x;
gc_list *gp;
+ char buf[1024];
#ifdef __linux__
struct rusage info;
+ struct timeval ut;
getrusage(RUSAGE_SELF, &info);
- fprintf(stderr, "process size: %" PRId64 "\n", (s7_int)(info.ru_maxrss * 1024));
+ ut = info.ru_utime;
+ n = snprintf(buf, 1024, "process size: %" PRId64 ", time: %ld.%d\n", (s7_int)(info.ru_maxrss * 1024), ut.tv_sec, (int)floor(ut.tv_usec / 1000.0));
+ port_write_string(sc->output_port)(sc, buf, n, sc->output_port);
#endif
- fprintf(stderr, "heap: %" PRId64 " (%" PRId64 " bytes)", sc->heap_size, (s7_int)(sc->heap_size * (sizeof(s7_pointer) + sizeof(s7_cell))));
+ n = snprintf(buf, 1024, "heap: %" PRId64 " (%" PRId64 " bytes)", sc->heap_size, (s7_int)(sc->heap_size * (sizeof(s7_pointer) + sizeof(s7_cell))));
+ port_write_string(sc->output_port)(sc, buf, n, sc->output_port);
+
{
int64_t k;
int32_t ts[NUM_TYPES];
@@ -79921,34 +80648,47 @@ static s7_pointer describe_memory_usage(s7_scheme *sc)
ts[unchecked_type(sc->heap[k])]++;
for (i = 0; i < NUM_TYPES; i++)
{
- if ((i % 10) == 0) fprintf(stderr, "\n ");
+ if ((i % 10) == 0)
+ {
+ n = snprintf(buf, 1024, "\n ");
+ port_write_string(sc->output_port)(sc, buf, n, sc->output_port);
+ }
+
if (ts[i] > 100)
- fprintf(stderr, " (%s): %d", type_name_from_type(sc, i, NO_ARTICLE), ts[i]);
- else fprintf(stderr, " %d", ts[i]);
+ n = snprintf(buf, 1024, " (%s): %d", type_name_from_type(sc, i, NO_ARTICLE), ts[i]);
+ else n = snprintf(buf, 1024, " %d", ts[i]);
+ port_write_string(sc->output_port)(sc, buf, n, sc->output_port);
}
- fprintf(stderr, "\n");
+ n = snprintf(buf, 1024, "\n");
+ port_write_string(sc->output_port)(sc, buf, n, sc->output_port);
}
- fprintf(stderr, "permanent cells: %d (%" PRId64 " bytes)\n", permanent_cells, (s7_int)(permanent_cells * sizeof(s7_cell)));
- fprintf(stderr, "gc protected size: %u, unused: %d\n", sc->protected_objects_size, sc->gpofl_loc);
+ n = snprintf(buf, 1024, "permanent cells: %d (%" PRId64 " bytes)\n", permanent_cells, (s7_int)(permanent_cells * sizeof(s7_cell)));
+ port_write_string(sc->output_port)(sc, buf, n, sc->output_port);
+ n = snprintf(buf, 1024, "gc protected size: %u, unused: %d\n", sc->protected_objects_size, sc->gpofl_loc);
+ port_write_string(sc->output_port)(sc, buf, n, sc->output_port);
for (i = 0; i < SYMBOL_TABLE_SIZE; i++)
for (x = vector_element(sc->symbol_table, i); is_not_null(x); x = cdr(x))
syms++;
- fprintf(stderr, "symbol table: %d (%d symbols, %" PRId64 " bytes)\n", SYMBOL_TABLE_SIZE, syms,
- (s7_int)(SYMBOL_TABLE_SIZE * sizeof(s7_pointer) + syms * 3 * sizeof(s7_cell)));
+ n = snprintf(buf, 1024, "symbol table: %d (%d symbols, %" PRId64 " bytes)\n", SYMBOL_TABLE_SIZE, syms,
+ (s7_int)(SYMBOL_TABLE_SIZE * sizeof(s7_pointer) + syms * 3 * sizeof(s7_cell)));
+ port_write_string(sc->output_port)(sc, buf, n, sc->output_port);
- fprintf(stderr, "stack: %u (%" PRId64 " bytes, current top: %ld)\n", sc->stack_size, (s7_int)(sc->stack_size * sizeof(s7_pointer)), (long int)s7_stack_top(sc));
- fprintf(stderr, "c_functions: %d (%d bytes)\n", c_functions, (int)(c_functions * sizeof(c_proc_t)));
+ n = snprintf(buf, 1024, "stack: %u (%" PRId64 " bytes, current top: %ld)\n", sc->stack_size, (s7_int)(sc->stack_size * sizeof(s7_pointer)), (long int)s7_stack_top(sc));
+ port_write_string(sc->output_port)(sc, buf, n, sc->output_port);
+ n = snprintf(buf, 1024, "c_functions: %d (%d bytes)\n", c_functions, (int)(c_functions * sizeof(c_proc_t)));
+ port_write_string(sc->output_port)(sc, buf, n, sc->output_port);
len = 0;
gp = sc->strings;
- for (i = 0; i < (int)(gp->loc); i++)
+ for (i = 0; i < (int32_t)(gp->loc); i++)
len += string_length(gp->list[i]);
syms = gp->loc;
gp = sc->strings1;
- for (i = 0; i < (int)(gp->loc); i++)
+ for (i = 0; i < (int32_t)(gp->loc); i++)
len += string_length(gp->list[i]);
- fprintf(stderr, "strings: %u, %d bytes\n", syms + gp->loc, len); /* also doc strings, permanent strings, etc */
+ n = snprintf(buf, 1024, "strings: %u, %d bytes\n", syms + gp->loc, len); /* also doc strings, permanent strings, etc */
+ port_write_string(sc->output_port)(sc, buf, n, sc->output_port);
{
int32_t hs;
@@ -79957,15 +80697,16 @@ static s7_pointer describe_memory_usage(s7_scheme *sc)
len = 0;
gp = sc->hash_tables;
- for (i = 0; i < (int)(gp->loc); i++)
+ for (i = 0; i < (int32_t)(gp->loc); i++)
len += (hash_table_mask(gp->list[i]) + 1);
- fprintf(stderr, "hash tables: %d (entries in use: %d, free: %d)\n", (int)(gp->loc), len, hs);
+ n = snprintf(buf, 1024, "hash tables: %" PRId32 " (entries in use: %d, free: %d)\n", (int32_t)(gp->loc), len, hs);
+ port_write_string(sc->output_port)(sc, buf, n, sc->output_port);
}
{
int64_t len = 0, flen = 0, ilen = 0;
gp = sc->vectors;
- for (i = 0; i < (int)(gp->loc); i++)
+ for (i = 0; i < (int32_t)(gp->loc); i++)
{
s7_pointer v;
v = gp->list[i];
@@ -79978,12 +80719,13 @@ static s7_pointer describe_memory_usage(s7_scheme *sc)
else len += vector_length(v);
}
}
- fprintf(stderr, "vectors: %u (%" PRId64 " %" PRId64 " %" PRId64 ")\n", sc->vectors->loc, len, flen, ilen);
+ n = snprintf(buf, 1024, "vectors: %u (%" PRId64 " %" PRId64 " %" PRId64 ")\n", sc->vectors->loc, len, flen, ilen);
+ port_write_string(sc->output_port)(sc, buf, n, sc->output_port);
}
{
int64_t len = 0, flen = 0;
gp = sc->input_ports;
- for (i = 0; i < (int)(gp->loc); i++)
+ for (i = 0; i < (int32_t)(gp->loc); i++)
{
s7_pointer v;
v = gp->list[i];
@@ -79994,7 +80736,8 @@ static s7_pointer describe_memory_usage(s7_scheme *sc)
len += port_data_size(v);
}
}
- fprintf(stderr, "input ports: %d (%" PRId64 " %" PRId64 ")\n", sc->input_ports->loc, len, flen);
+ n = snprintf(buf, 1024, "input ports: %d (%" PRId64 " %" PRId64 ")\n", sc->input_ports->loc, len, flen);
+ port_write_string(sc->output_port)(sc, buf, n, sc->output_port);
}
{
int32_t fs;
@@ -80002,14 +80745,15 @@ static s7_pointer describe_memory_usage(s7_scheme *sc)
port_t *p;
for (fs = 0, p = sc->port_heap; p; p = (port_t *)(p->next), fs++);
gp = sc->continuations;
- for (i = 0, cc_stacks = 0; i < (int)gp->loc; i++)
+ for (i = 0, cc_stacks = 0; i < (int32_t)gp->loc; i++)
if (is_continuation(gp->list[i]))
cc_stacks += continuation_stack_size(gp->list[i]);
- fprintf(stderr, "output ports: %u, free port: %d\ncontinuations: %u (total stack: %u), c_objects: %u, gensyms: %u, setters: %u, optlists: %u\n",
+ n = snprintf(buf, 1024, "output ports: %u, free port: %d\ncontinuations: %u (total stack: %u), c_objects: %u, gensyms: %u, setters: %u, optlists: %u\n",
sc->output_ports->loc, fs,
gp->loc, cc_stacks,
sc->c_objects->loc, sc->gensyms->loc, sc->setters_loc, sc->optlists->loc);
+ port_write_string(sc->output_port)(sc, buf, n, sc->output_port);
}
return(sc->F);
}
@@ -80116,8 +80860,8 @@ static s7_pointer g_s7_let_ref_fallback(s7_scheme *sc, s7_pointer args)
s7_pointer res;
int32_t i;
sc->w = sc->nil;
- for (i = 0; i < num_object_types; i++) /* c-object type (tag) is i */
- sc->w = cons(sc, object_types[i]->scheme_name, sc->w);
+ for (i = 0; i < sc->num_c_object_types; i++) /* c-object type (tag) is i */
+ sc->w = cons(sc, sc->c_object_types[i]->scheme_name, sc->w);
res = safe_reverse_in_place(sc, sc->w); /* so car(types) has tag 0 */
sc->w = sc->nil;
return(res);
@@ -80490,7 +81234,7 @@ char *s7_decode_bt(void)
/* -------------------------------- initialization -------------------------------- */
-static s7_pointer make_unique_object(const char* name, uint32_t typ)
+static s7_pointer make_unique_object(const char* name, uint64_t typ)
{
s7_pointer p;
p = alloc_pointer();
@@ -80511,13 +81255,14 @@ s7_scheme *s7_init(void)
#if (!MS_WINDOWS)
setlocale(LC_NUMERIC, "C"); /* use decimal point in floats */
#endif
-
+
if (!already_inited)
{
init_types();
init_ctables();
init_mark_functions();
init_display_functions();
+ init_length_functions();
init_equals();
init_hash_maps();
init_pows();
@@ -80532,7 +81277,7 @@ s7_scheme *s7_init(void)
}
sc = (s7_scheme *)calloc(1, sizeof(s7_scheme)); /* malloc is not recommended here */
- cur_sc = sc; /* for gdb/debugging */
+ cur_sc = sc; /* for gdb/debugging and clm optimizer */
sc->gc_off = true; /* sc->args and so on are not set yet, so a gc during init -> segfault */
sc->gc_stats = 0;
init_gc_caches(sc);
@@ -80762,6 +81507,9 @@ s7_scheme *s7_init(void)
pthread_mutex_init(&sc->lock, &attr);
}
#endif
+ sc->c_object_types = NULL;
+ sc->c_object_types_size = 0;
+ sc->num_c_object_types = 0;
sc->typnam = NULL;
sc->typnam_len = 0;
@@ -80792,7 +81540,7 @@ s7_scheme *s7_init(void)
sc->baffle_ctr = 0;
sc->syms_tag = 0;
sc->class_name_symbol = make_symbol(sc, "class-name");
- sc->circle_info = NULL;
+ sc->circle_info = init_circle_info();
sc->fdats = (format_data **)calloc(8, sizeof(format_data *));
sc->num_fdats = 8;
sc->plist_1 = permanent_list(sc, 1);
@@ -80975,7 +81723,7 @@ s7_scheme *s7_init(void)
set_immutable(sc->with_let_symbol);
sc->quote_unchecked_symbol = assign_internal_syntax(sc, "quote", OP_QUOTE_UNCHECKED);
- sc->begin_unchecked_symbol = assign_internal_syntax(sc, "begin", OP_BEGIN_UNCHECKED);
+ sc->begin1_symbol = assign_internal_syntax(sc, "begin", OP_BEGIN1);
sc->with_baffle_unchecked_symbol = assign_internal_syntax(sc, "with-baffle", OP_WITH_BAFFLE_UNCHECKED);
sc->let_unchecked_symbol = assign_internal_syntax(sc, "let", OP_LET_UNCHECKED);
sc->let_star_unchecked_symbol = assign_internal_syntax(sc, "let*", OP_LET_STAR_UNCHECKED);
@@ -81092,6 +81840,7 @@ s7_scheme *s7_init(void)
assign_if(andp, ANDP)
assign_if(orp, ORP)
assign_if(and2, AND2)
+ assign_if(and3, AND3)
assign_if(or2, OR2)
assign_if(z, Z)
assign_if(s, S)
@@ -81103,9 +81852,8 @@ s7_scheme *s7_init(void)
assign_if(csc, CSC)
assign_if(s_opcq, S_opCq)
assign_if(opsq, opSq)
- assign_if(is_pair, IS_PAIR)
- assign_if(is_null, IS_NULL)
- assign_if(is_symbol, IS_SYMBOL)
+ assign_if(is_type_s, IS_TYPE_S)
+ assign_if(is_type_opsq, IS_TYPE_opSq)
/* CLL and CLC happen a few times, but make no difference */
#define assign_case(Sym, Op) \
@@ -81211,43 +81959,43 @@ s7_scheme *s7_init(void)
sc->is_boolean_symbol = make_symbol(sc, "boolean?");
pl_bt = s7_make_signature(sc, 2, sc->is_boolean_symbol, sc->T);
- sc->is_symbol_symbol = defun("symbol?", is_symbol, 1, 0, false);
- sc->is_syntax_symbol = defun("syntax?", is_syntax, 1, 0, false);
+ sc->is_symbol_symbol = defun("symbol?", is_symbol, 1, 0, false); symbol_type(sc->is_symbol_symbol) = T_SYMBOL;
+ sc->is_syntax_symbol = defun("syntax?", is_syntax, 1, 0, false); symbol_type(sc->is_syntax_symbol) = T_SYNTAX;
sc->is_gensym_symbol = defun("gensym?", is_gensym, 1, 0, false);
sc->is_keyword_symbol = defun("keyword?", is_keyword, 1, 0, false);
- sc->is_let_symbol = defun("let?", is_let, 1, 0, false);
- sc->is_openlet_symbol = defun("openlet?", is_openlet, 1, 0, false);
- sc->is_iterator_symbol = defun("iterator?", is_iterator, 1, 0, false);
+ sc->is_let_symbol = defun("let?", is_let, 1, 0, false); symbol_type(sc->is_let_symbol) = T_LET;
+ sc->is_openlet_symbol = defun("openlet?", is_openlet, 1, 0, false);
+ sc->is_iterator_symbol = defun("iterator?", is_iterator, 1, 0, false); symbol_type(sc->is_iterator_symbol) = T_ITERATOR;
sc->is_constant_symbol = defun("constant?", is_constant, 1, 0, false);
sc->is_macro_symbol = defun("macro?", is_macro, 1, 0, false);
- sc->is_c_pointer_symbol = defun("c-pointer?", is_c_pointer, 1, 1, false);
- sc->is_c_object_symbol = defun("c-object?", is_c_object, 1, 0, false);
- sc->is_input_port_symbol = defun("input-port?", is_input_port, 1, 0, false);
- sc->is_output_port_symbol = defun("output-port?", is_output_port, 1, 0, false);
- sc->is_eof_object_symbol = defun("eof-object?", is_eof_object, 1, 0, false);
- sc->is_integer_symbol = defun("integer?", is_integer, 1, 0, false);
+ sc->is_c_pointer_symbol = defun("c-pointer?", is_c_pointer, 1, 1, false); symbol_type(sc->is_c_pointer_symbol) = T_C_POINTER;
+ sc->is_c_object_symbol = defun("c-object?", is_c_object, 1, 0, false); symbol_type(sc->is_c_object_symbol) = T_C_OBJECT;
+ sc->is_input_port_symbol = defun("input-port?", is_input_port, 1, 0, false); symbol_type(sc->is_input_port_symbol) = T_INPUT_PORT;
+ sc->is_output_port_symbol = defun("output-port?", is_output_port, 1, 0, false); symbol_type(sc->is_output_port_symbol) = T_OUTPUT_PORT;
+ sc->is_eof_object_symbol = defun("eof-object?", is_eof_object, 1, 0, false); symbol_type(sc->is_eof_object_symbol) = T_EOF_OBJECT;
+ sc->is_integer_symbol = defun("integer?", is_integer, 1, 0, false);
sc->is_number_symbol = defun("number?", is_number, 1, 0, false);
sc->is_real_symbol = defun("real?", is_real, 1, 0, false);
sc->is_complex_symbol = defun("complex?", is_complex, 1, 0, false);
sc->is_rational_symbol = defun("rational?", is_rational, 1, 0, false);
- sc->is_random_state_symbol = defun("random-state?", is_random_state, 1, 0, false);
- sc->is_char_symbol = defun("char?", is_char, 1, 0, false);
- sc->is_string_symbol = defun("string?", is_string, 1, 0, false);
+ sc->is_random_state_symbol = defun("random-state?", is_random_state, 1, 0, false); symbol_type(sc->is_random_state_symbol) = T_RANDOM_STATE;
+ sc->is_char_symbol = defun("char?", is_char, 1, 0, false); symbol_type(sc->is_char_symbol) = T_CHARACTER;
+ sc->is_string_symbol = defun("string?", is_string, 1, 0, false); symbol_type(sc->is_string_symbol) = T_STRING;
sc->is_list_symbol = defun("list?", is_list, 1, 0, false);
- sc->is_pair_symbol = defun("pair?", is_pair, 1, 0, false);
- sc->is_vector_symbol = defun("vector?", is_vector, 1, 0, false);
- sc->is_float_vector_symbol = defun("float-vector?", is_float_vector, 1, 0, false);
- sc->is_int_vector_symbol = defun("int-vector?", is_int_vector, 1, 0, false);
+ sc->is_pair_symbol = defun("pair?", is_pair, 1, 0, false); symbol_type(sc->is_pair_symbol) = T_PAIR;
+ sc->is_vector_symbol = defun("vector?", is_vector, 1, 0, false);
+ sc->is_float_vector_symbol = defun("float-vector?", is_float_vector, 1, 0, false); symbol_type(sc->is_float_vector_symbol) = T_FLOAT_VECTOR;
+ sc->is_int_vector_symbol = defun("int-vector?", is_int_vector, 1, 0, false); symbol_type(sc->is_int_vector_symbol) = T_INT_VECTOR;
sc->is_byte_vector_symbol = defun("byte-vector?", is_byte_vector, 1, 0, false);
- sc->is_hash_table_symbol = defun("hash-table?", is_hash_table, 1, 0, false);
- sc->is_continuation_symbol = defun("continuation?", is_continuation, 1, 0, false);
+ sc->is_hash_table_symbol = defun("hash-table?", is_hash_table, 1, 0, false); symbol_type(sc->is_hash_table_symbol) = T_HASH_TABLE;
+ sc->is_continuation_symbol = defun("continuation?", is_continuation, 1, 0, false); symbol_type(sc->is_continuation_symbol) = T_CONTINUATION;
sc->is_procedure_symbol = defun("procedure?", is_procedure, 1, 0, false);
sc->is_dilambda_symbol = defun("dilambda?", is_dilambda, 1, 0, false);
- /* set above */ defun("boolean?", is_boolean, 1, 0, false);
+ /* set above */ defun("boolean?", is_boolean, 1, 0, false); symbol_type(sc->is_boolean_symbol) = T_BOOLEAN;
sc->is_float_symbol = defun("float?", is_float, 1, 0, false);
sc->is_proper_list_symbol = defun("proper-list?", is_proper_list, 1, 0, false);
sc->is_sequence_symbol = defun("sequence?", is_sequence, 1, 0, false);
- sc->is_null_symbol = defun("null?", is_null, 1, 0, false);
+ sc->is_null_symbol = defun("null?", is_null, 1, 0, false); symbol_type(sc->is_null_symbol) = T_NIL;
/* these are for signatures */
sc->is_unspecified_symbol = s7_make_symbol(sc, "unspecified?");
@@ -81686,7 +82434,7 @@ s7_scheme *s7_init(void)
#endif
s7_define_function(sc, "s7-optimize", g_optimize, 1, 0, false, "short-term debugging aid");
- sym = s7_define_function(sc, "(c-object set)", g_internal_object_set, 1, 0, true, "internal object setter redirection");
+ sym = s7_define_function(sc, "(c-object set)", g_internal_c_object_set, 1, 0, true, "internal object setter redirection");
sc->object_set_function = slot_value(global_slot(sym));
set_scope_safe(slot_value(global_slot(sc->call_with_input_string_symbol)));
@@ -81926,7 +82674,7 @@ s7_scheme *s7_init(void)
s7_int_digits_by_radix[1] = 0;
for (i = 2; i < 17; i++)
- s7_int_digits_by_radix[i] = (int)(floor(((top == 8) ? S7_LOG_LLONG_MAX : S7_LOG_LONG_MAX) / log((double)i)));
+ s7_int_digits_by_radix[i] = (int32_t)(floor(((top == 8) ? S7_LOG_LLONG_MAX : S7_LOG_LONG_MAX) / log((double)i)));
s7_define_constant(sc, "most-positive-fixnum", make_permanent_integer_unchecked((top == 8) ? s7_int_max : ((top == 4) ? S7_LONG_MAX : S7_SHORT_MAX)));
s7_define_constant(sc, "most-negative-fixnum", make_permanent_integer_unchecked((top == 8) ? s7_int_min : ((top == 4) ? S7_LONG_MIN : S7_SHORT_MIN)));
@@ -82159,7 +82907,7 @@ s7_scheme *s7_init(void)
s7_set_b_p_function(slot_value(global_slot(sc->is_boolean_symbol)), s7_is_boolean);
s7_set_b_p_function(slot_value(global_slot(sc->is_byte_vector_symbol)), s7_is_byte_vector);
- s7_set_b_p_function(slot_value(global_slot(sc->is_c_object_symbol)), s7_is_object);
+ s7_set_b_p_function(slot_value(global_slot(sc->is_c_object_symbol)), s7_is_c_object);
s7_set_b_p_function(slot_value(global_slot(sc->is_char_symbol)), s7_is_character);
s7_set_b_p_function(slot_value(global_slot(sc->is_complex_symbol)), s7_is_complex);
s7_set_b_p_function(slot_value(global_slot(sc->is_constant_symbol)), s7_is_constant);
@@ -82270,7 +83018,6 @@ s7_scheme *s7_init(void)
s7_set_p_pi_function(slot_value(global_slot(sc->geq_symbol)), geq_p_pi);
s7_set_p_ii_function(slot_value(global_slot(sc->geq_symbol)), geq_p_ii);
s7_set_p_dd_function(slot_value(global_slot(sc->geq_symbol)), geq_p_dd);
- /* TODO: also multiply_p_pi etc */
s7_set_b_pp_function(slot_value(global_slot(sc->eq_symbol)), req_b_pp);
s7_set_b_pp_function(slot_value(global_slot(sc->lt_symbol)), lt_b_pp);
@@ -82461,14 +83208,14 @@ s7_scheme *s7_init(void)
(define (procedure-arity obj) (let ((c (arity obj))) (list (car c) (- (cdr c) (car c)) (> (cdr c) 100000)))))");
#endif
#if DEBUGGING
- if (strcmp(opt_names[HOP_SAFE_C_SSP], "h_safe_c_ssp") != 0)
- fprintf(stderr, "opt_name: %s\n", opt_names[HOP_SAFE_C_SSP]);
+ if (strcmp(opt_names[HOP_SAFE_C_AAP], "h_safe_c_aap") != 0)
+ fprintf(stderr, "opt_name: %s\n", opt_names[HOP_SAFE_C_AAP]);
if (strcmp(op_names[OP_SET_WITH_LET_2], "set_with_let_2") != 0)
fprintf(stderr, "op_name: %s\n", op_names[OP_SET_WITH_LET_2]);
#endif
/* fprintf(stderr, "size: %d, max op: %d, opt: %d\n", (int)sizeof(s7_cell), OP_MAX_DEFINED, OPT_MAX_DEFINED); */
- /* 64 bit machine: size: 48 or 56(heap-size) [size 72 if gmp, 120 if debugging], op: 426, opt: 442 */
+ /* 64 bit machine: size: 56 [size 80 if gmp, 136 if debugging], op: 425, opt: 442 */
if (sizeof(void *) > sizeof(s7_int))
fprintf(stderr, "s7_int is too small: it has %d bytes, but void* has %d\n", (int)sizeof(s7_int), (int)sizeof(void *));
@@ -82535,7 +83282,7 @@ int main(int argc, char **argv)
/* --------------------------------------------------------------------
*
- * new snd version: snd.h configure.ac HISTORY.Snd NEWS barchive
+ * new snd version: snd.h configure.ac HISTORY.Snd NEWS barchive, /usr/ccrma/web/html/software/snd/index.html
*
* s7:
* if profile, use line/file num to get at hashed count? and use that to annotate pp output via [count]-symbol pre-rewrite
@@ -82554,78 +83301,77 @@ int main(int argc, char **argv)
* play_selection_1 could put ends somewhere, set ends to NO_END_SPECIFIED, dac_loop_sample can
* use begs/other-ends to get loop points, so free_dac_info does not need to restart the loop(?)
* If start/end selection changed while playing, are these loop points updated?
- * there are uses of unscramble in snd-snd.c(1) and snd-dac.c(1)
- *
- * lint: as in random-gen, move internally created but unchanged sequences (lists) out of the body
*
* gtk gl: I can't see how to switch gl in and out as in the motif version -- I guess I need both gl_area and drawing_area
* the old mus-audio-* code needs to use play or something, especially bess*
* snd+gtk+script->eps fails?? Also why not make a graph in the no-gui case? t415.scm.
* remove as many edpos args as possible, and num+bool->num
* snd namespaces: dac, edits, fft, gxcolormaps, mix, region, snd. for snd-mix, tie-ins are in place
- * ruby version crashes in test 4|8 -- file_copy?
*
- * finish the t563.scm bugs: a couple number type problems 31905 30802
- * weed out unused stuff -- choose.data/choose: simple_char_eq, is_eq_caar_q not_is_string|char|pair_car
- * map/for-each multi-expr bodies could be done in-place (rather than cons with begin)
- * map/for-each/sort! in-place if c-func: p_pp
- * for-each+lambda also doable if lambda body is
- * test opt_sizes escape in sort et al -- perhaps save sc->envir, make sure it is ok if optimize fails
- * s7_macroexpand of multiple-value-set!? maybe disable values?
- * s7test 29596 _sort_ 23890 use-redef-1 etc
- * all_x_if_a...?
- * opt let? opt_float_begin in s7_float_optimize for map-channel in snd?
- * g_multiply_2 (et al) -> direct cases
- * tie in p_di|id?
- * private let: block outlet of any let = shutlet?
- * doc tree*?
- * there's confusion about where .so files place their names upon load:
- * cload uses (outlet (curlet))?? xg/xm use rootlet etc
- * ideally all would allow (load "a.so" (define *a* (inlet 'init_func 'init_a))) and the like
- * either we need settable (shadow-rootlet) or all should use curlet
- * (libm -> snd results in two versions of each??)
- * libgtk uses curlet which seems to work as intended
- * grepl:
- * grepl.scm for debugger.
- * libgl_s7.c to makegl
- * in gdb -- window showing text (via emacs?) and auto decode gdb output
- * in repl auto s7let? or begin-hook for that? or begin_hook for trace? symbol-access for set!
- * also on-going profile? room/gc stats? stacktrace?
- * added glistener commands: M-.
- * repl as break etc
- * in glistener, hover/select op, give doc string, var, highlight def? and box->inspect
- * as typed, run lint? or display op args, check types etc
- * if undef name, search libs and give correct/closest?
* libgtk:
* callback funcs need calling check -- 5 list as fields of c-pointer?
* several more special funcs
- * include gtkex1 somewhere with instructions and gtkex.scm
*
- * --------------------------------------------------------------------
+ * test opt_sizes escape in sort et al -- perhaps save sc->envir, make sure it is ok if optimize fails
+ * opt let? opt_float_begin in s7_float_optimize for map-channel in snd?
+ * check glob/libc.scm in openbsd -- some problem loading libc_s7.so (it works in snd, not in repl?)
+ * libc needs many type checks
+ * is_type replacing is_symbol etc [all_x_is_*_s if_is_* safe_is_*]
+ * is_type_car|cdr|a in all 3 cases
+ * need symbol->type-checker-recog->type -- symbol_type: object.sym.type
+ * maybe pass \u... through in read_constant_string unchanged, or read in s7?? no worse than \x..;
+ *
+ * immutable sequence as bit 25? == elements can't be set, immutable let=no slot added/deleted, so values changed
+ * then immutable-let access->offsets (type?), auto-copy-on-write? or (constant-copied ...)?
+ * currently the define-constant cases are inconsistent
+ * slot-setter, symbol-setter, let-setter?
+ * (define fnc (let ((setter...)) (lambda ...))) (define lt (let ((setter (lambda..))) (inlet...)))? -- and all the others like documentation/tester
+ * but where is this outlet saved esp. if vector? for let, a new union.
+ * vect get/set should be s7_function (multi-dim indices for example)
+ * string a new union as long as not associated with symbol, hash-table has extensible dproc
+ * pair can use opt fields, c_pointer has room already, immutable slot can use expr/pending_value
+ * so no problem at the s7_cell level, how to handle (eg) (let ((lt (let ((setter (lambda...))) (proc-creates-let...))))...)
+ * but how to access these?
+ * (define str (let ((documentation "a string")) "asdf")) -- (documentation str) is not in curlet
+ * and how to recognize immutable values/symbols/bindings etc?
+ * (define x (let ((documentation "help for x")) (* pi 3))) -- there is room for this but it's currently the number print name
+ * add constant = set completely-immutable-value bit, but since callable anytime, every seq-set always has to check it
+ * literator for lambda?
+ * c_object type table entries should also be s7_function, reported by object->let perhaps
+ * wrappers in the meantime?
+ *
+ * symbol 8-bits->cycling number, let tracks range? inserts ordered? [see above]
+ * could opt recognize large heavily-used lets and use this?
+ *
+ * ex lint for specific ques: turn off lint-format, seek all calls of f global|local|with a specific arg etc
+ * (requires lint on set of files, then specialize report-usage)
+ * does this give who-calls?
+ * or change to new call, reporting changes etc
+ *
+ * ----------------------------------------------------------------------------
*
- * 12 | 13 | 14 | 15 || 16 | 17.4 17.5 17.6 17.7
- * tmac | | | || 9052 | 615 259 261
- * index 44.3 | 3291 | 1725 | 1276 || 1255 | 1158 1111 1058
- * tref | | | 2372 || 2125 | 1375 1231 1125
- * tauto 265 | 89 | 9 | 8.4 || 2993 | 3255 3254 1772
- * teq | | | 6612 || 2777 | 2129 1978 1988
- * s7test 1721 | 1358 | 995 | 1194 || 2926 | 2645 2356 2215
- * tlet 5318 | 3701 | 3712 | 3700 || 4006 | 3616 2527 2436
- * lint | | | || 4041 | 3376 3114 3003
- * lg | | | || 211 | 161 149 143.9
- * tcopy | | | 13.6 || 3183 | 3404 3229 3092
- * tform | | | 6816 || 3714 | 3530 3361 3295
- * tmap | | | 9.3 || 5279 | 3939 3387
- * tfft | | 15.5 | 16.4 || 17.3 | 4901 4008 3963
- * tsort | | | || 8584 | 4869 4080 4010
- * titer | | | || 5971 | 5224 4768 4707
- * thash | | | 50.7 || 8778 | 8488 8057 7550
- * tgen | 71 | 70.6 | 38.0 || 12.6 | 12.4 12.6 11.7
- * bench | | | || 17.3 | 15.7 15.4 14.6
- * tall 90 | 43 | 14.5 | 12.7 || 17.9 | 20.4 18.6 17.7
- * calls 359 | 275 | 54 | 34.7 || 43.7 | 42.5 41.1 39.7
- * || 145 | 135 132 93.2
+ * 12 | 13 | 14 | 15 || 16 | 17.4 17.5 17.6 17.7 17.8
+ * tmac | | | || 9052 | 615 259 261 261
+ * index 44.3 | 3291 | 1725 | 1276 || 1255 | 1158 1111 1058 1053
+ * tref | | | 2372 || 2125 | 1375 1231 1125 1109
+ * tauto 265 | 89 | 9 | 8.4 || 2993 | 3255 3254 1772 1378
+ * teq | | | 6612 || 2777 | 2129 1978 1988 1921
+ * s7test 1721 | 1358 | 995 | 1194 || 2926 | 2645 2356 2215 2172
+ * tlet 5318 | 3701 | 3712 | 3700 || 4006 | 3616 2527 2436 2436
+ * lint | | | || 4041 | 3376 3114 3003 2726
+ * lg | | | || 211 | 161 149 144 134.9
+ * tform | | | 6816 || 3714 | 3530 3361 3295 2746
+ * tcopy | | | 13.6 || 3183 | 3404 3229 3092 3071
+ * tmap | | | 9.3 || 5279 | 3939 3387 3386
+ * tfft | | 15.5 | 16.4 || 17.3 | 4901 4008 3963 3964
+ * tsort | | | || 8584 | 4869 4080 4010 4012
+ * titer | | | || 5971 | 5224 4768 4707 4562
+ * bench | | | || 7012 | 6378 6327 5934 5106
+ * thash | | | 50.7 || 8778 | 8488 8057 7550 7537
+ * tgen | 71 | 70.6 | 38.0 || 12.6 | 12.4 12.6 11.7 11.9
+ * tall 90 | 43 | 14.5 | 12.7 || 17.9 | 20.4 18.6 17.7 17.8
+ * calls 359 | 275 | 54 | 34.7 || 43.7 | 42.5 41.1 39.7 39.4
+ * || 145 | 135 132 93.2 89.4
*
- * --------------------------------------------------------------------
- * safe lets saved across calls gains nothing! ~/old/has-olets(2)-s7.c.
+ * ----------------------------------------------------------------------------
*/
diff --git a/s7.h b/s7.h
index 9c1182a..892fb45 100644
--- a/s7.h
+++ b/s7.h
@@ -1,8 +1,8 @@
#ifndef S7_H
#define S7_H
-#define S7_VERSION "5.8"
-#define S7_DATE "28-July-17"
+#define S7_VERSION "5.9"
+#define S7_DATE "3-Aug-17"
#include <stdint.h> /* for int64_t */
@@ -368,22 +368,7 @@ void s7_display(s7_scheme *sc, s7_pointer obj, s7_pointer port); /* (
const char *s7_format(s7_scheme *sc, s7_pointer args); /* (format ... */
-bool s7_is_procedure(s7_pointer x); /* (procedure? x) */
-bool s7_is_macro(s7_scheme *sc, s7_pointer x); /* (macro? x) */
-s7_pointer s7_closure_body(s7_scheme *sc, s7_pointer p);
-s7_pointer s7_closure_let(s7_scheme *sc, s7_pointer p);
-s7_pointer s7_closure_args(s7_scheme *sc, s7_pointer p);
-s7_pointer s7_funclet(s7_scheme *sc, s7_pointer p); /* (funclet x) */
-const char *s7_procedure_documentation(s7_scheme *sc, s7_pointer p); /* (procedure-documentation x) if any (don't free the string) */
-s7_pointer s7_make_signature(s7_scheme *sc, int32_t len, ...); /* procedure-signature data */
-s7_pointer s7_make_circular_signature(s7_scheme *sc, int32_t cycle_point, int32_t len, ...);
-bool s7_is_aritable(s7_scheme *sc, s7_pointer x, int32_t args); /* (aritable? x args) */
-s7_pointer s7_arity(s7_scheme *sc, s7_pointer x); /* (arity x) */
-const char *s7_help(s7_scheme *sc, s7_pointer obj); /* (help obj) */
-s7_pointer s7_make_continuation(s7_scheme *sc); /* call/cc... (see example below) */
-
-
-bool s7_is_syntax(s7_pointer p);
+bool s7_is_syntax(s7_pointer p); /* (syntax? p) */
bool s7_is_symbol(s7_pointer p); /* (symbol? p) */
const char *s7_symbol_name(s7_pointer p); /* (symbol->string p) -- don't free the string */
s7_pointer s7_make_symbol(s7_scheme *sc, const char *name); /* (string->symbol name) */
@@ -401,7 +386,6 @@ s7_pointer s7_slot_value(s7_pointer slot);
s7_pointer s7_slot_set_value(s7_scheme *sc, s7_pointer slot, s7_pointer value);
s7_pointer s7_make_slot(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value);
-
s7_pointer s7_rootlet(s7_scheme *sc); /* (rootlet) */
s7_pointer s7_shadow_rootlet(s7_scheme *sc);
s7_pointer s7_set_shadow_rootlet(s7_scheme *sc, s7_pointer let);
@@ -444,6 +428,8 @@ bool s7_for_each_symbol(s7_scheme *sc, bool (*symbol_func)(const char *symbol_na
* The for-each loop stops if the symbol_func returns true, or at the end of the table.
*/
+s7_pointer s7_dynamic_wind(s7_scheme *sc, s7_pointer init, s7_pointer body, s7_pointer finish);
+
void s7_define(s7_scheme *sc, s7_pointer env, s7_pointer symbol, s7_pointer value);
bool s7_is_defined(s7_scheme *sc, const char *name);
@@ -468,18 +454,30 @@ bool s7_is_constant(s7_pointer p);
*/
bool s7_is_function(s7_pointer p);
+bool s7_is_procedure(s7_pointer x); /* (procedure? x) */
+bool s7_is_macro(s7_scheme *sc, s7_pointer x); /* (macro? x) */
+s7_pointer s7_closure_body(s7_scheme *sc, s7_pointer p);
+s7_pointer s7_closure_let(s7_scheme *sc, s7_pointer p);
+s7_pointer s7_closure_args(s7_scheme *sc, s7_pointer p);
+s7_pointer s7_funclet(s7_scheme *sc, s7_pointer p); /* (funclet x) */
+bool s7_is_aritable(s7_scheme *sc, s7_pointer x, int32_t args); /* (aritable? x args) */
+s7_pointer s7_arity(s7_scheme *sc, s7_pointer x); /* (arity x) */
+const char *s7_help(s7_scheme *sc, s7_pointer obj); /* (help obj) */
+s7_pointer s7_make_continuation(s7_scheme *sc); /* call/cc... (see example below) */
-s7_pointer s7_make_function(s7_scheme *sc, const char *name, s7_function fnc,
- int32_t required_args, int32_t optional_args, bool rest_arg, const char *doc);
-s7_pointer s7_make_safe_function(s7_scheme *sc, const char *name, s7_function fnc,
- int32_t required_args, int32_t optional_args, bool rest_arg, const char *doc);
+const char *s7_procedure_documentation(s7_scheme *sc, s7_pointer p); /* (procedure-documentation x) if any (don't free the string) */
+s7_pointer s7_procedure_setter(s7_scheme *sc, s7_pointer obj);
+s7_pointer s7_procedure_signature(s7_scheme *sc, s7_pointer func);
+s7_pointer s7_make_signature(s7_scheme *sc, int32_t len, ...); /* procedure-signature data */
+s7_pointer s7_make_circular_signature(s7_scheme *sc, int32_t cycle_point, int32_t len, ...);
+
+s7_pointer s7_make_function(s7_scheme *sc, const char *name, s7_function fnc, int32_t required_args, int32_t optional_args, bool rest_arg, const char *doc);
+s7_pointer s7_make_safe_function(s7_scheme *sc, const char *name, s7_function fnc, int32_t required_args, int32_t optional_args, bool rest_arg, const char *doc);
s7_pointer s7_make_typed_function(s7_scheme *sc, const char *name, s7_function f,
int32_t required_args, int32_t optional_args, bool rest_arg, const char *doc, s7_pointer signature);
-s7_pointer s7_define_function(s7_scheme *sc, const char *name, s7_function fnc,
- int32_t required_args, int32_t optional_args, bool rest_arg, const char *doc);
-s7_pointer s7_define_safe_function(s7_scheme *sc, const char *name, s7_function fnc,
- int32_t required_args, int32_t optional_args, bool rest_arg, const char *doc);
+s7_pointer s7_define_function(s7_scheme *sc, const char *name, s7_function fnc, int32_t required_args, int32_t optional_args, bool rest_arg, const char *doc);
+s7_pointer s7_define_safe_function(s7_scheme *sc, const char *name, s7_function fnc, int32_t required_args, int32_t optional_args, bool rest_arg, const char *doc);
s7_pointer s7_define_typed_function(s7_scheme *sc, const char *name, s7_function fnc,
int32_t required_args, int32_t optional_args, bool rest_arg,
const char *doc, s7_pointer signature);
@@ -492,13 +490,6 @@ s7_pointer s7_make_safe_function_star(s7_scheme *sc, const char *name, s7_functi
void s7_define_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc);
void s7_define_safe_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc);
void s7_define_typed_function_star(s7_scheme *sc, const char *name, s7_function fnc, const char *arglist, const char *doc, s7_pointer signature);
-s7_pointer s7_apply_function_star(s7_scheme *sc, s7_pointer fnc, s7_pointer args);
-
-void s7_define_function_with_setter(s7_scheme *sc, const char *name, s7_function get_fnc,
- s7_function set_fnc, int32_t req_args, int32_t opt_args, const char *doc);
- /* this is now the same as s7_dilambda (different args) */
-
-s7_pointer s7_apply_function(s7_scheme *sc, s7_pointer fnc, s7_pointer args);
s7_pointer s7_define_macro(s7_scheme *sc, const char *name, s7_function fnc, int32_t required_args, int32_t optional_args, bool rest_arg, const char *doc);
/* s7_make_function creates a Scheme function object from the s7_function 'fnc'.
@@ -554,6 +545,9 @@ s7_pointer s7_define_macro(s7_scheme *sc, const char *name, s7_function fnc, int
* for C-level functions (as well as optional/rest arguments).
*/
+s7_pointer s7_apply_function(s7_scheme *sc, s7_pointer fnc, s7_pointer args);
+s7_pointer s7_apply_function_star(s7_scheme *sc, s7_pointer fnc, s7_pointer args);
+
s7_pointer s7_call(s7_scheme *sc, s7_pointer func, s7_pointer args);
s7_pointer s7_call_with_location(s7_scheme *sc, s7_pointer func, s7_pointer args, const char *caller, const char *file, int32_t line);
@@ -566,8 +560,10 @@ s7_pointer s7_call_with_location(s7_scheme *sc, s7_pointer func, s7_pointer args
*
* s7_call_with_location passes some information to the error handler.
*/
-s7_pointer s7_dynamic_wind(s7_scheme *sc, s7_pointer init, s7_pointer body, s7_pointer finish);
+void s7_define_function_with_setter(s7_scheme *sc, const char *name, s7_function get_fnc,
+ s7_function set_fnc, int32_t req_args, int32_t opt_args, const char *doc);
+ /* this is now the same as s7_dilambda (different args) */
bool s7_is_dilambda(s7_pointer obj);
s7_pointer s7_dilambda(s7_scheme *sc,
@@ -586,16 +582,52 @@ s7_pointer s7_typed_dilambda(s7_scheme *sc,
const char *documentation,
s7_pointer get_sig, s7_pointer set_sig);
-s7_pointer s7_procedure_setter(s7_scheme *sc, s7_pointer obj);
-s7_pointer s7_procedure_signature(s7_scheme *sc, s7_pointer func);
s7_pointer s7_values(s7_scheme *sc, s7_pointer args);
+
s7_pointer s7_make_iterator(s7_scheme *sc, s7_pointer e);
bool s7_is_iterator(s7_pointer obj);
bool s7_iterator_is_at_end(s7_scheme *sc, s7_pointer obj);
s7_pointer s7_iterate(s7_scheme *sc, s7_pointer iter);
- /* ancient form -- backwards compatibility */
-int32_t s7_new_type(const char *name,
+void s7_autoload_set_names(s7_scheme *sc, const char **names, int32_t size);
+
+s7_pointer s7_copy(s7_scheme *sc, s7_pointer args);
+s7_pointer s7_fill(s7_scheme *sc, s7_pointer args);
+s7_pointer s7_type_of(s7_pointer arg);
+
+
+
+/* -------------------------------------------------------------------------------- */
+/* c types/objects */
+
+bool s7_is_c_object(s7_pointer p);
+int32_t s7_c_object_type(s7_pointer obj);
+void *s7_c_object_value(s7_pointer obj);
+void *s7_c_object_value_checked(s7_pointer obj, int32_t type);
+s7_pointer s7_make_c_object(s7_scheme *sc, int32_t type, void *value);
+s7_pointer s7_make_c_object_with_let(s7_scheme *sc, int32_t type, void *value, s7_pointer let);
+void s7_mark_c_object(s7_pointer p);
+s7_pointer s7_c_object_let(s7_pointer obj);
+s7_pointer s7_c_object_set_let(s7_pointer obj, s7_pointer e);
+
+int32_t s7_make_c_type(s7_scheme *sc, const char *name);
+void s7_c_type_set_print (s7_scheme *sc, int32_t tag, char *(*print)(s7_scheme *sc, void *value));
+void s7_c_type_set_print_readably(s7_scheme *sc, int32_t tag, char *(*printer)(s7_scheme *sc, void *val));
+void s7_c_type_set_free (s7_scheme *sc, int32_t tag, void (*gc_free)(void *value));
+void s7_c_type_set_equal (s7_scheme *sc, int32_t tag, bool (*equal)(void *val1, void *val2));
+void s7_c_type_set_mark (s7_scheme *sc, int32_t tag, void (*gc_mark)(void *val));
+void s7_c_type_set_apply (s7_scheme *sc, int32_t tag, s7_pointer (*ref)(s7_scheme *sc, s7_pointer obj, s7_pointer args));
+void s7_c_type_set_apply_direct (s7_scheme *sc, int32_t tag, s7_pointer (*dref)(s7_scheme *sc, s7_pointer obj, s7_int index));
+void s7_c_type_set_set (s7_scheme *sc, int32_t tag, s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args));
+void s7_c_type_set_set_direct (s7_scheme *sc, int32_t tag, s7_pointer (*dset)(s7_scheme *sc, s7_pointer obj, s7_int index, s7_pointer val));
+void s7_c_type_set_length (s7_scheme *sc, int32_t tag, s7_pointer (*length)(s7_scheme *sc, s7_pointer obj));
+void s7_c_type_set_copy (s7_scheme *sc, int32_t tag, s7_pointer (*copy)(s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_fill (s7_scheme *sc, int32_t tag, s7_pointer (*fill)(s7_scheme *sc, s7_pointer args));
+void s7_c_type_set_reverse (s7_scheme *sc, int32_t tag, s7_pointer (*reverse)(s7_scheme *sc, s7_pointer args));
+
+
+#if (!DISABLE_DEPRECATED)
+int32_t s7_new_type(const char *name,
char *(*print)(s7_scheme *sc, void *value),
void (*free)(void *value),
bool (*equal)(void *val1, void *val2),
@@ -603,7 +635,6 @@ int32_t s7_new_type(const char *name,
s7_pointer (*apply)(s7_scheme *sc, s7_pointer obj, s7_pointer args),
s7_pointer (*set)(s7_scheme *sc, s7_pointer obj, s7_pointer args));
- /* new form */
int32_t s7_new_type_x(s7_scheme *sc,
const char *name,
char *(*print)(s7_scheme *sc, void *value),
@@ -617,16 +648,21 @@ int32_t s7_new_type_x(s7_scheme *sc,
s7_pointer (*reverse)(s7_scheme *sc, s7_pointer obj),
s7_pointer (*fill)(s7_scheme *sc, s7_pointer args));
-bool s7_is_object(s7_pointer p);
-int32_t s7_object_type(s7_pointer obj);
-void *s7_object_value(s7_pointer obj);
-void *s7_object_value_checked(s7_pointer obj, int32_t type);
-s7_pointer s7_make_object(s7_scheme *sc, int32_t type, void *value);
-s7_pointer s7_make_object_with_let(s7_scheme *sc, int32_t type, void *value, s7_pointer let);
-void s7_mark_object(s7_pointer p);
-s7_pointer s7_object_let(s7_pointer obj);
-s7_pointer s7_object_set_let(s7_pointer obj, s7_pointer e);
-void s7_set_object_print_readably(int32_t type, char *(*printer)(s7_scheme *sc, void *val));
+void s7_object_type_set_direct(int32_t tag,
+ s7_pointer (*dref)(s7_scheme *sc, s7_pointer obj, s7_int index),
+ s7_pointer (*dset)(s7_scheme *sc, s7_pointer obj, s7_int index, s7_pointer val));
+
+#define s7_is_object s7_is_c_object
+#define s7_object_type s7_c_object_type
+#define s7_object_value s7_c_object_value
+#define s7_object_value_checked s7_c_object_value_checked
+#define s7_make_object s7_make_c_object
+#define s7_make_object_with_let s7_make_c_object_with_let
+#define s7_mark_object s7_mark_c_object
+#define s7_object_let s7_c_object_let
+#define s7_object_set_let s7_c_object_set_let
+#define s7_set_object_print_readably s7_c_type_set_print_readably
+#endif
/* These functions create a new Scheme object type. There is a simple example in s7.html.
*
@@ -650,23 +686,15 @@ void s7_set_object_print_readably(int32_t type, char *(*printer)(s7_scheme *sc,
*
* s7_new_type and s7_new_typ_x return an integer that identifies the new type for the other functions.
*
- * s7_is_object returns true if 'p' holds a value of a type created by s7_new_type.
- * s7_object_type returns the object's type
- * s7_object_value returns the value bound to that object (the void *value of s7_make_object)
- * s7_make_object creates a new Scheme entity of the given type with the given (uninterpreted) value
- * s7_mark_object marks any Scheme object as in-use (use this in the gc_mark function to mark
+ * s7_is_c_object returns true if 'p' holds a value of a type created by s7_new_type.
+ * s7_c_object_type returns the c_object's type
+ * s7_c_object_value returns the value bound to that c_object (the void *value of s7_make_c_object)
+ * s7_make_c_object creates a new Scheme entity of the given type with the given (uninterpreted) value
+ * s7_mark_c_object marks any Scheme c_object as in-use (use this in the gc_mark function to mark
* any embedded s7_pointer variables).
*/
-void s7_autoload_set_names(s7_scheme *sc, const char **names, int32_t size);
-
-s7_pointer s7_copy(s7_scheme *sc, s7_pointer args);
-s7_pointer s7_fill(s7_scheme *sc, s7_pointer args);
-
-s7_pointer s7_type_of(s7_pointer arg);
-
-
/* -------------------------------------------------------------------------------- */
/* the new clm optimizer! this time for sure!
* d=double, i=integer, v=c_object, p=s7_pointer
@@ -771,10 +799,6 @@ s7_d_pi_t s7_d_pi_function(s7_pointer f);
/* -------------------------------------------------------------------------------- */
-/* these are possibly temporary */
-void s7_object_type_set_direct(int32_t tag,
- s7_pointer (*dref)(s7_scheme *sc, s7_pointer obj, s7_int index),
- s7_pointer (*dset)(s7_scheme *sc, s7_pointer obj, s7_int index, s7_pointer val));
void s7_slot_set_real_value(s7_scheme *sc, s7_pointer slot, s7_double value);
@@ -857,6 +881,7 @@ s7_pointer s7_apply_n_9(s7_scheme *sc, s7_pointer args,
*
* s7 changes
*
+ * 3-Aug: object->c_object name changes.
* 28-Jul: s7_make_c_pointer_with_type and s7_c_pointer_type.
* 24-Jul: int64_t rather than long long int, and various related changes.
* 18-Jul: s7_make_object_with_let.
diff --git a/s7.html b/s7.html
index e8fc341..48dff79 100644
--- a/s7.html
+++ b/s7.html
@@ -2806,7 +2806,7 @@ such as abs, we need to put it back to its original form:
</blockquote>
-<p><b>openlet</b> marks its argument, either an environment, a closure, or a c-object
+<p><b>openlet</b> marks its argument, either an environment, a closure, a c-object, or a c-pointer
as open. I need better terminology here! An open object is one that the
built-in s7 functions handle specially. If they encounter one in their
argument list, they look in the object for their own name, and call that
@@ -2859,7 +2859,7 @@ is intended as a debugging aid, underlying a debugger's "inspect" for example.
<em class="gray">(inlet 'value #&lt;iterator: string&gt; 'type iterator? 'at-end #f 'sequence "1234" 'length 4 'position 2)</em>
</pre>
-<p>A c-object (in the sense of s7_new_type), can add its own info to this namespace via an object-&gt;let
+<p>A c-object (in the sense of s7_make_c_type), can add its own info to this namespace via an object-&gt;let
method in its local environment. snd-marks.c has a simple example using a class-wide environment (g_mark_methods),
holding as the value of its 'object-&gt;let field the function s7_mark_to_let. The latter uses s7_varlet to
add information to the namespace created by <code>(object-&gt;let mark)</code>.
@@ -3810,7 +3810,6 @@ the current-output-port without returning the string (this mimics the other IO r
such as display and newline). Other built-in port choices are *stdout* and *stderr*.
</p>
-
<blockquote>
<div class="indented">
@@ -4123,7 +4122,7 @@ in its closure:
<pre class="indented">
&gt; (define f1 (let ((procedure-documentation (lambda (f) "helpful info"))
(procedure-signature (lambda (f) '(boolean? real?))))
- (<em class=red>openlet</em>
+ (<em class=red>openlet</em> ; openlet alerts s7 that f1 has methods
(lambda (x)
(positive? x)))))
&gt; (procedure-documentation f1)
@@ -4146,11 +4145,37 @@ in its closure:
<p>but the optimizer currently doesn't know how to take advantage of this pattern.
</p>
-<p>openlet alerts s7 that f1 has methods.
+<p>You can obviously add your own methods:
</p>
+
+<pre class="indented">
+(define my-add
+ (let ((<em class="red">tester</em> (lambda ()
+ (if (not (= (my-add 2 3) 5))
+ (format #t "oops: (myadd 2 3) -&gt; ~A~%"
+ (my-add 2 3))))))
+ (lambda (x y)
+ (- x y))))
+
+(define (auto-test) ; scan the symbol table for procedures with testers
+ (let ((st (symbol-table)))
+ (for-each (lambda (f)
+ (let* ((fv (and (defined? f)
+ (symbol-&gt;value f)))
+ (testf (and (procedure? fv)
+ ((funclet fv) '<em class="red">tester</em>))))
+ (when (procedure? testf) ; found one!
+ (testf))))
+ st)))
+
+&gt; (auto-test)
+<em class="gray">oops: (myadd 2 3) -&gt; -1</em>
+</pre>
+
<blockquote>
<br>
+
<details>
<summary class="indented">examples</summary>
<div class="indented">
@@ -5832,7 +5857,7 @@ autoloading? #t
history a circular buffer of recent eval entries stored backwards
catches a list of the currently active catch tags
exits a list of active call-with-exit exit functions
-c-types a list of c-object type names (from s7_new_type, etc)
+c-types a list of c-object type names (from s7_make_c_type, etc)
input-ports, output-ports, strings, gensyms, vectors, hash-tables, continuations
stack-top current stack location
@@ -5848,7 +5873,7 @@ free-heap-size the number of currently unused cells
gc-freed number of cells freed by the last GC pass
gc-protected-objects vector of the objects permanently protected from the GC
gc-stats #f (#t turns on printout of the GC activity)
-memory-usage a description of current memory allocations
+memory-usage a description of current memory allocations (sent to current-output-port)
</pre>
<p>
@@ -5887,21 +5912,47 @@ The boolean sets whether the entire output should be displayed as a comment.
The defaults are '(3 45 80 45 #t).
</p>
+<p>This will display s7 memory usage sort of like the top program:
+</p>
+<pre class="indented">
+(format *stderr* "~C[~D;~DH" #\escape 0 0)
+(format *stderr* "~C[J" #\escape)
+(display (with-output-to-string (lambda() (*s7* 'memory-usage))))
+</pre>
+<p>(Ideally we'd only redisplay the changed fields).
+</p>
+
<pre class="indented">
(<em class=def id="cobject">c-object?</em> obj)
(<em class=def id="cpointer">c-pointer?</em> obj)
-(<em class=def id="cpoint">c-pointer</em> int)
+(<em class=def id="cpoint">c-pointer</em> int type info)
</pre>
<p>
+c-object? returns the object's type tag (otherwise #f of course). This tag is also the position
+of the object's type in the (*s7* 'c-types) list.
+(*s7* 'c-types) returns a list of the types created by s7_make_c_type.
+</p>
+<p>
You can wrap up raw C pointers and
pass them around in s7 code. The function c-pointer returns a wrapped pointer,
and c-pointer? returns #t if passed one. <code>(define NULL (c-pointer 0))</code>.
-c-object? returns the object's type tag if passed such an object (otherwise #f of course). This tag is also the position
-of the object's type in the (*s7* 'c-types) list.
-(*s7* 'c-types) returns a list of the types created by s7_new_type_x and friends.
+If the type field is a symbol, it is used to check types in s7_c_pointer with_type.
+If the 'info field of a c-pointer is a let, that pointer can participate in
+the generic functions mechanism, much like a c-object:
</p>
-
+<pre class="indented">
+&gt; (let ((ptr (c-pointer 1 'abc
+ (inlet 'object-&gt;string
+ (lambda (obj . args)
+ (let ((lt (object-&gt;let obj)))
+ (format #f "I am pointer ~A of type '~A!"
+ (lt 'c-pointer) ; we need c-pointer-type etc
+ (lt 'c-type))))))))
+ (openlet ptr)
+ (object-&gt;string ptr))
+<em class="gray">"I am pointer 1 of type 'abc!"</em>
+</pre>
<div class="separator"></div>
@@ -6058,6 +6109,12 @@ Better ideas are always welcome!
</ul>
<p>__func__ is the name (or name and location) of the function currently being called, as in C.
+<code>(symbol_value __func__)</code> is the current function, so this innocuous looking code:
+</p>
+<pre>
+(define (func p) (call-with-output-string (symbol-&gt;value __func__)))
+</pre>
+<p>can produce an infinite recursion!
</p>
<p>Currently WITH_PURE_S7:
@@ -6574,6 +6631,17 @@ These symbols are not just an optimization of string comparison:
<em class="gray">1</em>
</pre>
+<p>Now we notice that <code>(case 0.0 ((0.0) 1) (else 0))</code> is 1, but
+how to get pi into a key list?
+</p>
+<pre class="indented">
+&gt; (apply case 'pi `(((,pi) 1) (else 0)))
+<em class="gray">1</em>
+&gt; (let ((lst '(1 2))) (apply case 'lst `(((,lst) 1) (else 0))))
+<em class="gray">1</em> ; same trick puts a list in the keys
+&gt; (apply case 'nan.0 `(((,nan.0) 1) (else 0)))
+<em class="gray">0</em> ; (eqv? nan.0 nan.0) is #f
+</pre>
<p><code>(apply define ...)</code> is similar to CL's set.
</p>
@@ -7551,7 +7619,7 @@ static bool equal_dax(void *val1, void *val2)
static void mark_dax(void *val)
{
dax *o = (dax *)val;
- if (o) s7_mark_object(o-&gt;data);
+ if (o) s7_mark_c_object(o-&gt;data);
}
static int dax_type_tag = 0;
@@ -7564,27 +7632,27 @@ static s7_pointer make_dax(s7_scheme *sc, s7_pointer args)
if (s7_cdr(args) != s7_nil(sc))
o-&gt;data = s7_cadr(args);
else o-&gt;data = s7_nil(sc);
- return(<em class=red>s7_make_object</em>(sc, dax_type_tag, (void *)o));
+ return(<em class=red>s7_make_c_object</em>(sc, dax_type_tag, (void *)o));
}
static s7_pointer is_dax(s7_scheme *sc, s7_pointer args)
{
return(s7_make_boolean(sc,
- <em class=red>s7_is_object</em>(s7_car(args)) &amp;&amp;
- <em class=red>s7_object_type</em>(s7_car(args)) == dax_type_tag));
+ <em class=red>s7_is_c_object</em>(s7_car(args)) &amp;&amp;
+ <em class=red>s7_c_object_type</em>(s7_car(args)) == dax_type_tag));
}
static s7_pointer dax_x(s7_scheme *sc, s7_pointer args)
{
dax *o;
- o = (dax *)<em class=red>s7_object_value</em>(s7_car(args));
+ o = (dax *)<em class=red>s7_c_object_value</em>(s7_car(args));
return(s7_make_real(sc, o-&gt;x));
}
static s7_pointer set_dax_x(s7_scheme *sc, s7_pointer args)
{
dax *o;
- o = (dax *)s7_object_value(s7_car(args));
+ o = (dax *)s7_c_object_value(s7_car(args));
o-&gt;x = s7_real(s7_cadr(args));
return(s7_cadr(args));
}
@@ -7592,14 +7660,14 @@ static s7_pointer set_dax_x(s7_scheme *sc, s7_pointer args)
static s7_pointer dax_data(s7_scheme *sc, s7_pointer args)
{
dax *o;
- o = (dax *)s7_object_value(s7_car(args));
+ o = (dax *)s7_c_object_value(s7_car(args));
return(o-&gt;data);
}
static s7_pointer set_dax_data(s7_scheme *sc, s7_pointer args)
{
dax *o;
- o = (dax *)s7_object_value(s7_car(args));
+ o = (dax *)s7_c_object_value(s7_car(args));
o-&gt;data = s7_cadr(args);
return(o-&gt;data);
}
@@ -7614,7 +7682,11 @@ int main(int argc, char **argv)
s7_define_variable(s7, "*listener-prompt*", s7_make_string(s7, "&gt;"));
- dax_type_tag = <em class=red>s7_new_type</em>("dax", print_dax, free_dax, equal_dax, mark_dax, NULL, NULL);
+ dax_type_tag = <em class=red>s7_make_c_type</em>(s7, "dax");
+ s7_c_type_set_print(s7, dax_type_tag, print_dax);
+ s7_c_type_set_free(s7, dax_type_tag, free_dax);
+ s7_c_type_set_equal(s7, dax_type_tag, equal_dax);
+ s7_c_type_set_mark(s7, dax_type_tag, mark_dax);
s7_define_function(s7, "make-dax", make_dax, 2, 0, false, "(make-dax x data) makes a new dax");
s7_define_function(s7, "dax?", is_dax, 1, 0, false, "(dax? anything) returns #t if its argument is a dax object");
diff --git a/s7test.scm b/s7test.scm
index c7e3e2a..986c12b 100644
--- a/s7test.scm
+++ b/s7test.scm
@@ -72,17 +72,23 @@
(define (string-copy str)
(if (string? str)
(copy str)
- (error 'wrong-type-arg "string-copy argument should be a string: ~A" str)))
+ (if (openlet? str)
+ ((let-ref str 'string-copy) str)
+ (error 'wrong-type-arg "string-copy argument should be a string: ~A" str))))
(define (string-length str)
(if (string? str)
(length str)
- (error 'wrong-type-arg "string-length argument should be a string: ~A" str)))
+ (if (openlet? str)
+ ((let-ref str 'string-length) str)
+ (error 'wrong-type-arg "string-length argument should be a string: ~A" str))))
(define (string-fill! str chr . args)
(if (string? str)
(apply fill! str chr args)
- (error 'wrong-type-arg "string-fill! argument should be a string: ~A" str)))
+ (if (openlet? str)
+ (apply (let-ref str 'string-fill!) str chr args)
+ (error 'wrong-type-arg "string-fill! argument should be a string: ~A" str))))
(define* (vector->list vect (start 0) end)
(if (and (vector? vect)
@@ -126,12 +132,16 @@
(define (exact? n)
(if (number? n)
(rational? n)
- (error 'wrong-type-arg "exact? argument should be a number: ~A" n)))
+ (if (openlet? n)
+ ((let-ref n 'exact?) n)
+ (error 'wrong-type-arg "exact? argument should be a number: ~A" n))))
(define (inexact? x)
(if (number? x)
(not (rational? x))
- (error 'wrong-type-arg "inexact? argument should be a number: ~A" x)))
+ (if (openlet? n)
+ ((let-ref n 'inexact?) n)
+ (error 'wrong-type-arg "inexact? argument should be a number: ~A" x))))
(define (inexact->exact x)
(if (not (number? x))
@@ -153,7 +163,9 @@
(if (and (positive? i)
(zero? (logand i (- i 1))))
1 0)))
- (error 'wrong-type-arg "integer-length argument should be an integer: ~A" x)))
+ (if (openlet? i)
+ ((let-ref i 'integer-length) i)
+ (error 'wrong-type-arg "integer-length argument should be an integer: ~A" x))))
(set! *#readers* (list (cons #\i (lambda (str) (* 1.0 (string->number (substring str 1)))))
(cons #\e (lambda (str) (floor (string->number (substring str 1)))))))
@@ -435,21 +447,21 @@ static s7_pointer g_make_block(s7_scheme *sc, s7_pointer args)
if (g->size > 0)
g->data = (double *)calloc(g->size, sizeof(double));
else g->data = NULL;
- new_g = s7_make_object(sc, g_block_type, (void *)g);
- s7_object_set_let(new_g, g_block_methods);
+ new_g = s7_make_c_object(sc, g_block_type, (void *)g);
+ s7_c_object_set_let(new_g, g_block_methods);
s7_openlet(sc, new_g);
return(new_g);
}
static s7_pointer g_to_block(s7_scheme *sc, s7_pointer args)
{
- #define g_block_help \"(block ...) returns a block object with the arguments as its contents.\"
+ #define g_block_help \"(block ...) returns a block c_object with the arguments as its contents.\"
s7_pointer p, b;
size_t i, len;
g_block *gb;
len = s7_list_length(sc, args);
b = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, len), s7_nil(sc)));
- gb = (g_block *)s7_object_value(b);
+ gb = (g_block *)s7_c_object_value(b);
for (i = 0, p = args; i < len; i++, p = s7_cdr(p))
gb->data[i] = s7_number_to_real(sc, s7_car(p));
return(b);
@@ -516,12 +528,12 @@ static void g_block_mark(void *val)
static s7_pointer g_is_block(s7_scheme *sc, s7_pointer args)
{
#define g_is_block_help \"(block? obj) returns #t if obj is a block.\"
- return(s7_make_boolean(sc, s7_object_type(s7_car(args)) == g_block_type));
+ return(s7_make_boolean(sc, s7_c_object_type(s7_car(args)) == g_block_type));
}
static s7_pointer g_block_ref(s7_scheme *sc, s7_pointer obj, s7_pointer args)
{
- g_block *g = (g_block *)s7_object_value(obj);
+ g_block *g = (g_block *)s7_c_object_value(obj);
size_t index;
s7_pointer ind;
if (s7_is_null(sc, args)) /* this is for an (obj) test */
@@ -536,12 +548,12 @@ static s7_pointer g_block_ref(s7_scheme *sc, s7_pointer obj, s7_pointer args)
index = (size_t)s7_integer(ind);
if (index < g->size)
return(s7_make_real(sc, g->data[index]));
- return(s7_out_of_range_error(sc, \"block-ref\", 2, ind, \"should be less than block length\"));
+ return(s7_out_of_range_error(sc, \"block-ref\", 1, ind, \"should be less than block length\"));
}
static s7_pointer g_block_set(s7_scheme *sc, s7_pointer obj, s7_pointer args)
{
- g_block *g = (g_block *)s7_object_value(obj);
+ g_block *g = (g_block *)s7_c_object_value(obj);
s7_int index;
if (!s7_is_integer(s7_car(args)))
return(s7_wrong_type_arg_error(sc, \"block-set!\", 1, s7_car(args), \"an integer\"));
@@ -551,27 +563,27 @@ static s7_pointer g_block_set(s7_scheme *sc, s7_pointer obj, s7_pointer args)
g->data[index] = s7_number_to_real(sc, s7_cadr(args));
return(s7_cadr(args));
}
- return(s7_out_of_range_error(sc, \"block-set\", 2, s7_car(args), \"should be less than block length\"));
+ return(s7_out_of_range_error(sc, \"block-set\", 1, s7_car(args), \"should be less than block length\"));
}
static s7_pointer block_direct_ref(s7_scheme *sc, s7_pointer obj, s7_int index)
{
g_block *g;
- g = (g_block *)s7_object_value(obj);
+ g = (g_block *)s7_c_object_value(obj);
return(s7_make_real(sc, g->data[index]));
}
static s7_pointer block_direct_set(s7_scheme *sc, s7_pointer obj, s7_int index, s7_pointer val)
{
g_block *g;
- g = (g_block *)s7_object_value(obj);
+ g = (g_block *)s7_c_object_value(obj);
g->data[index] = s7_number_to_real(sc, val);
return(val);
}
static s7_pointer g_block_length(s7_scheme *sc, s7_pointer obj)
{
- g_block *g = (g_block *)s7_object_value(obj);
+ g_block *g = (g_block *)s7_c_object_value(obj);
return(s7_make_integer(sc, g->size));
}
@@ -612,12 +624,12 @@ static s7_pointer g_block_copy(s7_scheme *sc, s7_pointer args)
size_t len;
int start = 0;
obj = s7_car(args);
- g = (g_block *)s7_object_value(obj);
+ g = (g_block *)s7_c_object_value(obj);
len = g->size;
if (s7_is_pair(s7_cdr(args)))
{
new_g = s7_cadr(args);
- if (s7_object_type(new_g) != g_block_type) /* fall back on the float-vector code using a wrapper */
+ if (s7_c_object_type(new_g) != g_block_type) /* fall back on the float-vector code using a wrapper */
{
int gc_loc;
s7_pointer v;
@@ -631,7 +643,7 @@ static s7_pointer g_block_copy(s7_scheme *sc, s7_pointer args)
len = get_start_and_end(sc, s7_cdr(args), &start, len);
}
else new_g = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, len), s7_nil(sc)));
- g1 = (g_block *)s7_object_value(new_g);
+ g1 = (g_block *)s7_c_object_value(new_g);
if (g1->size < len) len = g1->size;
memcpy((void *)(g1->data), (void *)(g->data + start), len * sizeof(double));
return(new_g);
@@ -646,17 +658,17 @@ static s7_pointer g_block_append(s7_scheme *sc, s7_pointer args)
for (i = 0, p = args; s7_is_pair(p); p = s7_cdr(p), i++)
{
g_block *g1;
- if (s7_object_type(s7_car(p)) != g_block_type)
+ if (s7_c_object_type(s7_car(p)) != g_block_type)
return(s7_wrong_type_arg_error(sc, \"block-append\", i, s7_car(p), \"a block\"));
- g1 = (g_block *)s7_object_value(s7_car(p));
+ g1 = (g_block *)s7_c_object_value(s7_car(p));
len += g1->size;
}
new_g = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, len), s7_nil(sc)));
- g = (g_block *)s7_object_value(new_g);
+ g = (g_block *)s7_c_object_value(new_g);
for (i = 0, p = args; s7_is_pair(p); p = s7_cdr(p))
{
g_block *g1;
- g1 = (g_block *)s7_object_value(s7_car(p));
+ g1 = (g_block *)s7_c_object_value(s7_car(p));
memcpy((void *)(g->data + i), (void *)(g1->data), g1->size * sizeof(double));
i += g1->size;
}
@@ -668,9 +680,9 @@ static s7_pointer g_block_reverse(s7_scheme *sc, s7_pointer args)
size_t i, j;
g_block *g, *g1;
s7_pointer new_g;
- g = (g_block *)s7_object_value(s7_car(args));
+ g = (g_block *)s7_c_object_value(s7_car(args));
new_g = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, g->size), s7_nil(sc)));
- g1 = (g_block *)s7_object_value(new_g);
+ g1 = (g_block *)s7_c_object_value(new_g);
for (i = 0, j = g->size - 1; i < g->size; i++, j--)
g1->data[i] = g->data[j];
return(new_g);
@@ -683,9 +695,9 @@ static s7_pointer g_block_reverse_in_place(s7_scheme *sc, s7_pointer args)
g_block *g;
s7_pointer obj;
obj = s7_car(args);
- if (s7_object_type(obj) != g_block_type)
+ if (s7_c_object_type(obj) != g_block_type)
return(s7_wrong_type_arg_error(sc, \"block-reverse!\", 0, obj, \"a block\"));
- g = (g_block *)s7_object_value(obj);
+ g = (g_block *)s7_c_object_value(obj);
if (g->size < 2) return(obj);
for (i = 0, j = g->size - 1; i < j; i++, j--)
{
@@ -706,7 +718,7 @@ static s7_pointer g_block_fill(s7_scheme *sc, s7_pointer args)
g_block *g;
obj = s7_car(args);
val = s7_cadr(args);
- g = (g_block *)s7_object_value(obj);
+ g = (g_block *)s7_c_object_value(obj);
fill_val = s7_number_to_real(sc, val);
len = g->size;
if (s7_is_pair(s7_cddr(args)))
@@ -733,12 +745,12 @@ static s7_pointer g_subblock(s7_scheme *sc, s7_pointer args)
int start = 0, new_len, i;
g_block *g, *g1;
obj = s7_car(args);
- if (s7_object_type(obj) != g_block_type)
+ if (s7_c_object_type(obj) != g_block_type)
return(s7_wrong_type_arg_error(sc, \"subblock\", 1, obj, \"a block\"));
- g = (g_block *)s7_object_value(obj);
+ g = (g_block *)s7_c_object_value(obj);
new_len = get_start_and_end(sc, args, &start, g->size);
new_g = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, new_len), s7_nil(sc)));
- g1 = (g_block *)s7_object_value(new_g);
+ g1 = (g_block *)s7_c_object_value(new_g);
memcpy((void *)(g1->data), (void *)(g->data + start), new_len * sizeof(double));
return(new_g);
}
@@ -899,12 +911,18 @@ void block_init(s7_scheme *sc)
{
s7_pointer cur_env;
cur_env = s7_outlet(sc, s7_curlet(sc));
- g_block_type = s7_new_type_x(sc, \"#<block>\",
- g_block_display, g_block_free,
- g_block_is_equal, g_block_mark,
- g_block_ref, g_block_set, g_block_length,
- g_block_copy, g_block_reverse, g_block_fill);
- s7_set_object_print_readably(g_block_type, g_block_display_readably);
+ g_block_type = s7_make_c_type(sc, \"#<block>\");
+ s7_c_type_set_print(sc, g_block_type, g_block_display);
+ s7_c_type_set_free(sc, g_block_type, g_block_free);
+ s7_c_type_set_equal(sc, g_block_type, g_block_is_equal);
+ s7_c_type_set_mark(sc, g_block_type, g_block_mark);
+ s7_c_type_set_apply(sc, g_block_type, g_block_ref);
+ s7_c_type_set_set(sc, g_block_type, g_block_set);
+ s7_c_type_set_length(sc, g_block_type, g_block_length);
+ s7_c_type_set_copy(sc, g_block_type, g_block_copy);
+ s7_c_type_set_reverse(sc, g_block_type, g_block_reverse);
+ s7_c_type_set_fill(sc, g_block_type, g_block_fill);
+ s7_c_type_set_print_readably(sc, g_block_type, g_block_display_readably);
s7_define_safe_function(sc, \"make-block\", g_make_block, 1, 0, false, g_make_block_help);
s7_define_safe_function(sc, \"block\", g_to_block, 0, 0, true, g_block_help);
s7_define_safe_function(sc, \"subblock\", g_subblock, 1, 0, true, g_subblock_help);
@@ -918,7 +936,8 @@ void block_init(s7_scheme *sc)
'append block-append \
'reverse! block-reverse!))\");
s7_gc_protect(sc, g_block_methods);
- s7_object_type_set_direct(g_block_type, block_direct_ref, block_direct_set);
+ s7_c_type_set_apply_direct(sc, g_block_type, block_direct_ref);
+ s7_c_type_set_set_direct(sc, g_block_type, block_direct_set);
s7_define_safe_function(sc, \"function-open-output\", fout_open, 0, 0, false, \"\");
s7_define_safe_function(sc, \"function-get-output\", fout_get_output, 1, 0, false, \"\");
@@ -1336,6 +1355,15 @@ void block_init(s7_scheme *sc)
(test (c-pointer? (c-pointer (bignum "12341234"))) #t)
(test (c-pointer (bignum "1.4")) 'error))
+(let ((ptr (c-pointer 1 'abc (inlet 'object->string
+ (lambda (obj . args)
+ (let ((lt (object->let obj)))
+ (format #f "I am pointer ~A of type '~A!"
+ (lt 'c-pointer)
+ (lt 'c-type))))))))
+ (openlet ptr)
+ (test (object->string ptr) "I am pointer 1 of type 'abc!"))
+
(when with-block
(test (pair? (*s7* 'c-types)) #t))
@@ -3218,7 +3246,7 @@ void block_init(s7_scheme *sc)
(test (char? #\xff) #t)
;; any larger number is a reader error
-(test (eval-string "(char? #\xbdca2cbec)") 'error) ; this can overflow internally!
+;(test (eval-string "(char? #\xbdca2cbec)") 'error) ; this can overflow internally!
(test (eval-string "(char? #\\xbdca2cbec)") 'error)
(test (eval-string "(char? #\\100)") 'error)
(test (eval-string "(char? #\\x-65)") 'error)
@@ -4063,6 +4091,8 @@ void block_init(s7_scheme *sc)
(test (let ((str (string #\# #\\ #\t))) (string=? str "#\\t")) #t)
(test (string=? (string #\x (integer->char #xf0) #\x) (string #\x (integer->char #x70) #\x)) #f)
(test (string=? (string #\x (integer->char #xf0) #\x) (string #\x (integer->char #xf0) #\x)) #t)
+(test (string=? "\x65;\x65;" "ee") #t)
+(test (string=? "\"\\\n\t\r\/\b\f\x65;\"" "\x22;\x5c;\xa;\x09;\xd;\x2f;\x8;\xc;e\x22;") #t)
(test (string=? (string) "") #t)
(test (string=? (string) (make-string 0)) #t)
@@ -4088,7 +4118,7 @@ void block_init(s7_scheme *sc)
(test (let ((s1 "1234") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string=? s1 s2)) #t)
(test (let ((s1 "1234") (s2 "124")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string=? s1 s2)) #f)
(test (string=? (make-string 3 #\space) (let ((s (make-string 4 #\space))) (set! (s 3) #\null) s)) #f)
-(test "\x3012" "012")
+(test "\x3012;" "0\x12;") ; \x30 = 48 = #\0
(for-each
(lambda (arg)
@@ -4105,21 +4135,21 @@ void block_init(s7_scheme *sc)
(test (call-with-input-string "1\
2" (lambda (p) (read p))) 12)
-;; do we guarantee that read takes place in the current environment?
-(test (let ((xyzzy 32)) (call-with-input-string "xy\
-zzy" (lambda (p) (read p)))) 'xyzzy)
+;; do we guarantee that read takes place in the current environment? no...
+(test (call-with-input-string "fl\
+oor" read) 'floor)
-(test (let ((xyzzy 32)) (call-with-input-string "xy\
-zzy" (lambda (p) (eval (read p))))) 32)
+(test (call-with-input-string "p\
+i" (lambda (p) (eval (read p)))) pi)
-(test (let ((xyzzy 32)) (call-with-input-string "(set! xyzzy;\
+(test (call-with-input-string "(+ 1;\
this is presumably a comment
- 321)" (lambda (p) (eval (read p)))) xyzzy) 321)
+ 1)" (lambda (p) (eval (read p)))) 2)
-(test (let ((xyzzy 32)) (call-with-input-string "(set! xyzzy;\
+(test (call-with-input-string "(+ 1;\
this is presumably a comment;\
and more commentary
- 321)" (lambda (p) (eval (read p)))) xyzzy) 321)
+ 1)" (lambda (p) (eval (read p)))) 2)
@@ -4161,8 +4191,8 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((s1 "1234") (s2 "1245")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string<? s1 s2)) #t)
(test (let ((s1 "1234") (s2 "123")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string<? s1 s2)) #f)
(test (let ((s1 "123") (s2 "1234")) (string-set! s1 1 #\null) (string-set! s2 1 #\null) (string<? s1 s2)) #t)
-(test (not (string<? "foo\x0a" "foo\x0a")) #t)
-(test (string<? "foo\x0a" "foo\x0b") #t)
+(test (not (string<? "foo\x0a;" "foo\x0a;")) #t)
+(test (string<? "foo\x0a;" "foo\x0b;") #t)
(test (string<? (string (integer->char #xf0)) (string (integer->char #x70))) #f)
@@ -4616,7 +4646,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (string-length "\n\t") 2)
(test (string-length "#\newline") 8)
(test (string-length "#\tab") 4)
-(test (string-length "a\x00b") 3)
+(test (string-length "a\x00;b") 3)
(test (string-length "123\
456") 6)
@@ -4631,6 +4661,11 @@ zzy" (lambda (p) (eval (read p))))) 32)
(list #\a () (list 1) '(1 . 2) #f 'a-symbol (make-vector 3) abs _ht_ _null_ _c_obj_ quasiquote macroexpand 1/0 (log 0)
3.14 3/4 1.0+1.0i #t :hi (if #f #f) (lambda (a) (+ a 1))))
+;;; a couple more string constant cases
+(test (string? "[a-zA-Z_\x7f-\xff][a-zA-Z0-9_\x7f-\xff]*") #t)
+(test (format #f "\x7f~a" 1) (string #\delete #\1))
+(test (format #f "\x00~a\xff" 1) (string #\null #\1 #\xff))
+
;;; --------------------------------------------------------------------------------
@@ -4720,7 +4755,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (string-ref "hiho" (expt 2 32)) 'error)
(test (char=? (string-ref (string #\null) 0) #\null) #t)
(test (char=? (string-ref (string #\1 #\null #\2) 1) #\null) #t)
-(test (char=? ("1\x002" 1) #\null) #t)
+(test (char=? ("1\x002;" 1) #\null) #t)
(test (char=? (string-ref (string #\newline) 0) #\newline) #t)
(test (char=? (string-ref (string #\space) 0) #\space) #t)
@@ -4771,7 +4806,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (let ((hi (string-copy (make-string 8 (integer->char 0))))) (string-fill! hi #\a) hi) "aaaaaaaa") ; is this result widely accepted?
(test (string-copy (string-copy (string-copy "a"))) "a")
(test (string-copy (string-copy (string-copy ""))) "")
-(test (string-copy "a\x00b") "a\x00b") ; prints normally as "a" however
+(test (string-copy "a\x00;b") "a\x00;b") ; prints normally as "a" however
(test (string-copy (string #\1 #\null #\2)) (string #\1 #\null #\2))
(test (string-copy) 'error)
(test (string-copy "hi" "ho") 'error)
@@ -4924,7 +4959,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (string-downcase "\"\\\"") "\"\\\"")
(test (let ((hi "abc")) (eq? hi (string-downcase hi))) #f)
(test (string-downcase (string-upcase (string-downcase "a"))) "a")
-(test (string-downcase "a\x00b") "a\x00b")
+(test (string-downcase "a\x00;b") "a\x00;b")
(test (string-downcase (string #\1 #\null #\2)) (string #\1 #\null #\2))
(test (string-downcase) 'error)
(test (string-downcase "hi" "ho") 'error)
@@ -4936,7 +4971,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (string-upcase "\"\\\"") "\"\\\"")
(test (let ((hi "ABC")) (eq? hi (string-upcase hi))) #f)
(test (string-upcase (string-downcase (string-upcase "a"))) "A")
-(test (string-upcase "a\x00b") "A\x00B")
+(test (string-upcase "a\x00;b") "A\x00;B")
(test (string-upcase (string #\1 #\null #\2)) (string #\1 #\null #\2))
(test (string-upcase) 'error)
(test (string-upcase "hi" "ho") 'error)
@@ -5024,9 +5059,9 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (substring str 6) "6789")
(test (substring str 5 5) "")
(test (substring str 4 5) "4")
- (test (substring str 5 6) "\x00")
- (test (substring str 5 7) "\x006")
- (test (substring str 4 7) "4\x006"))
+ (test (substring str 5 6) "\x00;")
+ (test (substring str 5 7) "\x00;6")
+ (test (substring str 4 7) "4\x00;6"))
(for-each
(lambda (arg)
@@ -5266,6 +5301,9 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (list->string) 'error)
(test (string->list "hi" "ho") 'error)
(test (list->string () '(1 2)) 'error)
+(test (apply list->string '(#\a . #\b)) 'error)
+(test (list->string #\a . #\b) 'error)
+(test (let ((lst (cons #\a #\b))) (list->string lst)) 'error)
(test (string->list " hi ") '(#\space #\h #\i #\space))
(test (string->list (string (integer->char #xf0) (integer->char #x70))) (list (integer->char #xf0) (integer->char #x70)))
@@ -5290,7 +5328,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (str 1) #\space)
(test (str 2) #\null)
(test (str 3) #\x)
- (test (object->string str) "\"x \\x00x\"")
+ (test (object->string str) "\"x \\x00;x\"")
(let ((lst (string->list str)))
(test lst '(#\x #\space #\null #\x))))
@@ -5620,7 +5658,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ()
(apply define (list (symbol "(#)") 3))
- (test (eval (symbol "(#)")) 3))
+ (test (eval (symbol "(#)") (curlet)) 3))
(let ()
(define (immutable obj) (string->symbol (object->string obj :readable)))
@@ -6703,14 +6741,14 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (reverse "123") "321")
(test (reverse "1234") "4321")
(test (reverse "12") "21")
-(test (reverse "a\x00b") "b\x00a")
+(test (reverse "a\x00;b") "b\x00;a")
(test (reverse #()) #())
(test (reverse #(1)) #(1))
(test (reverse #(1 2)) #(2 1))
(test (reverse #(1 2 3)) #(3 2 1))
(test (reverse #(1 2 3 4)) #(4 3 2 1))
(test (reverse #2D((1 2) (3 4))) #2D((4 3) (2 1)))
-(test (reverse (string #\a #\null #\b)) "b\x00a")
+(test (reverse (string #\a #\null #\b)) "b\x00;a")
(test (reverse abs) 'error)
(test (vector->list (reverse (let ((v (make-int-vector 3))) (set! (v 1) 1) (set! (v 2) 2) v))) '(2 1 0))
(test (reverse (int-vector)) #())
@@ -11349,7 +11387,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(let ((acc1 (c?r (call-with-exit (lambda (return) . X))))
(acc2 (c?r (call-with-exit (lambda (return) (set! x (+ x 1)) (if (> x 10) (return x) 0) . X)))))
(set! (acc2 lst) (acc1 lst))
- (test (eval lst) 11))))
+ (test (eval lst (curlet)) 11))))
)
(let ()
@@ -12688,6 +12726,12 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (make-hash-table arg) 'error))
(list "hi" -1 0 #\a 'a-symbol #(1 2 3) 3.14 3/4 1.0+1.0i #t (list 1 2 3) '(1 . 2)))
+(let ((lst (list 1 2)))
+ (set-cdr! (cdr lst) lst)
+ (test (object->string (hash-table* 'a lst)) "(hash-table '(a . #1=(1 2 . #1#)))")
+ (test (object->string (hash-table* lst lst)) "(hash-table '(#1=(1 2 . #1#) . #1#))")
+ (test (object->string (hash-table* lst 1)) "(hash-table '(#1=(1 2 . #1#) . 1))"))
+
(let ()
(define ht (make-hash-table))
(set! (ht 123) "123")
@@ -13258,20 +13302,19 @@ zzy" (lambda (p) (eval (read p))))) 32)
(set! (ht "abc") 'abc)
(test (ht "abc") 'abc))
-(let ((h (make-hash-table 8 equal?)))
- (set! (h (make-int-vector 3 0)) 3)
- (test (h (make-int-vector 3 0)) 3)
- (test (h (make-vector 3 0)) #f)
- (test (h (make-float-vector 3 0)) #f)
- (let ((x 1.0)
- (y (+ 1.0 (* 0.5 (*s7* 'morally-equal-float-epsilon))))
- (z (+ 1.0 (* 2 (*s7* 'morally-equal-float-epsilon)))))
- (set! (h x) 12)
- (test (h x) 12)
- ;(test (h y) #f)
- ;(test (h z) #f)
- ;default vs explicit equal? here -- sigh
- ))
+(let-temporarily (((*s7* 'morally-equal-float-epsilon) 1e-15))
+ (let ((h (make-hash-table 8 equal?)))
+ (set! (h (make-int-vector 3 0)) 3)
+ (test (h (make-int-vector 3 0)) 3)
+ (test (h (make-vector 3 0)) #f)
+ (test (h (make-float-vector 3 0)) #f)
+ (let ((x 1.0)
+ (y (+ 1.0 (* 0.5 (*s7* 'morally-equal-float-epsilon))))
+ (z (+ 1.0 (* 1000 (*s7* 'morally-equal-float-epsilon))))) ; !
+ (set! (h x) 12)
+ (test (h x) 12)
+ (test (h y) 12)
+ (test (h z) #f))))
(let ((h (make-hash-table 8 morally-equal?)))
(set! (h (make-int-vector 3 0)) 3)
@@ -15135,17 +15178,15 @@ zzy" (lambda (p) (eval (read p))))) 32)
(format #t ";catch -> c/if -> error -> closed? ~A~%" port)
(close-input-port port)))))
-(test (with-output-to-string (lambda () (write (string (integer->char 4) (integer->char 8) (integer->char 20) (integer->char 30))))) "\"\\x04\\x08\\x14\\x1e\"")
-(test (string-length "\x04\x08\x14\x1e") 4)
-(test (char->integer (string-ref "\x0" 0)) 0)
-(test (char->integer (string-ref "\x0e" 0)) 14)
-(test (char->integer (string-ref "\x1e" 0)) 30)
-(test (char->integer (string-ref "\xff" 0)) 255)
-(test (string=?
- "\"\\x01\\x02\\x03\\x04\\x05\\x06\\x07\\x08\\x09x\\x0b\\x0c\\x0d\\x0e\\x0f\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f !\\\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\\x7f\\x80\\x81\\x82\\x83\\x84\\x85\\x86\\x87\\x88\\x89\\x8a\\x8b\\x8c\\x8d\\x8e\\x8f\\x90\\x91\\x92\\x93\\x94\\x95\\x96\\x97\\x98\\x99\\x9a\\x9b\\x9c\\x9d\\x9e\\x9f\\xa0¡¢£¤¥¦§¨©ª«¬\\xad®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ\"" "\"\\x01\\x02\\x03\\x04\\x05\\x06\\x07\\x08\\x09x\\x0b\\x0c\\x0d\\x0e\\x0f\\x10\\x11\\x12\\x13\\x14\\x15\\x16\\x17\\x18\\x19\\x1a\\x1b\\x1c\\x1d\\x1e\\x1f !\\\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\\x7f\\x80\\x81\\x82\\x83\\x84\\x85\\x86\\x87\\x88\\x89\\x8a\\x8b\\x8c\\x8d\\x8e\\x8f\\x90\\x91\\x92\\x93\\x94\\x95\\x96\\x97\\x98\\x99\\x9a\\x9b\\x9c\\x9d\\x9e\\x9f\\xa0¡¢£¤¥¦§¨©ª«¬\\xad®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ\"")
- #t)
-(test (string=? "\x61\x42\x63" "aBc") #t)
-
+(test (with-output-to-string (lambda () (write (string (integer->char 4) (integer->char 8) (integer->char 20) (integer->char 30))))) "\"\\x04;\\b\\x14;\\x1e;\"")
+(test (string-length "\x04;\x08;\x14;\x1e;") 4)
+(test (char->integer (string-ref "\x0;" 0)) 0)
+(test (char->integer (string-ref "\x0e;" 0)) 14)
+(test (char->integer (string-ref "\x1e;" 0)) 30)
+(test (char->integer (string-ref "\xff;" 0)) 255)
+(test (string=? "\x61;\x42;\x63;" "aBc") #t)
+(test (string=? "\"\\x01;\\x02;\\x03;\\x04;\\x05;\\x06;\\x07;\\x08;\\x09;x\\x0b;\\x0c;\\x0d;\\x0e;\\x0f;\\x10;\\x11;\\x12;\\x13;\\x14;\\x15;\\x16;\\x17;\\x18;\\x19;\\x1a;\\x1b;\\x1c;\\x1d;\\x1e;\\x1f; !\\\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\\x7f;\\x80;\\x81;\\x82;\\x83;\\x84;\\x85;\\x86;\\x87;\\x88;\\x89;\\x8a;\\x8b;\\x8c;\\x8d;\\x8e;\\x8f;\\x90;\\x91;\\x92;\\x93;\\x94;\\x95;\\x96;\\x97;\\x98;\\x99;\\x9a;\\x9b;\\x9c;\\x9d;\\x9e;\\x9f;\\xa0¡¢£¤¥¦§¨©ª«¬\\xad®¯°±²³´µ¶·¸¹º»¼½¾¿Ã\x80;Ã\x81;Ã\x82;Ã\x83;Ã\x84;Ã\x85;Ã\x86;Ã\x87;Ã\x88;Ã\x89;Ã\x8a;Ã\x8b;Ã\x8c;Ã\x8d;Ã\x8e;Ã\x8f;Ã\x90;Ã\x91;Ã\x92;Ã\x93;Ã\x94;Ã\x95;Ã\x96;Ã\x97;Ã\x98;Ã\x99;Ã\x9a;Ã\x9b;Ã\x9c;Ã\x9d;Ã\x9e;Ã\x9f;àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ\""
+ "\"\\x01;\\x02;\\x03;\\x04;\\x05;\\x06;\\x07;\\x08;\\x09;x\\x0b;\\x0c;\\x0d;\\x0e;\\x0f;\\x10;\\x11;\\x12;\\x13;\\x14;\\x15;\\x16;\\x17;\\x18;\\x19;\\x1a;\\x1b;\\x1c;\\x1d;\\x1e;\\x1f; !\\\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\\x7f;\\x80;\\x81;\\x82;\\x83;\\x84;\\x85;\\x86;\\x87;\\x88;\\x89;\\x8a;\\x8b;\\x8c;\\x8d;\\x8e;\\x8f;\\x90;\\x91;\\x92;\\x93;\\x94;\\x95;\\x96;\\x97;\\x98;\\x99;\\x9a;\\x9b;\\x9c;\\x9d;\\x9e;\\x9f;\\xa0¡¢£¤¥¦§¨©ª«¬\\xad®¯°±²³´µ¶·¸¹º»¼½¾¿Ã\x80;Ã\x81;Ã\x82;Ã\x83;Ã\x84;Ã\x85;Ã\x86;Ã\x87;Ã\x88;Ã\x89;Ã\x8a;Ã\x8b;Ã\x8c;Ã\x8d;Ã\x8e;Ã\x8f;Ã\x90;Ã\x91;Ã\x92;Ã\x93;Ã\x94;Ã\x95;Ã\x96;Ã\x97;Ã\x98;Ã\x99;Ã\x9a;Ã\x9b;Ã\x9c;Ã\x9d;Ã\x9e;Ã\x9f;àáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ\"") #t)
(when (provided? 'system-extras)
;; directory?
@@ -15279,7 +15320,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "") "")
(test (format #f "" 1) 'error)
(test (format #f "a") "a")
-;(test (format #f "a\x00b") "a")
+;(test (format #f "a\x00;b") "a")
(test (format #f "~~") "~") ; guile returns this, but clisp thinks it's an error
(test (format #f "~~~~") "~~")
@@ -15507,7 +15548,7 @@ zzy" (lambda (p) (eval (read p))))) 32)
(test (format #f "~C~c~C" #\a #\b #\c) "abc")
;(test (format #f "1 2~C 3 4" #\null) "1 2") ; ?? everyone does something different here
;; s7 used to return "1 2 3 4" because it treated ~C as a string (empty in this case)
-(test (format #f "1 2~C 3 4" #\null) "1 2\x00 3 4") ; this is also what Guile returns
+(test (format #f "1 2~C 3 4" #\null) "1 2\x00; 3 4")
(test (format #f "~nc" 3 #\a) "aaa")
(test (format #f "~nc" 0 #\a) "")
(test (format #f "~0c" #\a) "")
@@ -16054,10 +16095,10 @@ a2" 3) "132")
(test (string=? (format #f "~10,'*d" 100) "*******100") #t)
(test (string=? (format #f "~c" #\a) "a") #t)
(test (string=? (format #f "~c" #\space) " ") #t)
-(test (string=? (format #f "~C" #\x91) "\x91") #t)
-(test (string=? (format #f "~C" #\x9) "\x09") #t)
+(test (string=? (format #f "~C" #\x91) "\x91;") #t)
+(test (string=? (format #f "~C" #\x9) "\x09;") #t)
(test (string=? (format #f "~C" #\~) "~") #t)
-(test (string=? (format #f "~A" #\x91) "\x91") #t)
+(test (string=? (format #f "~A" #\x91) "\x91;") #t)
(test (string=? (format #f "~S" #\x91) "#\\x91") #t)
(test (string=? (format #f "~A" (string->symbol "hi")) "hi") #t)
(test (string=? (format #f "~S" (string->symbol "hi")) "hi") #t)
@@ -16118,7 +16159,7 @@ a2" 3) "132")
(list 1 1.0 #(1 2 3) '(1 2 3) '(1 . 2) () #f #t abs #<eof> #<unspecified> 'hi '\a))
(test (length (format #f "~S" (string #\\))) 4) ; "\"\\\\\""
(test (length (format #f "~S" (string #\a))) 3) ; "\"a\""
-(test (length (format #f "~S" (string #\null))) 6) ; "\"\\x00\""
+(test (length (format #f "~S" (string #\null))) 7) ; "\"\\x00;\""
(test (length (format #f "~S" (string (integer->char #xf0)))) 3) ; "\"ð\""
(test (length (format #f "~S" (string #\"))) 4) ; "\""
@@ -16171,7 +16212,7 @@ a2" 3) "132")
(test (format #f "~O" 1.0) "1.0")
(test (format #f "~P" 1.0) "")
(test (format #f "~P" '(1 2 3)) 'error)
-(test (format #f "~\x00T") 'error)
+(test (format #f "~\x00;T") 'error)
(test (format #f "~9,'(T") "((((((((")
(test (format #f "~0F" 1+1i) "1.000000+1.000000i")
(test (format #f "~9F" 1) " 1")
@@ -17686,8 +17727,6 @@ a2" 3) "132")
(test (list"0"0()#()#\a"""1"'x(list)+(cons"""")#f) (list "0" 0 () #() #\a "" "1" 'x (list) + '("" . "") #f))
(test (let ((x, 1)) x,) 1)
(test (length (eval-string (string #\' #\( #\1 #\space #\. (integer->char 200) #\2 #\)))) 2) ; will be -1 if dot is for improper list, 3 if dot is a symbol
-(test (eval-string "(list \\\x001)") 'error)
-(test (eval-string "(list \\\x00 1)") 'error)
(test (+ `,0(angle ```,`11)) 0)
(test (map . (char->integer "123")) '(49 50 51))
(test (map .(values "0'1")) '(#\0 #\' #\1))
@@ -18145,8 +18184,8 @@ so anything that quotes ` is not going to equal quote quasiquote
(test (object->string #\t #f) "t")
(test (object->string #\t) "#\\t")
-(test (object->string "a\x00b" #t) "\"a\\x00b\"")
-(test (object->string "a\x00b" #f) "a\x00b")
+(test (object->string "a\x00;b" #t) "\"a\\x00;b\"")
+(test (object->string "a\x00;b" #f) "a\x00;b")
(let-temporarily (((*s7* 'print-length) 3))
(test (object->string (inlet :a 1 :b 2 :c 3 :d 4)) "(inlet 'a 1 'b 2 'c 3 ...)")
@@ -19418,7 +19457,7 @@ c"
(test (for-each '(1 2 . 3) '(1 . 2)) #<unspecified>)
(test (for-each '(()) ()) #<unspecified>)
(test (for-each #2D((1 2) (3 4)) '(1)) #<unspecified>)
-(test (for-each "a\x00b" #(1 2)) #<unspecified>)
+(test (for-each "a\x00;b" #(1 2)) #<unspecified>)
(test (for-each #(1 (3)) '(1)) #<unspecified>)
(test (for-each '((1 (2)) (((3) 4))) '(1)) #<unspecified>)
(test (for-each "hi" '(1)) #<unspecified>)
@@ -19829,6 +19868,15 @@ c"
(test (apply append (map list '(a b #<eof> d))) '(a b #<eof> d))
(test (map values (vector 1 2 #<eof> 3)) '(1 2 #<eof> 3))
+(test (map (lambda (x) (set! x (* 2 x)) 2) '(1 2 3)) '(2 2 2))
+(test (map (lambda (x) x (set! x (* 2 x)) x) '(1 2 3)) '(2 4 6))
+(test (map (lambda (x) 1) '(1 2 3)) '(1 1 1))
+
+(test (let () (define (f) (map (let ((x 3)) (lambda (y) (+ x y))) '((x 1) (y . 2)))) (f)) 'error)
+(test (let () (define (f) (map (let ((x 3)) (lambda (y) (+ x y))) '(x 2))) (f)) 'error)
+(test (let () (define (f) (map (let ((x 3)) (lambda (y) (+ x y))) '(1 2))) (f)) '(4 5))
+(test (let () (define (f) (map (let ((x 3)) (let ((y 0)) (lambda (y) (+ x y)))) '(1 2))) (f)) '(4 5))
+
(test (let ((d 0))
(map (let ((a 0))
(map (lambda (b) (set! a (+ a b))) (list 1 2))
@@ -20174,7 +20222,7 @@ c"
(test (map '(1 2 . 3) '(1 . 2)) '(2))
(test (map '(()) ()) ())
(test (map #2D((1 2) (3 4)) '(1)) '(#(3 4)))
-(test (map "a\x00b" #(1 2)) '(#\null #\b))
+(test (map "a\x00;b" #(1 2)) '(#\null #\b))
(test (map #(1 (3)) '(1)) '((3)))
(test (map '((1 (2)) (((3) 4))) '(1)) '((((3) 4))))
(test (map "hi" '(1)) '(#\i))
@@ -20193,7 +20241,7 @@ c"
(test (map 0 #() ()) 'error)
(test (map #\a #(1 2) '(3 4) "") 'error)
(test (map or '(1 2 . 3)) '(1 2))
-(test (map or "a\x00b") '(#\a #\null #\b))
+(test (map or "a\x00;b") '(#\a #\null #\b))
(test (map cond '((1 2) (3 4))) '(2 4)) ; (cond (1 2)) -> 2
(test (map begin "hi") '(#\h #\i))
(test (map quote "hi") '(#\h #\i))
@@ -20204,14 +20252,14 @@ c"
(test (map (apply lambda 'a '(-1)) '(1 2)) '(-1 -1))
(test (map do '(()) '((1 2))) '(2)) ; (list 2) because it's map, not just do
(test (map case '(1) '(((-1 1) 2) 3)) '(2))
-(test (map let '(()) "a\x00b") '(#\a))
+(test (map let '(()) "a\x00;b") '(#\a))
(test (map "hi" '(0 1) '(0 1)) 'error)
(test (map '((1 2) (3 4)) '(0 1) '(0 1)) '(1 4))
(test (map #2d((1 2) (3 4)) '(0 1) '(0 1)) '(1 4))
(test (map #2d((1 2) (3 4)) '(0 1)) '(#(1 2) #(3 4)))
(let ((os (*s7* 'safety)))
(set! (*s7* 'safety) 1)
- (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (map (lambda (a) a) lst) '(1)))
+ (let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (map (lambda (a) a) lst) '(1 2 1)))
(let ((lst (list 1 2))) (set! (cdr (cdr lst)) lst) (test (map (lambda (a) a) lst lst) 'error))
(set! (*s7* 'safety) os))
(test (map "hi" ('((1)) 0)) '(#\i))
@@ -21374,6 +21422,9 @@ in s7:
(test (do ((a . 1) (b . 2)) () a) 'error)
(let () (define (d1) (do ((i 0 (+ i 1))) ((= i 3) . i) (display i))) (test (d1) 'error))
(let () (define (d1) (do ((i 0 (+ i 1))) ((= i 3) i) . i)) (test (d1) 'error))
+(test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1) i) ((0 1) ()))) (f)) 'error)
+(test (let () (define (f) (do ((i 0 (+ i 1))) ((= i 1) i) () (define-macro (_m1_ a) (list-values '+ a 1)))) (f)) 1)
+(test (let () (define (f) (do ((i 0 (+ i 1)) (j 0 (+ j 1))) ((= i 1) i) () (define-macro (_m1_ a) (list-values '+ a 1)))) (f)) 1)
(test (define-constant) 'error)
(test (define-constant _asdf_ 2 3) 'error)
@@ -21440,6 +21491,7 @@ in s7:
(num-test (let ((x 0)) (do ((i 1 4)) ((> i 3)) (set! x (+ x i))) x) 1)
(num-test (let ((x 0)) (do ((i 1 ((if #t + -) i 1))) ((> i 3)) (set! x (+ x i))) x) 6)
(num-test (let ((x 0)) (do ((i 1 (+))) ((> i 0)) (set! x (+ x i))) x) 0)
+(let () (define (f12345) (let ((x 0)) (do ((i 1 (+))) ((> i 0)) (set! x (+ x i))) x) 0) (f12345) (f12345))
(num-test (let ((x 0)) (do ((i 1 (+ 1))) ((> i 0)) (set! x (+ x i))) x) 0)
(num-test (let ((x 0)) (do ((i 1 (+ 1 i 2))) ((> i 10)) (set! x (+ x i))) x) 22)
(num-test (let ((x 0)) (do ((i 1 (+ 1.0 i))) ((> i 3)) (set! x (+ x i))) x) 6.0)
@@ -29935,6 +29987,27 @@ who says the continuation has to restart the map from the top?
(test (let ((x (list 1 2))) (catch #t (lambda () (catch x (lambda () (throw x)) (lambda args x))) (lambda () 'oops))) '(1 2))
+(let ()
+ (define (f)
+ (let ((val (catch #t (lambda () (throw 'oops)) (lambda args #f)))) (if val (format *stderr* "~A should be #f~%" val)))
+ (let ((val (catch #t (lambda () (throw 'oops)) (lambda args 'a)))) (if (not (eq? val 'a)) (format *stderr* "~A should be 'a~%" val)))
+ (let ((val (catch #t (lambda () (throw 'oops)) (lambda args (car args))))) (if (not (eq? val 'oops)) (format *stderr* "~A should be 'oops~%" val)))
+ (let ((val (catch #t (lambda () (throw 'oops)) (lambda args (+ 1 2))))) (if (not (= val 3)) (format *stderr* "~A should be 3~%" val)))
+ (let ((val (catch #t (lambda () (throw 'oops)) (lambda args args)))) (if (not (equal? val '(oops ()))) (format *stderr* "~A should be '(oops ())~%" val)))
+ (let ((val (catch #t (lambda () (throw 'oops)) (lambda (type info) type)))) (if (not (eq? val 'oops)) (format *stderr* "~A should be 'oops~%" val)))
+ (let ((val (catch #t (lambda () (throw 'oops)) (lambda (type info) info)))) (if (not (null? val)) (format *stderr* "~A should be ()~%" val)))
+ (let ((val (catch #t (lambda () (throw 'oops)) (lambda (type info) #f)))) (if val (format *stderr* "~A should be #f~%" val)))
+
+ (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda args #f)))) (if val (format *stderr* "oops ~A should be #f~%" val)))
+ (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda args 'a)))) (if (not (eq? val 'a)) (format *stderr* "oops ~A should be 'a~%" val)))
+ (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda args (car args))))) (if (not (eq? val 'oops)) (format *stderr* "oops ~A should be 'oops~%" val)))
+ (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda args (+ 1 2))))) (if (not (= val 3)) (format *stderr* "oops ~A should be 3~%" val)))
+ (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda args args)))) (if (not (equal? val '(oops ()))) (format *stderr* "oops ~A should be '(oops ())~%" val)))
+ (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda (type info) type)))) (if (not (eq? val 'oops)) (format *stderr* "oops ~A should be 'oops~%" val)))
+ (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda (type info) info)))) (if (not (null? val)) (format *stderr* "oops ~A should be ()~%" val)))
+ (let ((val (catch 'oops (lambda () (throw 'oops)) (lambda (type info) #f)))) (if val (format *stderr* "oops ~A should be #f~%" val))))
+ (f))
+
;;; various catch macros from s7.html
(let ()
(define-macro (catch-all . body)
@@ -32154,6 +32227,14 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (arity (let ((a 1)) (make-iterator (curlet)))) (cons 0 0))
(test (arity (random-state 123)) #f)
+(when with-block
+ (test (procedure? _c_obj_) #t)
+ (test (procedure-setter _c_obj_) #t)
+ (test (procedure-signature _c_obj_) #f)
+ (test (procedure-documentation _c_obj_) "")
+ (test (procedure-source _c_obj_) ())
+ (test (arity _c_obj_) (cons 0 *max-arity*))
+ (test (aritable? _c_obj_ 1) #t))
(define (for-each-subset func args)
@@ -32597,7 +32678,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature eqv?) (let ((L (list 'boolean? #t))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature vector-ref) (let ((L (list #t 'vector? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
(test (procedure-signature float-vector-set!) (let ((L (list 'real? 'float-vector? 'integer? 'integer:real?))) (set-cdr! (cdddr L) (cdddr L)) L))
-(test (procedure-signature procedure-signature) '((pair? boolean?) #t))
+(test (procedure-signature procedure-signature) '((pair? boolean?) procedure?))
(test (procedure-signature hash-table-set!) '(#t hash-table? #t #t))
(test (procedure-signature round) '(integer? real?))
(test (procedure-signature char-position) '((integer? boolean?) (char? string?) string? integer?))
@@ -32731,7 +32812,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature write) '(#t #t output-port?))
(test (procedure-signature cdr) '(#t pair?))
(test (procedure-signature call/cc) '(values procedure?))
-(test (procedure-signature port-filename) '(string? #t))
+(test (procedure-signature port-filename) '(string? (input-port? output-port?)))
(test (procedure-signature caaadr) '(#t pair?))
(test (procedure-signature symbol?) '(boolean? #t))
(test (procedure-signature values) (let ((L (list 'values #t))) (set-cdr! (cdr L) (cdr L)) L))
@@ -32744,7 +32825,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature iterate) '(#t iterator?))
(test (procedure-signature substring) (let ((L (list 'string? 'string? 'integer?))) (set-cdr! (cddr L) (cddr L)) L))
(test (procedure-signature tanh) (let ((L (list 'number?))) (set-cdr! L L) L))
-(test (procedure-signature symbol-access) '(#t symbol? let?))
+(test (procedure-signature symbol-access) '((boolean? procedure?) symbol? let?))
(test (procedure-signature provide) '(symbol? symbol?))
(test (procedure-signature rational?) '(boolean? #t))
(test (procedure-signature vector-set!) (let ((L (list #t 'vector? 'integer? 'integer:any?))) (set-cdr! (cdddr L) (cdddr L)) L))
@@ -32770,9 +32851,9 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature eval) '(values #t let?))
(test (procedure-signature caddr) '(#t pair?))
(test (procedure-signature cons) '(pair? #t #t))
-(test (procedure-signature port-closed?) '(boolean? #t))
+(test (procedure-signature port-closed?) '(boolean? (input-port? output-port?)))
(test (procedure-signature char-upcase) (let ((L (list 'char?))) (set-cdr! L L) L))
-(test (procedure-signature sort!) '(#t sequence? procedure?))
+(test (procedure-signature sort!) '(sequence? sequence? procedure?))
(test (procedure-signature write-string) (let ((L (list 'string? 'string? 'output-port? 'integer?))) (set-cdr! (cdddr L) (cdddr L)) L))
(test (procedure-signature char>=?) (let ((L (list 'boolean? 'char?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature caadar) '(#t pair?))
@@ -32810,7 +32891,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature funclet) '(let? procedure?))
(test (procedure-signature floor) '(integer? real?))
(test (procedure-signature let-set!) '(#t let? symbol? #t))
-(test (procedure-signature system) '(#t string? boolean?))
+(test (procedure-signature system) '((integer? string?) string? boolean?))
(test (procedure-signature map) (let ((L (list 'list? 'procedure? 'sequence?))) (set-cdr! (cddr L) (cddr L)) L))
(test (procedure-signature caaaar) '(#t pair?))
(test (procedure-signature port-line-number) '(integer? (input-port? null?)))
@@ -32822,7 +32903,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature float?) '(boolean? #t))
(test (procedure-signature cddar) '(#t pair?))
(test (procedure-signature atan) '(number? number? real?))
-(test (procedure-signature varlet) (let ((L (list 'let? 'let? #t))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature varlet) (let ((L (list 'let? '(let? null?) '(pair? symbol? let?) #t))) (set-cdr! (cdddr L) (cddr L)) L))
(test (procedure-signature random-state) (let ((L (list 'random-state? 'integer?))) (set-cdr! (cdr L) (cdr L)) L))
(test (procedure-signature emergency-exit) '(#t #t))
(test (procedure-signature #_exit) '(#t #t))
@@ -32853,7 +32934,7 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (procedure-signature atanh) (let ((L (list 'number?))) (set-cdr! L L) L))
(test (procedure-signature read-byte) '((integer? eof-object?) input-port?))
(test (procedure-signature procedure?) '(boolean? #t))
-(test (procedure-signature sublet) (let ((L (list 'let? '(let? null?) #t))) (set-cdr! (cddr L) (cddr L)) L))
+(test (procedure-signature sublet) (let ((L (list 'let? '(let? null?) '(pair? symbol? let?) #t))) (set-cdr! (cdddr L) (cddr L)) L))
(test (procedure-signature list-set!) (let ((L (list #t 'pair? 'integer? 'integer:any?))) (set-cdr! (cdddr L) (cdddr L)) L))
(test (procedure-signature string->number) '((number? boolean?) string? integer?))
(test (procedure-signature number->string) '(string? number? integer?))
@@ -32959,9 +33040,9 @@ or better (define-macro (prog vars . body) `(call-with-exit (lambda (return) (ta
(test (let? (funclet abs)) #t)
(test (> (length (funclet abs)) 100) #t)
(test (fill! (funclet abs) 0) 'error)
- (test (reverse (funclet abs)) 'error)
+ (test (reverse (funclet abs)) (rootlet))
(test (fill! (funclet ho) 0) 'error)
- (test (reverse (funclet ho)) 'error))
+ (test (let? (reverse (funclet ho))) #t))
(test (funclet quasiquote) (rootlet))
(test (funclet lambda) 'error)
@@ -36671,7 +36752,7 @@ func
(test (fill! hi 1) 1)
;(test (object->string hi) "(inlet)")
(test (length hi) 2)
- (test (reverse hi) 'error)
+ (test (let? (reverse hi)) #t)
(test (for-each abs hi) 'error)
(test (map abs hi) 'error)
(test (hi 1) 'error)
@@ -37940,13 +38021,13 @@ hi6: (string-app...
(test (copy 1.0+i) 1.0+i)
(test (copy "") "")
(test (copy #t) #t)
-(test (copy (string #\a #\null #\b)) "a\x00b")
+(test (copy (string #\a #\null #\b)) "a\x00;b")
(test (copy #<eof>) #<eof>)
(test ((copy abs) -123) 123)
(test (copy ''1) ''1)
(test (copy '''1) '''1)
(test (copy not) not)
-(test (copy "a\x00b") "a\x00b")
+(test (copy "a\x00;b") "a\x00;b")
(test (infinite? (copy (log 0.0))) #t)
(test (nan? (copy 1/0)) #t)
(test (copy if) if)
@@ -38109,7 +38190,7 @@ hi6: (string-app...
(test (copy i1 h2) 'error)
(test (copy i1 p2) '(5 6))
(if with-block (test (copy i1 b2) (block 5.000 6.000)))
- (test (copy i1 s2) "\x05\x06")
+ (test (copy i1 s2) "\x05;\x06;")
(test (copy f1 e2) 'error)
(test (copy f1 v2) #(9.0 10.0))
(test (copy f1 i2) (int-vector 9 10))
@@ -38196,7 +38277,7 @@ hi6: (string-app...
(test (copy i1 h2 1) 'error)
(test (copy i1 p2 1) '(6 16))
(if with-block (test (copy i1 b2 1) (block 6.000 20.000)))
- (test (copy i1 s2 1) "\x06b")
+ (test (copy i1 s2 1) "\x06;b")
(test (copy f1 e2 1) 'error)
(test (copy f1 v2 1) #(10.0 4))
(test (copy f1 i2 1) (int-vector 10 8))
@@ -78789,9 +78870,9 @@ etc....
(test (string->number "+.e1") #f)
(test (string->number ".e1") #f)
-(num-test (string->number "4\x32\x37") 427)
-(num-test (string->number "\x32.\x39") 2.9)
-(num-test (string->number "4\x31+3\x36i") 41+36i)
+(num-test (string->number "4\x32;\x37;") 427)
+(num-test (string->number "\x32;.\x39;") 2.9)
+(num-test (string->number "4\x31;+3\x36;i") 41+36i)
(when with-bignums
(num-test (string->number "101461074055444526136" 8) 1181671265888545886)
@@ -82572,6 +82653,7 @@ etc
ht))
(fill! ht ())
(test (hash-table-entries ht) 3))
+ (test (let ((v (vector 0 0))) (copy ((*mock-hash-table* 'mock-hash-table*) 'b 2) v) v) #((b . 2) 0))
(unless pure-s7 (test (let ((e (openlet (inlet 'fill! (lambda (obj val) (string-fill! (obj 'value) val)) 'value "01234")))) (vector-fill! e #\a) (e 'value)) 'error))
(test (let ((e (openlet (inlet 'call/cc (lambda (obj) 32))))) (call/cc e)) 32)
@@ -83832,6 +83914,7 @@ etc
(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (and `((x)) (string (integer->char 255))))) (define (hi) (func #f)) (hi)) #t)
(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1)) (string>? (null? i) (object->let /)) (string>? (null? i) (object->let /)))) (define (hi) (func #f)) (hi)) 'error)
(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) / (letrec . #t))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (do ((i 0 (+ i 1))) ((= i 1) i) :readable `((x . 1)) (provide (quote /)))) (define (hi) (func #f)) (hi)) 1)
(test (let () (define (func x) (iterator-sequence (string-ci<=? (do ((i 0 (+ i 1))) ((= i 1) i) (when (+ i 1) `(+ x 1) (list 1) (- i 1)))))) (define (hi) (func #f)) (hi)) 'error)
(test (let () (define (func x) (continuation? (do ((i 0 (+ i 1))) ((= i 1) i) (unless (+ i 1) quasiquote )))) (define (hi) (func #f)) (hi)) #f)
(test (let () (define (func x) (error `(x 1) (null? i) (list 1 2) (lambda . /))) (define (hi) (func #f)) (hi)) 'error)
@@ -83839,6 +83922,17 @@ etc
(test (let () (define (func x) (char>=? (inlet 'a 1) (hook-functions (output-port?))) (vector? (letrec))) (define (hi) (func #f)) (hi)) 'error)
(test (let () (define (func x) (letrec // . letrec)) (define (hi) (func #f)) (hi)) 'error)
(test (let () (define (func x) (for-each quasiquote (object->let /))) (define (hi) (func #f)) (hi)) #<unspecified>)
+(test (let () (define (func x) (provided? (eval-string (do ((i 0 (+ i 1))) ((= i 1) i) (case))))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (cond (denominator 1 . 2))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (when denominator 1 . 2)) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (case 0 ((0) 1 . 2))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (case denominator ((0) 1) (else 1 . 2))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (cond (denominator . 2))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (when denominator . 2)) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (case 0 ((0) . 2))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (case denominator ((0) 1) (else . 2))) (define (hi) (func #f)) (hi)) 'error)
+(test (let () (define (func x) (string? (object->string (hash-table (list-values (object->let /)))))) (define (hi) (func #f)) (hi)) #t)
+(test (let () (define (func x) (sort! / (lambda (zero? i) (zero? i)))) (define (hi) (func #f)) (hi)) 'error)
(test (let () (define (f) (let ((_x_ (+ _x_ 1.0))) 1)) (f)) 'error)
(test (let () (define (f) (define _x_ (let-ref (cdr _x_) 'a))) (f)) 'error)
@@ -84654,7 +84748,7 @@ etc
(let ()
(require libc.scm)
(when (and (defined? '*libc*)
- (procedure? (*libc* 'passwd_pw_name)))
+ (procedure? (*libc* 'passwd.pw_name)))
(with-let (sublet *libc*)
(test (let ((buf (make-string 20 #\null)))
@@ -84746,7 +84840,7 @@ etc
(let ((len (strftime timestr 64 "%a %d-%b-%Y %H:%M %Z"
(localtime
(time.make (time
- (c-pointer 0)))))))
+ (c-pointer 0 'time_t*)))))))
(substring timestr 0 len))))
(define (write-date file)
@@ -84812,8 +84906,14 @@ etc
(format *stderr* "got ~C~%" (c 0))))))))))
;; to write a directory files + file size:
- ;; (ftw "/home/bil/sf1" (lambda (a b c) (format *stderr* "~A ~A~%" a (stat.st_size b)) 0) 10)
-
+ (test (string? (with-output-to-string
+ (lambda ()
+ (ftw "/home/bil/sf1"
+ (lambda (a b c)
+ (format () "~A ~A~%" a ((*libc* 'stat.st_size) b))
+ 0) 10))))
+ #t)
+
(define (directory? file)
(let ((buf (stat.make)))
(let ((result (and (stat file buf)
@@ -84840,18 +84940,23 @@ etc
'groups-max (sysconf _SC_NGROUPS_MAX)
'page-size (sysconf _SC_PAGESIZE)))
+ (test (string? (getcwd (make-string 1024 #\space) 1024)) #t)
(test (string? (get-environment-variable "HOME")) #t)
(test (integer? (random)) #t)
- (test (assq 'decimal_point (localeconv)) '(decimal_point . "."))
+ (test ((localeconv) 'decimal_point) ".")
(test (string? (getlogin)) #t)
(test (integer? (getpid)) #t)
(test (integer? _POSIX_VERSION) #t)
(if (provided? 'linux) (test (>= __GLIBC__ 2) #t))
(test (c-null? (c-pointer 0)) #t)
(test (fnmatch "*.c" "s7.c" FNM_PATHNAME) 0)
- (test (string? (realpath "s7.c" ".")) #t)
- (test (passwd.pw_name (getpwnam (getlogin))) (getlogin))
- (test (string? (passwd.pw_shell (getpwnam (getlogin)))) #t)
+ (test (string? (realpath "s7.c" (string))) #t) ; second arg is simply ignored
+ (test (string? (realpath "s7.c" #f)) #t)
+ (let ((log (getlogin))) ; this is null in an emacs shell!
+ (when (and (string? log)
+ (> (string-length log) 0))
+ (test (passwd.pw_name (getpwnam (getlogin))) (getlogin))
+ (test (string? (passwd.pw_shell (getpwnam (getlogin)))) #t)))
(reader-cond ((not (provided? 'openbsd))
(test (string? (car (let ((w (wordexp.make))) (wordexp "~/cl/snd-gdraw" w 0) (wordexp.we_wordv w)))) #t)))
(test (pair? (system-limits)) #t)
@@ -84876,10 +84981,24 @@ etc
(test (llabs -1234) 1234)
(test (strtod "1.5") 1.5)
(test CLOCKS_PER_SEC 1000000)
- (test (group.gr_name (getgrnam "wheel")) "wheel")
+ (test (*libc* 'INT8_MIN) -128)
+ (test (not (member (group.gr_name (getgrnam "wheel")) '("" "wheel"))) #f)
+ (test (group.gr_name (getgrgid 0)) "root")
+ (test (group.gr_gid (getgrnam "root")) 0)
(test (let ((g (glob.make))) (glob "s7t*.scm" 0 g) (let ((res (glob.gl_pathv g))) (globfree g) res)) '("s7test.scm"))
+ (test (fegetround) 0)
+ (test (fegetenv (fenv_t.make)) 0)
+ (test (let ((file (fopen "s7test.scm" "r")))
+ (let ((c (getc file)))
+ (fclose file)
+ (integer->char c)))
+ #\;)
+
))))
+(if (defined? '*libc*) (format *stderr* "*libc* is defined~%"))
+(if (equal? (arity random) '(0 . 0)) (format *stderr* "libc random is global~%"))
+
;;; --------------------------------------------------------------------------------
;;; libgsl
@@ -85700,6 +85819,10 @@ etc
" +: in (+ 1 (if x #() 0)), +'s argument 2 should be a number, but #() is a vector?
+: perhaps (+ 1 (if x #() 0)) -> (if x (+ 1 #()) 1)")
(lint-test "(+ n (make-rectangular 0.0 0.0))" " +: perhaps (+ n (make-rectangular 0.0 0.0)) -> (+ n 0.0)")
+ (lint-test "(if old (list form) (cons form old))" " if: perhaps (if old (list form) (cons form old)) -> (cons form (if old () old))")
+ (lint-test "(if old (cons form old) (list form))" " if: perhaps (if old (cons form old) (list form)) -> (cons form (or old ()))")
+ (lint-test "(if (not x) (list y) (cons y x))" " if: perhaps (if (not x) (list y) (cons y x)) -> (cons y (or x ()))")
+ (lint-test "(if (not x) (cons y x) (list y))" " if: perhaps (if (not x) (cons y x) (list y)) -> (cons y (if (not x) x ()))")
(lint-test "(* 2 3)" " *: perhaps (* 2 3) -> 6")
(lint-test "(* 2 (+))" " *: perhaps (* 2 (+)) -> 0")
@@ -87918,7 +88041,7 @@ etc
(lint-test "(eq? x (not x))" " eq?: this looks odd: (eq? x (not x))")
(lint-test "(eq? #(a) #(a))"
" eq?: this looks odd: (eq? #(a) #(a)) eq?: perhaps (eq? #(a) #(a)) -> #f eq?: eq? should be equal? in (eq? #(a) #(a))")
- (lint-test "(eq? #() ())" " eq?: perhaps (eq? #() ()) -> #f eq?: eq? should be equal? in (eq? #() ())")
+ (lint-test "(eq? #() ())" " eq?: perhaps (eq? #() ()) -> #f eq?: eq? should be equal? in (eq? #() ()) eq?: perhaps (eq? #() ()) -> #f")
(lint-test "(eqv? x #())" " eqv?: eqv? should be equal? in (eqv? x #())")
(lint-test "(eq? x \"\")" " eq?: eq? should be equal? in (eq? x \"\")")
(lint-test "(eq? #() (vector))" " eq?: eq? should be equal? in (eq? #() (vector))")
@@ -87954,11 +88077,38 @@ etc
(lint-test "(equal? (string->number x) (string->number y))" " equal?: equal? could be eqv? in (equal? (string->number x) (string->number y))")
(lint-test "(eqv? \":\" (string-ref s 0))"
" eqv?: this can't be right: (eqv? \":\" (string-ref s 0))
- eqv?: eqv? should be equal? in (eqv? \":\" (string-ref s 0))")
+ eqv?: eqv? should be equal? in (eqv? \":\" (string-ref s 0))
+ eqv?: perhaps (eqv? \":\" (string-ref s 0)) -> #f")
(lint-test "(char-ci=? x #\\return)" " char-ci=?: char-ci=? could be char=? here: (char-ci=? x #\\return)")
(lint-test "(equal? (vector-copy #(a b c)) #(a b c))" " equal?: perhaps (equal? (vector-copy #(a b c)) #(a b c)) -> (equal? #(a b c) #(a b c))")
(lint-test "(not (equal? v (copy v)))" " not: perhaps (equal? v (copy v)) -> (equal? v v)")
+ (lint-test "(eq? (floor x) 'a)" " eq?: eq? should be eqv? in (eq? (floor x) 'a) eq?: perhaps (eq? (floor x) 'a) -> #f")
+ (lint-test "(eq? (floor pi) #t)" " eq?: eq? should be eqv? in (eq? (floor pi) #t) eq?: perhaps (eq? (floor pi) #t) -> #f")
+ (lint-test "(eqv? (string->symbol x) 123)" " eqv?: perhaps (eqv? (string->symbol x) 123) -> #f")
+ (lint-test "(eq? 'a (integer->char 48))"
+ " eq?: eq? should be eqv? in (eq? 'a (integer->char 48))
+ eq?: perhaps (eq? 'a (integer->char 48)) -> #f
+ eq?: perhaps (integer->char 48) -> #\\0")
+ (lint-test "(equal? (string->symbol x) 123)"
+ " equal?: equal? could be eqv? in (equal? (string->symbol x) 123)
+ equal?: perhaps (equal? (string->symbol x) 123) -> #f")
+ (lint-test "(equal? (floor pi) (list 1 2))"
+ " equal?: equal? could be eqv? in (equal? (floor pi) (list 1 2))
+ equal?: perhaps (equal? (floor pi) (list 1 2)) -> #f
+ equal?: perhaps (list 1 2) -> '(1 2)")
+ (lint-test "(morally-equal? (list 1 2) (vector 1 2))"
+ " morally-equal?: perhaps (morally-equal? (list 1 2) (vector 1 2)) -> #f
+ morally-equal?: perhaps (list 1 2) -> '(1 2)
+ morally-equal?: perhaps (vector 1 2) -> #(1 2)")
+ (lint-test "(eq? x 'a)" "")
+ (lint-test "(equal? '(1 2) '(1 2))" " equal?: perhaps (equal? '(1 2) '(1 2)) -> #t")
+ (lint-test "(equal? '(1 2) #(1 2))"
+ " equal?: perhaps (equal? '(1 2) #(1 2)) -> #f
+ equal?: perhaps (equal? '(1 2) #(1 2)) -> #f
+ equal?: #(1 2) could be #i(1 2)")
+ (lint-test "(equal? '(1 . 2) (cons 1 2))" "")
+
(lint-test "(map abs '(1 2) '(3 4))" " map: map has too many arguments in: (map abs '(1 2) '(3 4))")
(lint-test "(map (lambda (a b) a) '(1 2))" " map: map has too few arguments in: (map (lambda (a b) a) '(1 2))")
(lint-test "(map (lambda (a) (abs a)) '(1 2 3))" " map: perhaps (lambda (a) (abs a)) -> abs")
@@ -88211,6 +88361,13 @@ etc
(lint-test "(case x ((a b) (f y z)) (else (g y z)))" " case: perhaps (case x ((a b) (f y z)) (else (g y z))) -> ((case x ((a b) f) (else g)) y z)")
(lint-test "(case x ((a) (f y a)) (else (f y z)))" " case: perhaps (case x ((a) (f y a)) (else (f y z))) -> (f y (if (eqv? x a) a z))")
+ (lint-test "(case (abs x) ((integer?) 1) ((x) 2) ((1) 3))"
+ "case: case key integer? in ((integer?) 1) is pointless
+ case: case key x in ((x) 2) is pointless")
+ (lint-test "(case (floor x) ((1 2) 3) ((a b) 4))"
+ " case: case key a in ((a b) 4) is pointless
+ case: case key b in ((a b) 4) is pointless")
+
(lint-test "(if (not sym) (set! sym (eqv-selector p)) (equal? sym (eqv-selector p)))" "")
(lint-test "(cond (X (f y z)) (else (set! y z)))" "")
(lint-test "(case x ((a) (set! y z)) (else (g y z)))" " case: perhaps (case x ((a) (set! y z)) (else (g y z))) -> (if (eq? x 'a) (set! y z) (g y z))")
@@ -88226,7 +88383,7 @@ etc
((5) (call-case 5))
((6) (call-case 6))
(else 12))"
- " case (line 8): perhaps use => here: (case arg-count ((0) (call-case 0)) ((1) (call-case 1)) ((2) (call-case... ->
+ " case: perhaps use => here: (case arg-count ((0) (call-case 0)) ((1) (call-case 1)) ((2) (call-case... ->
(case arg-count ((0 1 2 3 4 5 6) => call-case) ...)")
(lint-test "(case x ((0) (f 0)) ((1) z) (else y))"
" case: perhaps use => here: (case x ((0) (f 0)) ((1) z) (else y)) -> (case x ((0) => f) ...)")
@@ -88565,7 +88722,9 @@ etc
(lint-test "(let ((x 43)) (define y 44) (display (+ x y)))"
" let: perhaps (let ((x 43)) (define y 44) (display (+ x y))) -> (let ((x 43) (y 44)) ...)")
(lint-test "(lambda () (let ((x 43)) (define y 44) (display (+ x y))))"
- " lambda: perhaps (let ((x 43)) (define y 44) (display (+ x y))) -> (let ((x 43) (y 44)) ...)")
+ " lambda: y can be moved to lambda's closure
+ lambda: x can be moved to lambda's closure
+ lambda: perhaps (let ((x 43)) (define y 44) (display (+ x y))) -> (let ((x 43) (y 44)) ...)")
(lint-test "(let () (define x 3) (define (y a) a) (g z))"
" let: perhaps (... (define x 3) (define (y a) a) (g z)) -> (... (let ((x 3)) ...))
let: y not used, value: (define (y a) a)
@@ -88612,8 +88771,8 @@ etc
(let-temporarily (((*s7* 'print-length) 32)) (display x))")
(lint-test "(define equalize-panes (let ((equalize-sound (lambda (ind) (let-temporarily (((channel-style ind) channels-combined))))))
(lambda* (snd) (if snd (equalize-sound snd) (for-each equalize-sound (sounds))))))" "")
- (lint-test "(let-temporarily () 3)" " let-temporarily (line 0): let-temporarily with no vars? (let-temporarily () 3)")
- (lint-test "(let-temporarily)" " let-temporarily (line 0): let-temporarily is messed up: (let-temporarily)")
+ (lint-test "(let-temporarily () 3)" " let-temporarily: let-temporarily with no vars? (let-temporarily () 3)")
+ (lint-test "(let-temporarily)" " let-temporarily: let-temporarily is messed up: (let-temporarily)")
(lint-test "(null? (let ((p (lambda (x) (not ((if (path? obj) path? picture?) x))))) (filt p (cons obj more-objs))))"
" null?: perhaps (null? (let ((p (lambda (x) (not ((if (path? obj) path? picture?) x)))))... ->
@@ -88655,7 +88814,8 @@ etc
" lambda: the inner function f211 could be moved outside the lambda: (lambda () (let ((a 1)) (define (f211 x) (+ x 1)) (display a) (let ((b 2))... ->
(let () (define (f211 x) (+ x 1)) (lambda () ...))
lambda: perhaps move 'f211 into the inner let: (lambda () (let ((a 1)) (define (f211 x) (+ x 1)) (display a) (let ((b 2))... ->
- (let ((f211 (lambda (x) (+ x 1))) (b 2)) (display (f211 (+ a b))))")
+ (let ((f211 (lambda (x) (+ x 1))) (b 2)) (display (f211 (+ a b))))
+ lambda: a can probably be moved to lambda's closure")
(lint-test "(let () (let ((a 1)) (let ((f212 (lambda (x) (+ x 1)))) (display a) (let ((b 2)) (display (f212 (+ a b)))))))"
" let: pointless let: (let () (let ((a 1)) (let ((f212 (lambda (x) (+ x 1)))) (display a) (let...
let: perhaps (let ((a 1)) (let ((f212 (lambda (x) (+ x 1)))) (display a) (let ((b 2))... ->
@@ -88896,8 +89056,8 @@ etc
(lint-test "(format #f \"~NC ~W\" 1 #\\c 2)" "")
(lint-test "(format #f \"~4,3F\" x)" "")
(lint-test "(format #f \"~32T\")" "")
- (lint-test "(format #f \"~a\\x00b\" x)"
- " format: #\\null in a format control string will confuse both lint and format: \"~a\\x00b\" in (format #f \"~a\\x00b\" x)")
+ (lint-test "(format #f \"~a\\x00;b\" x)"
+ " format: #\\null in a format control string will confuse both lint and format: \"~a\\x00;b\" in (format #f \"~a\\x00;b\" x)")
(lint-test "(let () (format #t \"~A\" x) x)"
" let: let could be begin: (let () (format #t \"~A\" x) x) -> (begin (format #t \"~A\" x) x)
let: perhaps use () with format since the string value is discarded: (format () \"~A\" x)")
@@ -89069,7 +89229,7 @@ etc
" begin: perhaps
(... (write-string x p y z) (write-string \"1234\" p 1) (write-string \"5678\"... ->
(format p \"~A2347~A\" (substring x y z) (substring \"abc\" 2 z))")
- (lint-test "(display x #f)" "") ; #f is ok here = no output
+ (lint-test "(display x #f)" " display: (display x #f) could be x")
(lint-test "(read-line in-port 'concat)"
"read-line: in (read-line in-port 'concat), read-line's argument 2 should be a boolean, but 'concat is a symbol?
read-line: the third argument should be boolean (#f=default, #t=include trailing newline): (read-line in-port 'concat)")
@@ -89967,15 +90127,16 @@ etc
" lambda: the inner function fdo could be moved outside the lambda:
(lambda (i) (let ((y 32)) (define (fdo x) (+ x 1)) (if (= i y) (display... -> (let () (define (fdo x) (+ x 1)) (lambda (i) ...))
lambda: perhaps (... (define (fdo x) (+ x 1)) (if (= i y) (display (fdo i)) (loop (+ i 1)))) ->
- (... (if (= i y) (display (let ((x i)) (+ x 1))) (loop (+ i 1))))")
- (lint-test "(let ((y 32)) (define (fdo x) (+ x 1)) (if (= i y) (display (fdo i)) (loop (+ i 1))))"
+ (... (if (= i y) (display (let ((x i)) (+ x 1))) (loop (+ i 1))))
+ lambda: y can be moved to lambda's closure")
+ (lint-test "(let ((y 33)) (define (fdo x) (+ x 1)) (if (= i y) (display (fdo i)) (loop (+ i 1))))"
" let: the inner function fdo could be moved into the let:
- (let ((y 32)) (define (fdo x) (+ x 1)) (if (= i y) (display (fdo i)) (loop... -> (let ((y 32) (fdo (lambda (x) (+ x 1)))) ...)
+ (let ((y 33)) (define (fdo x) (+ x 1)) (if (= i y) (display (fdo i)) (loop... -> (let ((y 33) (fdo (lambda (x) (+ x 1)))) ...)
let: perhaps (... (define (fdo x) (+ x 1)) (if (= i y) (display (fdo i)) (loop (+ i 1)))) ->
(... (if (= i y) (display (let ((x i)) (+ x 1))) (loop (+ i 1))))")
- (lint-test "(let* ((y 32) (z (log y))) (define (fdo x) (+ x 1)) (if (= z y) (display (fdo y)) (loop (+ i 1))))"
+ (lint-test "(let* ((y 34) (z (log y))) (define (fdo x) (+ x 1)) (if (= z y) (display (fdo y)) (loop (+ i 1))))"
" let*: the inner function fdo could be moved out of the let*:
- (let* ((y 32) (z (log y))) (define (fdo x) (+ x 1)) (if (= z y) (display... -> (let ((fdo (lambda (x) (+ x 1)))) (let* ((y 32) (z (log y))) ...))
+ (let* ((y 34) (z (log y))) (define (fdo x) (+ x 1)) (if (= z y) (display... -> (let ((fdo (lambda (x) (+ x 1)))) (let* ((y 34) (z (log y))) ...))
let*: perhaps (... (define (fdo x) (+ x 1)) (if (= z y) (display (fdo y)) (loop (+ i 1)))) ->
(... (if (= z y) (display (let ((x y)) (+ x 1))) (loop (+ i 1))))")
(lint-test "(define (fda y) (define (fdo x) (+ x 1)) (if (= y 3) (display (fdo y))))"
@@ -90012,14 +90173,17 @@ etc
" lambda: the inner function fdo could be moved outside the lambda:
(lambda (i) (let ((y 32)) (define (fdo i) (+ i 1)) (if (= i y) (display... -> (let () (define (fdo i) (+ i 1)) (lambda (i) ...))
lambda: perhaps (... (define (fdo i) (+ i 1)) (if (= i y) (display (fdo i)) (loop (+ i 1)))) ->
- (... (if (= i y) (display (let ((i i)) (+ i 1))) (loop (+ i 1))))")
+ (... (if (= i y) (display (let ((i i)) (+ i 1))) (loop (+ i 1))))
+ lambda: y can be moved to lambda's closure")
(lint-test "(lambda (i) (let ((y 32)) (define fdo (lambda (i) (+ i 1))) (if (= i y) (display (fdo i)) (loop (+ i 1)))))"
" lambda: the inner function fdo could be moved outside the lambda:
- (lambda (i) (let ((y 32)) (define fdo (lambda (i) (+ i 1))) (if (= i y)... -> (let () (define fdo (lambda (i) (+ i 1))) (lambda (i) ...))")
+ (lambda (i) (let ((y 32)) (define fdo (lambda (i) (+ i 1))) (if (= i y)... -> (let () (define fdo (lambda (i) (+ i 1))) (lambda (i) ...))
+ lambda: y can be moved to lambda's closure")
(lint-test "(define (f x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (if (= i y) (display (fdo i)) (loop (+ i 1)))))"
" define: the local function fdo could be moved to f's closure:
(define (f x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (if (= i y)... ->
- (define f (let ((fdo (lambda (i) (+ i 1)))) (lambda (x) ...)))")
+ (define f (let ((fdo (lambda (i) (+ i 1)))) (lambda (x) ...)))
+ f: y can be moved to f's closure")
(lint-test "(define (f x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (define (fdi i) (+ i 2)) (if (= i y) (display (fdo (fdi i))) (loop (+ i 1)))))"
" define: the inner function fdi could be moved to f's closure:
(define (f x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (define (fdi i) (+... ->
@@ -90028,11 +90192,13 @@ etc
(define (f x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (define (fdi i) (+... ->
(define f (let ((fdo (lambda (i) (+ i 1)))) (lambda (x) ...)))
f: perhaps (... (define (fdi i) (+ i 2)) (if (= i y) (display (fdo (fdi i))) (loop (+... ->
- (... (if (= i y) (display (fdo (let ((i i)) (+ i 2)))) (loop (+ i 1))))")
+ (... (if (= i y) (display (fdo (let ((i i)) (+ i 2)))) (loop (+ i 1))))
+ f: y can be moved to f's closure")
(lint-test "(lambda (x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (if (= i y) (display (fdo i)) (loop (+ i 1)))))"
" lambda: the local function fdo could be moved outside the lambda:
(lambda (x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (if (= i y) (display... ->
- (let ((fdo (lambda (i) (+ i 1)))) (lambda (x) ...))")
+ (let ((fdo (lambda (i) (+ i 1)))) (lambda (x) ...))
+ lambda: y can be moved to lambda's closure")
(lint-test "(lambda (x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (define (fdi i) (+ i 2)) (if (= i y) (display (fdo (fdi i))) (loop (+ i 1)))))"
" lambda: the inner function fdi could be moved outside the lambda:
(lambda (x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (define (fdi i) (+ i... ->
@@ -90041,7 +90207,8 @@ etc
(lambda (x) (let ((y 32) (fdo (lambda (i) (+ i 1)))) (define (fdi i) (+ i... ->
(let ((fdo (lambda (i) (+ i 1)))) (lambda (x) ...))
lambda: perhaps (... (define (fdi i) (+ i 2)) (if (= i y) (display (fdo (fdi i))) (loop (+... ->
- (... (if (= i y) (display (fdo (let ((i i)) (+ i 2)))) (loop (+ i 1))))")
+ (... (if (= i y) (display (fdo (let ((i i)) (+ i 2)))) (loop (+ i 1))))
+ lambda: y can be moved to lambda's closure")
(lint-test "(let () (define (f1 a) a) (f1 2 3))"
" let: perhaps (... (define (f1 a) a) (f1 2 3)) -> (... (let ((a 2)) a))
@@ -90312,7 +90479,8 @@ etc
" case-lambda: perhaps (lambda (a b) (+ a b)) -> +
case-lambda: perhaps (case-lambda \"a doc string\" ((a b) (+ a b))) -> (let ((documentation \"a doc string\")) (lambda (a b) (+ a b)))")
(lint-test "(case-lambda (() (display x #f)) ((y) (display x y)))"
- " case-lambda: perhaps (case-lambda (() (display x #f)) ((y) (display x y))) -> (lambda* (y) (display x y))")
+ " case-lambda: (display x #f) could be x
+ case-lambda: perhaps (case-lambda (() (display x #f)) ((y) (display x y))) -> (lambda* (y) (display x y))")
(lint-test "(case-lambda (() (+ x 0)) ((y) (+ x y)))"
" case-lambda: perhaps (+ x 0) -> x
case-lambda: perhaps (case-lambda (() (+ x 0)) ((y) (+ x y))) -> (lambda* ((y 0)) (+ x y))")
@@ -90586,59 +90754,59 @@ etc
(define (f11 a b) (if (positive? a) (+ a b) b))
(define (f14 x y) (if (positive? x) (+ x y) y))
(+ (f11 1 2) (f14 1 2)))"
- " let (line 3): perhaps embed f14:
+ " let: perhaps embed f14:
(let () (define (f11 a b) (if (positive? a) (+ a b) b)) (define (f14 x y)... ->
(... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y))))
- f14 (line 2): f14 could be (define f14 f11)")
+ f14: f14 could be (define f14 f11)")
(lint-test "(let ((x (let () (define (f11 a b) (if (positive? a) (+ a b) b)) (f11 1 2))))
(define (f14 x y) (if (positive? x) (+ x y) y))
(+ x (f14 1 2)))"
- " let (line 0): perhaps (... (define (f11 a b) (if (positive? a) (+ a b) b)) (f11 1 2)) -> (... (let ((a 1) (b 2)) (if (positive? a) (+ a b) b)))
- let (line 0): the inner function f14 could be moved into the let:
+ " let: perhaps (... (define (f11 a b) (if (positive? a) (+ a b) b)) (f11 1 2)) -> (... (let ((a 1) (b 2)) (if (positive? a) (+ a b) b)))
+ let: the inner function f14 could be moved into the let:
(let ((x (let () (define (f11 a b) (if (positive? a) (+ a b) b)) (f11 1... ->
(let ((x (let () (define (f11 a b) (if (positive? a) (+ a b) b)) (f11 1 2))) (f14 (lambda (x y) (if (positive? x) (+ x y) y)))) ...)
- let (line 0): perhaps (... (define (f14 x y) (if (positive? x) (+ x y) y)) (+ x (f14 1 2))) ->
+ let: perhaps (... (define (f14 x y) (if (positive? x) (+ x y) y)) (+ x (f14 1 2))) ->
(... (+ x (let ((x 1) (y 2)) (if (positive? x) (+ x y) y))))
- f14 (line 1): f14 is the same as f11 (line 0)")
+ f14: f14 is the same as f11 (line 0)")
(lint-test "(let ()
(define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b)) (f12 a b))
(define (f14 x y) (if (positive? x) (+ x y) y))
(+ (f11 1 2) (f14 1 2)))"
- " let (line 3): perhaps embed f14:
+ " let: perhaps embed f14:
(let () (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b))... ->
(... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y))))
- let (line 1): the inner function f12 could be moved to f11's closure:
+ let: the inner function f12 could be moved to f11's closure:
(define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b)) (f12 a b)) ->
(define f11 (let () (define (f12 a b) (if (positive? a) (+ a b) b)) (lambda (a b) ...)))
- let (line 1): perhaps (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b)) (f12 a b)) ->
+ let: perhaps (define (f11 a b) (define (f12 a b) (if (positive? a) (+ a b) b)) (f12 a b)) ->
(define (f11 a b) (if (positive? a) (+ a b) b))
- f14 (line 2): f14 is the same as f12 (line 1)")
+ f14: f14 is the same as f12 (line 1)")
(lint-test "(let ()
(define (f11 a b) (if (positive? a) (+ a b) b))
(define (f14 y x) (if (positive? x) (+ x y) y))
(+ (f11 1 2) (f14 1 2)))"
- " let (line 3): perhaps embed f14:
+ " let: perhaps embed f14:
(let () (define (f11 a b) (if (positive? a) (+ a b) b)) (define (f14 y x)... ->
(... (+ (f11 1 2) (let ((y 1) (x 2)) (if (positive? x) (+ x y) y))))")
- ; TODO: f14 (line 2): perhaps (if (positive? x) (+ x y) y) -> (f11 x y)
+ ; TODO: f14: perhaps (if (positive? x) (+ x y) y) -> (f11 x y)
(lint-test "(let ()
(define (f11 b a) (if (positive? a) (+ a b) b))
(define (f14 x y) (if (positive? x) (+ x y) y))
(+ (f11 1 2) (f14 1 2)))"
- " let (line 3): perhaps embed f14:
+ " let: perhaps embed f14:
(let () (define (f11 b a) (if (positive? a) (+ a b) b)) (define (f14 x y)... ->
(... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y))))")
- ; TODO: f14 (line 2): perhaps (if (positive? x) (+ x y) y) -> (f11 y x)
+ ; TODO: f14: perhaps (if (positive? x) (+ x y) y) -> (f11 y x)
(lint-test "(let ()
(define (f1 x) (set! x 32) (log x 2.0))
(define (f2 y) (set! y 32) (log y 2.0))
(+ (f1 0) (f2 0)))"
- " let (line 3): perhaps embed f2:
+ " let: perhaps embed f2:
(let () (define (f1 x) (set! x 32) (log x 2.0)) (define (f2 y) (set! y 32)... ->
(... (+ (f1 0) (let ((y 0)) (set! y 32) (log y 2.0))))
- f1 (line 1): perhaps (set! x 32) -> (let ((x 32)) ...)
- f2 (line 2): f2 could be (define f2 f1)
- f2 (line 2): perhaps (set! y 32) -> (let ((y 32)) ...)")
+ f1: perhaps (set! x 32) -> (let ((x 32)) ...)
+ f2: f2 could be (define f2 f1)
+ f2: perhaps (set! y 32) -> (let ((y 32)) ...)")
(lint-test "(let ()
(define (f11 a b) (if (positive? a) (+ a b) b))
(let ((z (if (positive? a1) (+ a1 b1) b1)))
@@ -90647,105 +90815,105 @@ etc
(define (f11 a b) (if (positive? a) (+ a b) b))
(define f14 (lambda (x y) (if (positive? x) (+ x y) y)))
(+ (f11 1 2) (f14 1 2)))"
- " let (line 3): the scope of f14 could be reduced:
+ " let: the scope of f14 could be reduced:
(... (define f14 (lambda (x y) (if (positive? x) (+ x y) y))) (+ (f11 1 2) (f14 1 2))) ->
(... (let ((f14 (lambda (x y) (if (positive? x) (+ x y) y)))) (+ (f11 1 2) (f14 1 2))))")
- ; TODO: f14 (line 2): perhaps (if (positive? x) (+ x y) y) -> (f11 x y)
+ ; TODO: f14: perhaps (if (positive? x) (+ x y) y) -> (f11 x y)
(lint-test "(let ()
(define f11 (let () (lambda (a b) (if (positive? a) (+ a b) b))))
(define (f14 x y) (if (positive? x) (+ x y) y))
(+ (f11 1 2) (f14 1 2)))"
- " let (line 3): perhaps embed f14: (let () (define f11 (let () (lambda (a b) (if (positive? a) (+ a b) b))))... ->
+ " let: perhaps embed f14: (let () (define f11 (let () (lambda (a b) (if (positive? a) (+ a b) b))))... ->
(... (+ (f11 1 2) (let ((x 1) (y 2)) (if (positive? x) (+ x y) y))))
- f11 (line 1): pointless let: (let () (lambda (a b) (if (positive? a) (+ a b) b)))")
- ; TODO: f14 (line 2): f14 could be (define f14 f11)
+ f11: pointless let: (let () (lambda (a b) (if (positive? a) (+ a b) b)))")
+ ; TODO: f14: f14 could be (define f14 f11)
(lint-test "(let ()
(define (f11 a b) (if (positive? a) (+ a b) b))
(define (f14 x y) (if (positive? x) (+ x (log y)) (log y)))
- (+ (f11 1 2) (f14 1 2)))" "") ; TODO: f14 (line 2): perhaps (if (positive? x) (+ x (log y)) (log y)) -> (f11 x (log y))
+ (+ (f11 1 2) (f14 1 2)))" "") ; TODO: f14: perhaps (if (positive? x) (+ x (log y)) (log y)) -> (f11 x (log y))
(lint-test "(let () (define union (let ((z 32)) (set! x (lambda (y) (+ z y))) (lambda args args))) (union 1 2))" "")
(lint-test "(let ()
(define (f11 a b) (let ((z (+ a 1))) (if (positive? z) (+ a b) b)))
(define (f14 x y) (let ((w (+ x 1))) (if (positive? w) (+ x y) y)))
(+ (f11 1 2) (f14 1 2)))"
- " f11 (line 1): perhaps (let ((z (+ a 1))) (if (positive? z) (+ a b) b)) -> (if (positive? (+ a 1)) (+ a b) b)
- f14 (line 2): f14 could be (define f14 f11)
- f14 (line 2): perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (if (positive? (+ x 1)) (+ x y) y)")
+ " f11: perhaps (let ((z (+ a 1))) (if (positive? z) (+ a b) b)) -> (if (positive? (+ a 1)) (+ a b) b)
+ f14: f14 could be (define f14 f11)
+ f14: perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (if (positive? (+ x 1)) (+ x y) y)")
(lint-test "(let ()
(define (f11 a b) (let ((z (+ a 1))) (if (positive? z) (+ a b) b)))
(define (f14 x . y) (let ((w (+ x 1))) (if (positive? w) (+ x y) y)))
(+ (f11 1 2) (f14 1 2)))"
- " f11 (line 1): perhaps (let ((z (+ a 1))) (if (positive? z) (+ a b) b)) -> (if (positive? (+ a 1)) (+ a b) b)
- f14 (line 2): perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (if (positive? (+ x 1)) (+ x y) y)")
+ " f11: perhaps (let ((z (+ a 1))) (if (positive? z) (+ a b) b)) -> (if (positive? (+ a 1)) (+ a b) b)
+ f14: perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (if (positive? (+ x 1)) (+ x y) y)")
(lint-test "(let ()
(define (f11 a b) (let ((z (+ a 1))) (if (positive? z) (+ a b) b)))
(define (f14 x y z) (let ((w (+ x 1))) (if (positive? w) (+ x y) y)))
(+ (f11 1 2) (f14 1 2 3)))"
- " f11 (line 1): perhaps (let ((z (+ a 1))) (if (positive? z) (+ a b) b)) -> (if (positive? (+ a 1)) (+ a b) b)
- f14 (line 2): perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (if (positive? (+ x 1)) (+ x y) y)
- let (line 3): f14's parameter 3 is not used, but a value is passed: 3")
- ; TODO: f14 (line 2): perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (f11 x y)
+ " f11: perhaps (let ((z (+ a 1))) (if (positive? z) (+ a b) b)) -> (if (positive? (+ a 1)) (+ a b) b)
+ f14: perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (if (positive? (+ x 1)) (+ x y) y)
+ let: f14's parameter 3 is not used, but a value is passed: 3")
+ ; TODO: f14: perhaps (let ((w (+ x 1))) (if (positive? w) (+ x y) y)) -> (f11 x y)
(lint-test "(let ()
(define (f11 a b) (let ((z (+ a 1))) (if (positive? z) (+ a b) b)))
(define (f14 x y) (let ((w (+ x 1)) (ww 1)) (if (positive? w) (+ x y) y)))
(+ (f11 1 2) (f14 1 2)))"
- " f11 (line 1): perhaps (let ((z (+ a 1))) (if (positive? z) (+ a b) b)) -> (if (positive? (+ a 1)) (+ a b) b)
- f14 (line 2): ww not used, initially: 1 from let
- f14 (line 2): ww can be moved to f14's closure")
+ " f11: perhaps (let ((z (+ a 1))) (if (positive? z) (+ a b) b)) -> (if (positive? (+ a 1)) (+ a b) b)
+ f14: ww not used, initially: 1 from let
+ f14: ww can be moved to f14's closure")
(lint-test "(let ()
(define (f12 a b) (let* ((z (+ a 1)) (zz z)) (if (positive? z) (+ a b) zz)))
(define (f15 x y) (let* ((w (+ x 1)) (ww w)) (if (positive? w) (+ x y) ww)))
(+ (f12 1 2) (f15 1 2)))"
- " f12 (line 1): perhaps (let* ((z (+ a 1)) (zz z)) (if (positive? z) (+ a b) zz)) -> (let ((z (+ a 1))) (if (positive? z) (+ a b) z))
- f15 (line 2): f15 could be (define f15 f12)
- f15 (line 2): perhaps (let* ((w (+ x 1)) (ww w)) (if (positive? w) (+ x y) ww)) -> (let ((w (+ x 1))) (if (positive? w) (+ x y) w))")
+ " f12: perhaps (let* ((z (+ a 1)) (zz z)) (if (positive? z) (+ a b) zz)) -> (let ((z (+ a 1))) (if (positive? z) (+ a b) z))
+ f15: f15 could be (define f15 f12)
+ f15: perhaps (let* ((w (+ x 1)) (ww w)) (if (positive? w) (+ x y) ww)) -> (let ((w (+ x 1))) (if (positive? w) (+ x y) w))")
(lint-test "(let ()
(define (f16 x) (do ((i 0 (+ i 1))) ((= i x)) (display i)))
(define (f17 y) (do ((k 0 (+ k 1))) ((= k y)) (display k)))
- (f16 2) (f17 2))" " f17 (line 2): f17 could be (define f17 f16)")
+ (f16 2) (f17 2))" " f17: f17 could be (define f17 f16)")
(lint-test "(let ()
(define (f18 a b) (let ((z (lambda (c) (+ c 1)))) (if (positive? (z 1)) (+ a b) b)))
(define (f19 x y) (let ((w (lambda (d) (+ d 1)))) (if (positive? (w 1)) (+ x y) y)))
(+ (f18 1 2) (f19 1 2)))"
- " let (line 1): the local function z could be moved to f18's closure:
+ " let: the local function z could be moved to f18's closure:
(define (f18 a b) (let ((z (lambda (c) (+ c 1)))) (if (positive? (z 1)) (+... ->
(define f18 (let ((z (lambda (c) (+ c 1)))) (lambda (a b) ...)))
- f18 (line 1): perhaps (let ((z (lambda (c) (+ c 1)))) (if (positive? (z 1)) (+ a b) b)) -> (if (positive? (let ((c 1)) (+ c 1))) (+ a b) b)
- let (line 2): the local function w could be moved to f19's closure:
+ f18: perhaps (let ((z (lambda (c) (+ c 1)))) (if (positive? (z 1)) (+ a b) b)) -> (if (positive? (let ((c 1)) (+ c 1))) (+ a b) b)
+ let: the local function w could be moved to f19's closure:
(define (f19 x y) (let ((w (lambda (d) (+ d 1)))) (if (positive? (w 1)) (+... ->
(define f19 (let ((w (lambda (d) (+ d 1)))) (lambda (x y) ...)))
- f19 (line 2): f19 could be (define f19 f18)
- f19 (line 2): perhaps (let ((w (lambda (d) (+ d 1)))) (if (positive? (w 1)) (+ x y) y)) -> (if (positive? (let ((d 1)) (+ d 1))) (+ x y) y)")
+ f19: f19 could be (define f19 f18)
+ f19: perhaps (let ((w (lambda (d) (+ d 1)))) (if (positive? (w 1)) (+ x y) y)) -> (if (positive? (let ((d 1)) (+ d 1))) (+ x y) y)")
(lint-test "(let ()
(define (f20 a) (define (f20a b) (+ (* 2 b) a)) (f20a a))
(define (f21 x) (define (f21a c) (+ (* 2 c) x)) (f21a x))
(+ (f20 1) (f21 2)))"
- " let (line 1): perhaps (define (f20 a) (define (f20a b) (+ (* 2 b) a)) (f20a a)) -> (define (f20 a) (let ((b a)) (+ (* 2 b) a)))
- let (line 2): perhaps (define (f21 x) (define (f21a c) (+ (* 2 c) x)) (f21a x)) -> (define (f21 x) (let ((c x)) (+ (* 2 c) x)))")
- ; f21 (line 2): f21 could be (define f21 f20)
+ " let: perhaps (define (f20 a) (define (f20a b) (+ (* 2 b) a)) (f20a a)) -> (define (f20 a) (let ((b a)) (+ (* 2 b) a)))
+ let: perhaps (define (f21 x) (define (f21a c) (+ (* 2 c) x)) (f21a x)) -> (define (f21 x) (let ((c x)) (+ (* 2 c) x)))")
+ ; f21: f21 could be (define f21 f20)
(lint-test "(let ()
(define (f20 a) (define f20a (lambda (b) (+ (* 2 b) a))) (f20a a))
(define (f21 x) (define f21a (lambda (c) (+ (* 2 c) x))) (f21a x))
(+ (f20 1) (f21 2)))" "")
- ; f21 (line 2): f21 could be (define f21 f20)
+ ; f21: f21 could be (define f21 f20)
(lint-test "(let ()
(define (f22 a) (lambda (b) (+ (* 2 b) a)))
(define (f23 x) (lambda (c) (+ (* 2 c) x)))
(+ ((f22 1) 2) ((f23 2) 3)))"
- "let (line 3): perhaps embed f23:
+ "let: perhaps embed f23:
(let () (define (f22 a) (lambda (b) (+ (* 2 b) a))) (define (f23 x)... ->
(... (+ ((f22 1) 2) ((let ((x 2)) (lambda (c) (+ (* 2 c) x))) 3)))
- f23 (line 2): f23 could be (define f23 f22)")
+ f23: f23 could be (define f23 f22)")
(lint-test "(let ()
(define (f22 a) (lambda* ((b 21)) (+ (* 2 b) a)))
(define (f23 x) (lambda* ((c 21)) (+ (* 2 c) x)))
(+ ((f22 1) 2) ((f23 2) 3)))"
- "let (line 3): perhaps embed f23:
+ "let: perhaps embed f23:
(let () (define (f22 a) (lambda* ((b 21)) (+ (* 2 b) a))) (define (f23 x)... ->
(... (+ ((f22 1) 2) ((let ((x 2)) (lambda* ((c 21)) (+ (* 2 c) x))) 3)))
- f23 (line 2): f23 could be (define f23 f22)")
+ f23: f23 could be (define f23 f22)")
(lint-test "(let ()
(define (f1 x) (abs (* 2 (+ (car x) 1))))
(define (f2 . x) (abs (* 2 (+ (car x) 1))))
@@ -90754,18 +90922,18 @@ etc
(define (f1 . x) (abs (* 2 (+ (car x) 1))))
(define (f2 x) (abs (* 2 (+ (car x) 1))))
(+ (f1 2) (f2 '(3))))" ; these should not match!
- " let (line 3): perhaps embed f2:
+ " let: perhaps embed f2:
(let () (define (f1 . x) (abs (* 2 (+ (car x) 1)))) (define (f2 x) (abs (*... -> (... (+ (f1 2) (let ((x '(3))) (abs (* 2 (+ (car x) 1))))))")
(lint-test "(let ()
(define (f24 aa) (let ((z (+ aa 1))) (if (positive? z) (f24 (+ aa 1)) 0)))
(define (f25 x) (let ((w (+ x 1))) (if (positive? w) (f25 (+ x 1)) 0)))
(+ (f24 2) (f25 2)))"
- " f25 (line 2): f25 could be (define f25 f24)")
+ " f25: f25 could be (define f25 f24)")
(lint-test "(let ()
(define* (f26 (aa 1)) (let ((z (+ aa 1))) (if (positive? z) (f26 (+ aa 1)) 0)))
(define* (f27 (x 1)) (let ((w (+ x 1))) (if (positive? w) (f27 (+ x 1)) 0)))
(+ (f26 2) (f27 2)))"
- " f27 (line 2): f27 could be (define f27 f26)")
+ " f27: f27 could be (define f27 f26)")
(lint-test "(let ()
(define (f31 a b) (if (> a 0) (+ a b) b))
(define (f32 x y) (if (< 0 y) (+ x y) y))
@@ -90943,7 +91111,7 @@ etc
(lint-test "(let () (define (get-xyzzy a) (+ 1 (car a)))
(define (set-xyzzy a b) (cons (+ a 1) b))
(set-xyzzy x (get-xyzzy y)))"
- "let (line 2): perhaps change set-xyzzy to a let:
+ "let: perhaps change set-xyzzy to a let:
(let () (define (get-xyzzy a) (+ 1 (car a))) (define (set-xyzzy a b) (cons... -> (... (let ((a x) (b (get-xyzzy y))) ...))
let: perhaps use dilambda and generalized set! for get-xyzzy and set-xyzzy:
replace (get-xyzzy ...) with (xyzzy ...) and (set-xyzzy ... b) with (set! (xyzzy ...) b)
@@ -90951,7 +91119,7 @@ etc
(lint-test "(let () (define (xyzzy-ref a) (+ 1 (car a)))
(define (xyzzy-set! a b) (cons (+ a 1) b))
(xyzzy-set! x (xyzzy-ref y)))"
- "let (line 2): perhaps change xyzzy-set! to a let:
+ "let: perhaps change xyzzy-set! to a let:
(let () (define (xyzzy-ref a) (+ 1 (car a))) (define (xyzzy-set! a b)... -> (... (let ((a x) (b (xyzzy-ref y))) ...))
let: perhaps use dilambda and generalized set! for xyzzy-ref and xyzzy-set!:
replace (xyzzy-ref ...) with (xyzzy ...) and (xyzzy-set! ... b) with (set! (xyzzy ...) b)
@@ -90965,7 +91133,7 @@ etc
(lint-test "(let () (define (xyzzy-ref xyzzy b) (+ b (car xyzzy)))
(define (xyzzy-set! xyzzy b c) (list (+ xyzzy c) b))
(xyzzy-set! obj (xyzzy-ref obj y) z))"
- "let (line 2): perhaps change xyzzy-set! to a let:
+ "let: perhaps change xyzzy-set! to a let:
(let () (define (xyzzy-ref xyzzy b) (+ b (car xyzzy))) (define (xyzzy-set!... -> (... (let ((xyzzy obj) (b (xyzzy-ref obj y)) (c z)) ...))
let: perhaps use dilambda and generalized set! for xyzzy-ref and xyzzy-set!:
replace (xyzzy-ref ...) with (xyzzy ...) and (xyzzy-set! ... c) with (set! (xyzzy ...) c)
@@ -90973,7 +91141,7 @@ etc
(lint-test "(let () (define (xyz-get-zy xyzzy b) (+ b (car xyzzy)))
(define (xyz-set-zy xyzzy b c) (list (+ xyzzy c) b))
(xyz-set-zy obj (xyz-get-zy obj y) z))"
- "let (line 2): perhaps change xyz-set-zy to a let:
+ "let: perhaps change xyz-set-zy to a let:
(let () (define (xyz-get-zy xyzzy b) (+ b (car xyzzy))) (define... -> (... (let ((xyzzy obj) (b (xyz-get-zy obj y)) (c z)) ...))
let: perhaps use dilambda and generalized set! for xyz-get-zy and xyz-set-zy:
replace (xyz-get-zy ...) with (xyz-zy ...) and (xyz-set-zy ... c) with (set! (xyz-zy ...) c)
@@ -91338,11 +91506,16 @@ etc
(lint-test "(equal? x lint)" "")
(lint-test "(string x #\\xd)" " #\\xd is #\\return")
-; (lint-test "(let ((x ())) (set! x (cons 1 x)) (if x 3 2))" " let: x is never #f, so (if x 3 2) is 3")
-; (lint-test "(let ((x ())) (if x 3 2))" " let: x is never #f, so (if x 3 2) is 3")
+ (lint-test "(let ((x ())) (set! x (cons 1 x)) (if x 3 2))"
+ " let: x is never #f, so (if x 3 2) -> 3
+ let: perhaps (let ((x ())) (set! x (cons 1 x)) (if x 3 2)) -> (let ((x (cons 1 ()))) (if x 3 2))")
+ (lint-test "(let ((x ())) (if x 3 2))"
+ " let: perhaps (let ((x ())) (if x 3 2)) -> (if () 3 2)
+ let: x is never #f, so (if x 3 2) -> 3")
(lint-test "(let ((x ())) (if (pair? x) 3 2))" " let: perhaps (let ((x ())) (if (pair? x) 3 2)) -> (if (pair? ()) 3 2)")
-
-; (lint-test "(let ((x 0)) (if x 3 2))" " let: x is never #f, so (if x 3 2) is 3")
+ (lint-test "(let ((x 0)) (if x 3 2))"
+ " let: perhaps (let ((x 0)) (if x 3 2)) -> (if 0 3 2)
+ let: x is never #f, so (if x 3 2) -> 3")
(lint-test "(let ((x 0)) (if (zero? x) 3 2))"
" let: perhaps (let ((x 0)) (if (zero? x) 3 2)) -> (if (zero? 0) 3 2)
let: x is 0, so (zero? x) is #t")
@@ -91351,8 +91524,7 @@ etc
" let: perhaps (let ((x 0)) (set! x ()) (if (null? x) 3 2)) -> (let ((x ())) (if (null? x) 3 2))")
(lint-test "(let ((x 0)) (display x) (set! x ()) (if (null? x) 3 2))"
" let: perhaps combine these two lines: (set! x ()) (if (null? x) 3 2)")
-
-; (lint-test "(let ((x 0)) (when x 3))" " let: x is never #f, so (when x 3) is 3")
+ (lint-test "(let ((x 0)) (when x 3))" " let: perhaps (let ((x 0)) (when x 3)) -> (when 0 3) let: x is never #f, so (when x 3) -> 3")
(lint-test "(let ((x 0)) (when (zero? x) 3))"
" let: perhaps (let ((x 0)) (when (zero? x) 3)) -> (when (zero? 0) 3)
let: x is 0, so (zero? x) is #t")
@@ -91438,7 +91610,7 @@ etc
(make-env :envelope '(0 0 1 1)
:length (if (and (> (length args) 1) (number? (cadr args))) (cadr args)
(framples (if (> (length args) 2) (caddr args) (selected-sound))))) args)"
- " apply (line 3): perhaps (apply env-channel (make-env ...) args) ->
+ " apply: perhaps (apply env-channel (make-env ...) args) ->
(let ((_1_ (make-env ...))) (apply env-channel _1_ args))")
(let-temporarily ((*report-bloated-arg* 50))
(lint-test "(apply env-channel
@@ -91513,7 +91685,7 @@ etc
(lint-test "(throw 'oops \"throw: ~A~%\" x)" "")
(lint-test "(throw 'oops \"throw: ~A~%\" x y)" " throw: throw has too many arguments: (throw 'oops \"throw: ~A~%\" x y)")
(lint-test "(error 'oops \"error: ~A ~A~%\" x)" " error: error has too few arguments: (error 'oops \"error: ~A ~A~%\" x)")
- (lint-test "(catch #f (lambda () 1) (lambda args 2))" " catch (line 0): catch tag #f makes this catch a no-op")
+ (lint-test "(catch #f (lambda () 1) (lambda args 2))" " catch: catch tag #f makes this catch a no-op")
(lint-test "(define (f75) \"a string\")" " f75: returns a string constant: \"a string\"")
(lint-test "(define (f75) #i(0 1 2 3))" " f75: returns an int-vector constant: #i(0 1 2 3)")
@@ -91539,10 +91711,13 @@ etc
(cond ((string=? x \"a\") 1) ((string=? \"b\" x) 2) ((string=? x \"c\") 3))")
(lint-test "(cond ((< x 3) 1) ((> 2 x) 2) ((< x 1) 3))" "")
(let-temporarily ((*report-unused-parameters* #t))
- (lint-test "(define (f74 x) (let ((lst (list 1 2 3 4 5 6 7 8))) (list-ref lst 2)))" " f74: x not used")
+ (lint-test "(define (f74 x) (let ((lst (list 1 2 3 4 5 6 7 8))) (list-ref lst 2)))"
+ "f74: lst can be moved to f74's closure
+ f74: x not used")
(lint-test "(let () (define (f75 x) (let ((lst (list 1 2 3 4 5 6 7 8))) (list-ref lst 2))) (f75 2))"
" let: perhaps (... (define (f75 x) (let ((lst (list 1 2 3 4 5 6 7 8))) (list-ref lst... ->
(... (let ((x 2)) (let ((lst (list 1 2 3 4 5 6 7 8))) (list-ref lst 2))))
+ f75: lst can be moved to f75's closure
f75: x not used
let: f75's parameter 1 is not used, but a value is passed: 2"))
@@ -91550,7 +91725,7 @@ etc
(call-with-output-file "tmp1.r5rs"
(lambda (p)
(format p "(define (f x) (and (< x 3) (> x 0)))~%")))
- (lint-test "(load \"tmp1.r5rs\")" " --------------------- ;tmp1.r5rs f (line 1): perhaps (and (< x 3) (> x 0)) -> (< 0 x 3)"))
+ (lint-test "(load \"tmp1.r5rs\")" " --------------------- ;tmp1.r5rs f: perhaps (and (< x 3) (> x 0)) -> (< 0 x 3)"))
(lint-test "(or (< x 3) (> 3 x))" " or: perhaps (or (< x 3) (> 3 x)) -> (< x 3)")
(lint-test "(and (< x 3) (> 3 x))" " and: perhaps (and (< x 3) (> 3 x)) -> (< x 3)")
@@ -91593,7 +91768,7 @@ etc
" peek-char: (current-input-port) is the default port for peek-char: (peek-char (current-input-port))")
(lint-test "(write-char #\\newline)" " write-char: perhaps (write-char #\\newline) -> (newline)")
(lint-test "(write-char #\\newline port)" " write-char: perhaps (write-char #\\newline port) -> (newline port)")
- (lint-test "(write-string \"\n\")" " write-string (line 1): perhaps (write-string \"\n\") -> (newline)")
+ (lint-test "(write-string \"\n\")" " write-string: perhaps (write-string \"\n\") -> (newline)")
(lint-test "(write-string \"\")" " write-string: (write-string \"\") is pointless")
(lint-test "(char? #\\a)" " char?: perhaps (char? #\\a) -> #t")
(lint-test "(symbol->string (keyword->symbol :hi))" " symbol->string: perhaps (keyword->symbol :hi) -> 'hi")
@@ -91668,6 +91843,9 @@ etc
" s: perhaps (let ((s (open-output-string))) (write obj s) (let ((result... -> (object->string obj)")
(lint-test "(let ((x '(1 2 3))) (display (car x)) (display (list-ref x y)) (list-ref x 1))" " let: x could be a vector, rather than a list")
(lint-test "(let ((x '(1 2 3))) (display (car x)) (display (x y)) (x 1))" " let: x could be a vector, rather than a list")
+ (lint-test "(display 123 #f)" " display: (display 123 #f) could be 123")
+ (lint-test "(write 123 #f)" " write: (write 123 #f) could be 123")
+ (lint-test "(newline #f)" " newline: (newline #f) is a no-op, returning #<unspecified>")
(lint-test "(define (func x) (if (or x 1/0+i) 3))" " func: perhaps (or x nan+1i) -> (or x nan+1i)") ; infinite loop
(lint-test "(if (and x 1/0) 3)" " if: perhaps (and x nan.0) -> (and x nan.0)")
(lint-test "(cond ((number? x) 4) ((integer? x) 3) ((list? x) 0) ((pair? x) 1))"
@@ -91785,13 +91963,13 @@ etc
func: stray dot in begin? (begin cdddar . and)
func: in (port-line-number 2 (exp 1)), port-line-number's argument 1 should be an input-port or null, but 2 is an integer?")
(lint-test "(define (func x) (if (char<? (vector (defined?))) (define-constant +(random-state->list -)) (hash-table? (define-macro* + (list ()) `(x 1) :hi 1+0/0i))))"
- " func (line 0): char<? needs at least 2 arguments: (char<? (vector (defined?)))
- func (line 0): in (char<? (vector (defined?))), char<?'s argument should be a char, but (vector (defined?)) is a vector?
- func (line 0): defined? needs at least 1 argument: (defined?)
- + (line 0): in (random-state->list -), random-state->list's argument should be a random-state, but - is a procedure?
- func (line 0): + in (define-macro* + (list ()) '(x 1) :hi 1nani) is already a constant, defined (line 0): (random-state->list -)
- func (line 0): (define-macro* + (list ()) '(x 1) :hi 1nani) is messed up
- func (line 0): + not used, initially: (random-state->list -) from define-constant")
+ " func: char<? needs at least 2 arguments: (char<? (vector (defined?)))
+ func: in (char<? (vector (defined?))), char<?'s argument should be a char, but (vector (defined?)) is a vector?
+ func: defined? needs at least 1 argument: (defined?)
+ +: in (random-state->list -), random-state->list's argument should be a random-state, but - is a procedure?
+ func: + in (define-macro* + (list ()) '(x 1) :hi 1nani) is already a constant, defined: (random-state->list -)
+ func: (define-macro* + (list ()) '(x 1) :hi 1nani) is messed up
+ func: + not used, initially: (random-state->list -) from define-constant")
(lint-test "(define (func x) (if (arity (apply +)) (caaadr /) (begin .. when `((x . 1)) . 0/0+0/0i)))"
" func: perhaps (apply +) -> (+)
func: in (caaadr /), caaadr's argument should be a pair, but / is a procedure?
@@ -91819,7 +91997,9 @@ etc
func: in (caaadr /), caaadr's argument should be a pair, but / is a procedure?
hi: func's parameter 1 is not used, but a value is passed: (make-hook '(0 0 #f))")
(lint-test "(define (func x) (case x ((else) (char>? 11/(symbol-access))) ((-1) (load - -1 3/4)) (else (positive? (format 0(inlet (make-list)))))))"
- " func: symbol-access needs at least 1 argument: (symbol-access)
+ " func: in (char>? 11/ (symbol-access)),
+ char>?'s argument 2 should be a char, but (symbol-access) is a boolean or a procedure?
+ func: symbol-access needs at least 1 argument: (symbol-access)
func: load has too many arguments: (load - -1 3/4)
func: in (load - -1 3/4), load's argument 1 should be a string, but - is a procedure?
func: in (load - -1 3/4), load's argument 2 should be a let, but -1 is an integer?
@@ -91827,6 +92007,7 @@ etc
func: in (positive? (format 0 (inlet (make-list)))),
positive?'s argument should be real, but (format 0 (inlet (make-list))) is a string or a boolean?
func: make-list needs at least 1 argument: (make-list)")
+ (lint-test "(zero? (system str))" "")
(lint-test "(define (func x) (if (- 2(+)) (lambda 1.)))"
" func: if test is never false: (if (- 2 (+)) (lambda 1.0))
func: perhaps (- 2 (+)) -> 2
@@ -91911,6 +92092,21 @@ etc
func: bad case key dilambda in (dilambda i let +i (list (list 1)) let . cons)
func: stray dot? (i let +i (list (list 1)) let . cons)")
+ ;; this tickles an infinite recursion bug that is still in lint, but hacked around for now
+ (lint-test "(let* ((seed 0)
+ (hashfn (lambda (obj)
+ (cond ((string? obj) (let ((sl (string-length obj))) (+ (if (> sl 0) (hashfn obj) seed) (if (> sl 1) (hashfn obj) seed))))
+ ((else #f))))))
+ (modulo (hashfn obj) size))"
+ " let*: perhaps restrict seed which is not used in the let* body
+ (let* ((seed 0) (hashfn (lambda (obj) (cond ((string? obj) (let ((sl... ->
+ (let ((hashfn (let ((seed 0))
+ (lambda (obj)
+ (cond ((string? obj)
+ (let ((sl (string-length obj)))
+ (+ (if (> sl 0) (hashfn obj) seed) (if (> sl 1) (hashfn obj) seed))))
+ ((else #f))))))) ...)")
+
(let ()
(define (glint str1)
(let ((result (call-with-output-string
diff --git a/snd-0.h b/snd-0.h
index 309a3f3..4f7e373 100644
--- a/snd-0.h
+++ b/snd-0.h
@@ -9,12 +9,6 @@
#define DISPLAY(Obj) s7_object_to_c_string(s7, Obj)
#endif
-#if (SIZEOF_VOID_P == 4)
- typedef int pointer_or_int_t;
-#else
- typedef long long int pointer_or_int_t;
-#endif
-
#ifndef STRFTIME_FORMAT
#define STRFTIME_FORMAT "%a %d-%b-%Y %H:%M %Z"
#endif
diff --git a/snd-chn.c b/snd-chn.c
index d28a4e7..48f4af8 100644
--- a/snd-chn.c
+++ b/snd-chn.c
@@ -1417,7 +1417,7 @@ static void display_selection_transform_size(chan_info *cp, axis_info *fap, grap
y0 = fap->height + fap->y_offset + SELECTION_FFT_LABEL_OFFSET;
x0 = fap->x_axis_x0 + 20;
snprintf(chn_id_str, LABEL_BUFFER_SIZE,
- "(len: %lld/%lld)",
+ "(len: %" PRId64 "/%" PRId64 ")",
selection_len(),
cp->selection_transform_size);
draw_string(copy_context(cp), x0, y0, chn_id_str, strlen(chn_id_str));
@@ -4782,14 +4782,14 @@ void show_cursor_info(chan_info *cp)
expr_str = (char *)calloc(len, sizeof(char));
if (sp->nchans == 1)
- snprintf(expr_str, PRINT_BUFFER_SIZE, "cursor at %s (sample %lld) = %s",
+ snprintf(expr_str, PRINT_BUFFER_SIZE, "cursor at %s (sample %" PRId64 ") = %s",
s1 = x_axis_location_to_string(cp, (double)samp / (double)snd_srate(sp)),
samp,
s2 = prettyf(y, digits));
else
{
if (sp->sync == 0)
- snprintf(expr_str, PRINT_BUFFER_SIZE, "chan %d, cursor at %s (sample %lld) = %s",
+ snprintf(expr_str, PRINT_BUFFER_SIZE, "chan %d, cursor at %s (sample %" PRId64 ") = %s",
cp->chan + 1,
s1 = x_axis_location_to_string(cp, (double)samp / (double)snd_srate(sp)),
samp,
@@ -4798,7 +4798,7 @@ void show_cursor_info(chan_info *cp)
{
/* in this case, assume we show all on chan 0 and ignore the call otherwise (see above) */
/* "cursor at..." then list of values */
- snprintf(expr_str, PRINT_BUFFER_SIZE, "cursor at %s (sample %lld): %s",
+ snprintf(expr_str, PRINT_BUFFER_SIZE, "cursor at %s (sample %" PRId64 "): %s",
s1 = x_axis_location_to_string(cp, (double)samp / (double)snd_srate(sp)),
samp,
s2 = prettyf(y, digits));
@@ -5696,13 +5696,13 @@ void graph_button_release_callback(chan_info *cp, int x, int y, int key_state, i
samp = mark_sample(mouse_mark);
sync = mark_sync(mouse_mark);
if (sync == 0)
- status_report(sp, "mark %d at sample %lld (%3f secs): %3f",
+ status_report(sp, "mark %d at sample %" PRId64 " (%3f secs): %3f",
mark_to_int(mouse_mark),
samp,
(double)samp / (double)(snd_srate(sp)),
chn_sample(samp, cp, cp->edit_ctr));
else
- status_report(sp, "mark %d at sample %lld (%3f secs): %3f, (sync: %d)",
+ status_report(sp, "mark %d at sample %" PRId64 " (%3f secs): %3f, (sync: %d)",
mark_to_int(mouse_mark),
samp,
(double)samp / (double)(snd_srate(sp)),
@@ -7592,7 +7592,7 @@ static Xen g_maxamp(Xen snd, Xen chn_n, Xen edpos)
if (save_maxamp)
{
mus_long_t *times = NULL;
- /* fprintf(stderr, "save g_maxamp for %s (%d %lld)\n", sp->filename, mus_sound_maxamp_exists(sp->filename), sp->chans[0]->edits[0]->samples); */
+ /* fprintf(stderr, "save g_maxamp for %s (%d %" PRId64 ")\n", sp->filename, mus_sound_maxamp_exists(sp->filename), sp->chans[0]->edits[0]->samples); */
vals = (mus_float_t *)calloc(sp->nchans, sizeof(mus_float_t));
times = (mus_long_t *)calloc(sp->nchans, sizeof(mus_long_t));
for (i = 0; i < sp->nchans; i++)
@@ -9024,7 +9024,7 @@ void write_transform_peaks(FILE *fd, chan_info *ucp)
{
fprintf(fd, "%s", sp->short_filename);
if (sp->nchans > 1) fprintf(fd, ": chan %d", cp->chan);
- fprintf(fd, ", fft %lld points beginning at sample %lld (%.3f secs), %s\n\n",
+ fprintf(fd, ", fft %" PRId64 " points beginning at sample %" PRId64 " (%.3f secs), %s\n\n",
fp->current_size,
ap->losamp,
(float)((double)(ap->losamp) / (double)srate),
@@ -9288,6 +9288,7 @@ If 'data' is a list of numbers, it is treated as an envelope."
Xen snd = Xen_undefined, chn_n = Xen_undefined, force_display = Xen_undefined, show_axes = Xen_undefined;
/* ldata can be a vct or a list of numbers or vcts */
+ Xen_check_type(Xen_is_pair(args), args, 1, S_graph, "a " S_vct " or a list");
arg = args;
ldata = Xen_car(arg);
Xen_check_type(((mus_is_vct(ldata)) ||
diff --git a/snd-dac.c b/snd-dac.c
index ed95aa9..d74370f 100644
--- a/snd-dac.c
+++ b/snd-dac.c
@@ -2768,7 +2768,11 @@ static Xen s7_xen_player_length(s7_scheme *sc, Xen player)
static void init_xen_player(void)
{
#if HAVE_SCHEME
- xen_player_tag = s7_new_type_x(s7, "<player>", print_xen_player, free_xen_player, s7_xen_player_equalp, NULL, NULL, NULL, s7_xen_player_length, NULL, NULL, NULL);
+ xen_player_tag = s7_make_c_type(s7, "<player>");
+ s7_c_type_set_print(s7, xen_player_tag, print_xen_player);
+ s7_c_type_set_free(s7, xen_player_tag, free_xen_player);
+ s7_c_type_set_equal(s7, xen_player_tag, s7_xen_player_equalp);
+ s7_c_type_set_length(s7, xen_player_tag, s7_xen_player_length);
#else
#if HAVE_RUBY
xen_player_tag = Xen_make_object_type("XenPlayer", sizeof(xen_player));
@@ -2823,7 +2827,7 @@ static Xen play_file(const char *play_name, mus_long_t start, mus_long_t end, in
return(Xen_false);
}
-
+#if (!HAVE_SCHEME)
static Xen kw_start, kw_end, kw_channel, kw_wait, kw_edit_position, kw_stop, kw_out_channel, kw_with_sync, kw_srate, kw_channels;
static void init_play_keywords(void)
@@ -2839,9 +2843,8 @@ static void init_play_keywords(void)
kw_srate = Xen_make_keyword("srate");
kw_channels = Xen_make_keyword("channels");
}
+#endif
-static Xen g_play(Xen arglist)
-{
#if HAVE_SCHEME
#define play_example "(play \"oboe.snd\")"
#endif
@@ -2852,13 +2855,124 @@ static Xen g_play(Xen arglist)
#define play_example "\"oboe.snd\" play"
#endif
- #define H_play "(" S_play " object :start :end :channel :edit-position :out-channel :with-sync :wait :stop): \
+#define H_play "(" S_play " object start end channel edit-position out-channel with-sync wait stop srate channels): \
play the object from start to end. If channel is not given, play all channels. If with-sync, play all objects sync'd \
to the current object. If wait, wait for the play process to finish before going on. If out-channel, send the samples \
to that DAC channel. If edit-position, play that member of the edit list, otherwise play the current state of the object. \
If stop, call that function when the play process finishes. \
If object is a string, it is assumed to be a file name: \n " play_example "\n."
+#if HAVE_SCHEME
+static s7_pointer g_play(s7_scheme *sc, s7_pointer args)
+{
+ s7_pointer object, p, fp;
+ mus_long_t start, end;
+ int channel, out_channel, srate, channels, edpos_argpos = 4, channel_argpos = 3;
+ bool with_sync;
+#if (!USE_NO_GUI)
+ bool wait;
+#endif
+ s7_pointer stop_func, edit_position, channel_arg;
+ play_process_t background;
+ snd_info *sp;
+
+ object = s7_car(args);
+ args = s7_cdr(args);
+
+ fp = s7_car(args);
+ if (fp == Xen_false)
+ start = 0;
+ else
+ {
+ if (!s7_is_integer(fp))
+ return(s7_wrong_type_arg_error(sc, S_play, 1, fp, "an integer (start)"));
+ start = s7_integer(fp);
+ if (start < 0)
+ Xen_out_of_range_error(S_play, 1, fp, "start is negative?");
+ }
+
+ fp = s7_cadr(args);
+ if (fp == Xen_false)
+ end = NO_END_SPECIFIED;
+ else
+ {
+ if (!s7_is_integer(fp))
+ return(s7_wrong_type_arg_error(sc, S_play, 2, fp, "an integer (end)"));
+ end = s7_integer(fp);
+ if (end < -1)
+ Xen_out_of_range_error(S_play, 2, fp, "end is negative?");
+ }
+
+ p = s7_cddr(args);
+ fp = s7_car(p);
+ channel_arg = fp;
+ if (fp == Xen_false)
+ channel = -1;
+ else
+ {
+ if (!s7_is_integer(fp))
+ return(s7_wrong_type_arg_error(sc, S_play, 3, fp, "an integer (channel)"));
+ channel = s7_integer(fp);
+ }
+
+ edit_position = s7_cadr(p);
+
+ p = s7_cddr(p);
+ fp = s7_car(p);
+ if (fp == Xen_false)
+ out_channel = -1;
+ else
+ {
+ if (!s7_is_integer(fp))
+ return(s7_wrong_type_arg_error(sc, S_play, 5, fp, "an integer (out channel)"));
+ out_channel = s7_integer(fp);
+ }
+
+ fp = s7_cadr(p);
+ with_sync = (fp != Xen_false);
+
+ p = s7_cddr(p);
+#if (!USE_NO_GUI)
+ fp = s7_car(p);
+ wait = (fp != Xen_false);
+#endif
+
+ stop_func = s7_cadr(p);
+ if ((stop_func != Xen_false) &&
+ (!s7_is_procedure(stop_func)))
+ return(s7_wrong_type_arg_error(sc, S_play, 8, stop_func, "a procedure (stop)"));
+ if ((s7_is_procedure(stop_func)) &&
+ (!s7_is_aritable(sc, stop_func, 1)))
+ Xen_bad_arity_error(S_play, 8, fp, "stop function should take 1 argument");
+
+ p = s7_cddr(p);
+ fp = s7_car(p);
+ if (fp == Xen_false)
+ srate = 44100;
+ else
+ {
+ if (!s7_is_integer(fp))
+ return(s7_wrong_type_arg_error(sc, S_play, 9, fp, "an integer (srate)"));
+ srate = s7_integer(fp);
+ if (srate <= 0)
+ Xen_out_of_range_error(S_play, 9, fp, "srate <= 0?");
+ }
+
+ fp = s7_cadr(p);
+ if (fp == Xen_false)
+ channels = 2;
+ else
+ {
+ if (!s7_is_integer(fp))
+ return(s7_wrong_type_arg_error(sc, S_play, 10, fp, "an integer (channels)"));
+ channels = s7_integer(fp);
+ if (channels <= 0)
+ Xen_out_of_range_error(S_play, 10, fp, "channels <= 0?");
+ }
+
+#else
+static Xen g_play(Xen arglist)
+{
Xen object = Xen_undefined;
mus_long_t start = 0, end = NO_END_SPECIFIED;
int channel = -1, out_channel = -1, srate = 44100, channels = 2, edpos_argpos = 0, channel_argpos = 0;
@@ -2934,6 +3048,7 @@ If object is a string, it is assumed to be a file name: \n " play_example "\n
Xen_out_of_range_error(S_play, orig_arg[9], keys[9], "channels <= 0?");
}
}
+#endif
#if USE_NO_GUI
background = NOT_IN_BACKGROUND;
@@ -3434,7 +3549,9 @@ static Xen g_set_with_tracking_cursor(Xen on)
Xen_wrap_no_args(g_with_tracking_cursor_w, g_with_tracking_cursor)
Xen_wrap_1_arg(g_set_with_tracking_cursor_w, g_set_with_tracking_cursor)
+#if (!HAVE_SCHEME)
Xen_wrap_any_args(g_play_w, g_play)
+#endif
Xen_wrap_1_optional_arg(g_stop_playing_w, g_stop_playing)
Xen_wrap_2_optional_args(g_make_player_w, g_make_player)
Xen_wrap_6_optional_args(g_add_player_w, g_add_player)
@@ -3480,9 +3597,13 @@ void g_init_dac(void)
#endif
init_xen_player();
+#if (!HAVE_SCHEME)
init_play_keywords();
-
Xen_define_typed_procedure(S_play, g_play_w, 0, 0, 1, H_play, pcl_t);
+#else
+ s7_define_function_star(s7, S_play, g_play, "(object #<undefined>) start end channel edit-position out-channel with-sync wait stop srate channels", H_play);
+#endif
+
Xen_define_typed_procedure(S_stop_playing, g_stop_playing_w, 0, 1, 0, H_stop_playing, s7_make_signature(s7, 2, b, t));
Xen_define_typed_procedure(S_make_player, g_make_player_w, 0, 2, 0, H_make_player, s7_make_signature(s7, 3, pl, t, t));
Xen_define_typed_procedure(S_add_player, g_add_player_w, 1, 5, 0, H_add_player, s7_make_signature(s7, 7, pl, pl, i, i, t, t, i));
diff --git a/snd-edits.c b/snd-edits.c
index 6aab459..ac6278c 100644
--- a/snd-edits.c
+++ b/snd-edits.c
@@ -1431,15 +1431,15 @@ static void display_ed_list(chan_info *cp, FILE *outp, int i, ed_list *ed)
len = ed->size; /* number of fragments in this list */
switch (ed->edit_type)
{
- case INSERTION_EDIT: fprintf(outp, "\n (insert %lld %lld) ", ed->beg, ed->len); break;
- case DELETION_EDIT: fprintf(outp, "\n (delete %lld %lld) ", ed->beg, ed->len); break;
- case CHANGE_EDIT: fprintf(outp, "\n (set %lld %lld) ", ed->beg, ed->len); break;
- case SCALED_EDIT: fprintf(outp, "\n (scale %lld %lld) ", ed->beg, ed->len); break;
- case ZERO_EDIT: fprintf(outp, "\n (silence %lld %lld) ", ed->beg, ed->len); break;
- case RAMP_EDIT: fprintf(outp, "\n (ramp %lld %lld) ", ed->beg, ed->len); break;
+ case INSERTION_EDIT: fprintf(outp, "\n (insert %" PRId64 " %" PRId64 ") ", ed->beg, ed->len); break;
+ case DELETION_EDIT: fprintf(outp, "\n (delete %" PRId64 " %" PRId64 ") ", ed->beg, ed->len); break;
+ case CHANGE_EDIT: fprintf(outp, "\n (set %" PRId64 " %" PRId64 ") ", ed->beg, ed->len); break;
+ case SCALED_EDIT: fprintf(outp, "\n (scale %" PRId64 " %" PRId64 ") ", ed->beg, ed->len); break;
+ case ZERO_EDIT: fprintf(outp, "\n (silence %" PRId64 " %" PRId64 ") ", ed->beg, ed->len); break;
+ case RAMP_EDIT: fprintf(outp, "\n (ramp %" PRId64 " %" PRId64 ") ", ed->beg, ed->len); break;
case EXTEND_EDIT: fprintf(outp, "\n (extend edit list with no-op)"); break;
- case MIX_EDIT: fprintf(outp, "\n (mix %lld %lld) ", ed->beg, ed->len); break;
- case CHANGE_MIX_EDIT: fprintf(outp, "\n (change mix %lld %lld) ", ed->beg, ed->len); break;
+ case MIX_EDIT: fprintf(outp, "\n (mix %" PRId64 " %" PRId64 ") ", ed->beg, ed->len); break;
+ case CHANGE_MIX_EDIT: fprintf(outp, "\n (change mix %" PRId64 " %" PRId64 ") ", ed->beg, ed->len); break;
case INITIALIZE_EDIT: fprintf(outp, "\n (begin) "); break;
default: break;
}
@@ -1450,12 +1450,12 @@ static void display_ed_list(chan_info *cp, FILE *outp, int i, ed_list *ed)
int index;
index = FRAGMENT_SOUND(ed, j);
if (index == EDIT_LIST_END_MARK)
- fprintf(outp, "\n (at %lld, end_mark)", FRAGMENT_GLOBAL_POSITION(ed, j));
+ fprintf(outp, "\n (at %" PRId64 ", end_mark)", FRAGMENT_GLOBAL_POSITION(ed, j));
else
{
int typ;
typ = FRAGMENT_TYPE(ed, j);
- fprintf(outp, "\n (at %lld, cp->sounds[%d][%lld:%lld, %.3f",
+ fprintf(outp, "\n (at %" PRId64 ", cp->sounds[%d][%" PRId64 ":%" PRId64 ", %.3f",
FRAGMENT_GLOBAL_POSITION(ed, j),
index,
FRAGMENT_LOCAL_POSITION(ed, j),
@@ -1495,7 +1495,7 @@ static void display_ed_list(chan_info *cp, FILE *outp, int i, ed_list *ed)
for (i = 0; i < mxs->size; i++)
{
if (MIX_LIST_STATE(mxs, i))
- fprintf(outp, ", ([%d]: %d %.3f %lld)",
+ fprintf(outp, ", ([%d]: %d %.3f %" PRId64 ")",
i,
MIX_LIST_INDEX(mxs, i),
MIX_LIST_SCALER(mxs, i),
@@ -1514,7 +1514,7 @@ static void display_ed_list(chan_info *cp, FILE *outp, int i, ed_list *ed)
fprintf(outp, " [file: %s[%d]]", sd->filename, sd->chan);
else
if (sd->type == SND_DATA_BUFFER)
- fprintf(outp, " [buf: %lld] ", sd->data_bytes / sizeof(mus_float_t));
+ fprintf(outp, " [buf: %" PRId64 "] ", sd->data_bytes / sizeof(mus_float_t));
else fprintf(outp, " [bogus!]");
}
}
@@ -1545,14 +1545,14 @@ char *edit_to_string(chan_info *cp, int edit)
/* only for edit list in snd-g|xchn.c */
#if HAVE_FORTH
- return(mus_format("%s : %lld %lld %s",
+ return(mus_format("%s : %" PRId64 " %" PRId64 " %s",
ed->origin,
ed->beg, ed->len,
edit_names[(int)(ed->edit_type)]));
#endif
#if HAVE_RUBY
- return(mus_format("%s : %s(%lld, %lld)",
+ return(mus_format("%s : %s(%" PRId64 ", %" PRId64 ")",
ed->origin,
edit_names[(int)(ed->edit_type)],
ed->beg, ed->len));
@@ -1560,7 +1560,7 @@ char *edit_to_string(chan_info *cp, int edit)
#endif
#if HAVE_SCHEME
- return(mus_format("%s : (%s %lld %lld)",
+ return(mus_format("%s : (%s %" PRId64 " %" PRId64 ")",
ed->origin,
edit_names[(int)(ed->edit_type)],
ed->beg, ed->len));
@@ -1953,29 +1953,29 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
return;
}
#if HAVE_RUBY
- fprintf(fd, " %s(\"%s\", %lld, sfile, %d, ", to_proc_name(S_override_samples_with_origin), nfile, len, cp->chan);
+ fprintf(fd, " %s(\"%s\", %" PRId64 ", sfile, %d, ", to_proc_name(S_override_samples_with_origin), nfile, len, cp->chan);
if (ed->origin)
fprintf_with_possible_embedded_string(fd, ed->origin);
else fprintf(fd, "\"\"");
- fprintf(fd, ", [%d, %lld])\n",
+ fprintf(fd, ", [%d, %" PRId64 "])\n",
(int)mus_sound_write_date(nfile),
mus_sound_length(nfile));
#endif
#if HAVE_SCHEME
- fprintf(fd, " (%s \"%s\" %lld sfile %d ", S_override_samples_with_origin, nfile, len, cp->chan);
+ fprintf(fd, " (%s \"%s\" %" PRId64 " sfile %d ", S_override_samples_with_origin, nfile, len, cp->chan);
if (ed->origin)
fprintf_with_possible_embedded_string(fd, ed->origin);
else fprintf(fd, "\"\"");
- fprintf(fd, " (list %d %lld))\n",
+ fprintf(fd, " (list %d %" PRId64 "))\n",
(int)mus_sound_write_date(nfile),
mus_sound_length(nfile));
#endif
#if HAVE_FORTH
- fprintf(fd, " \"%s\" %lld sfile %d ", nfile, len, cp->chan);
+ fprintf(fd, " \"%s\" %" PRId64 " sfile %d ", nfile, len, cp->chan);
if (ed->origin)
fprintf_with_possible_embedded_string(fd, ed->origin);
else fprintf(fd, "\"\"");
- fprintf(fd, " '( %d %lld ) %s drop\n",
+ fprintf(fd, " '( %d %" PRId64 " ) %s drop\n",
(int)mus_sound_write_date(nfile),
mus_sound_length(nfile),
S_override_samples_with_origin);
@@ -1997,7 +1997,7 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
case INSERTION_EDIT:
/* samp data snd chn */
forth_func = S_insert_samples_with_origin;
- fprintf(fd, "%lld %lld ",
+ fprintf(fd, "%" PRId64 " %" PRId64 " ",
ed->beg,
ed->len);
if (ed->origin)
@@ -2010,7 +2010,7 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
case DELETION_EDIT:
/* samp samps snd chn */
forth_func = S_delete_samples;
- fprintf(fd, "%lld %lld sfile %d",
+ fprintf(fd, "%" PRId64 " %" PRId64 " sfile %d",
ed->beg,
ed->len,
cp->chan);
@@ -2018,7 +2018,7 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
case CHANGE_EDIT:
forth_func = S_change_samples_with_origin;
- fprintf(fd, "%lld %lld ",
+ fprintf(fd, "%" PRId64 " %" PRId64 " ",
ed->beg,
ed->len);
if (ed->origin)
@@ -2034,7 +2034,7 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
case ZERO_EDIT:
forth_func = S_pad_channel;
- fprintf(fd, "%lld %lld sfile %d",
+ fprintf(fd, "%" PRId64 " %" PRId64 " sfile %d",
ed->beg,
ed->len,
cp->chan);
@@ -2074,7 +2074,7 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
{
case INSERTION_EDIT:
/* samp data snd chn */
- fprintf(fd, "%s" PROC_OPEN "%lld" PROC_SEP "%lld" PROC_SEP,
+ fprintf(fd, "%s" PROC_OPEN "%" PRId64 PROC_SEP "%" PRId64 PROC_SEP,
to_proc_name(S_insert_samples_with_origin),
ed->beg,
ed->len);
@@ -2088,7 +2088,7 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
case DELETION_EDIT:
/* samp samps snd chn */
- fprintf(fd, "%s" PROC_OPEN "%lld" PROC_SEP "%lld" PROC_SEP "sfile" PROC_SEP "%d",
+ fprintf(fd, "%s" PROC_OPEN "%" PRId64 PROC_SEP "%" PRId64 PROC_SEP "sfile" PROC_SEP "%d",
to_proc_name(S_delete_samples),
ed->beg,
ed->len,
@@ -2096,7 +2096,7 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
break;
case CHANGE_EDIT:
- fprintf(fd, "%s" PROC_OPEN "%lld" PROC_SEP "%lld" PROC_SEP,
+ fprintf(fd, "%s" PROC_OPEN "%" PRId64 PROC_SEP "%" PRId64 PROC_SEP,
to_proc_name(S_change_samples_with_origin),
ed->beg,
ed->len);
@@ -2119,7 +2119,7 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
break;
case ZERO_EDIT:
- fprintf(fd, "%s" PROC_OPEN "%lld" PROC_SEP "%lld" PROC_SEP "sfile" PROC_SEP "%d",
+ fprintf(fd, "%s" PROC_OPEN "%" PRId64 PROC_SEP "%" PRId64 PROC_SEP "sfile" PROC_SEP "%d",
to_proc_name(S_pad_channel),
ed->beg,
ed->len,
@@ -2171,17 +2171,17 @@ void edit_history_to_file(FILE *fd, chan_info *cp, bool with_save_state_hook)
if (nfile)
{
#if HAVE_SCHEME
- fprintf(fd, " (list %d %lld)",
+ fprintf(fd, " (list %d %" PRId64 ")",
(int)mus_sound_write_date(nfile),
mus_sound_length(nfile));
#endif
#if HAVE_RUBY
- fprintf(fd, ", [%d, %lld]",
+ fprintf(fd, ", [%d, %" PRId64 "]",
(int)mus_sound_write_date(nfile),
mus_sound_length(nfile));
#endif
#if HAVE_FORTH
- fprintf(fd, " '( %d %lld )",
+ fprintf(fd, " '( %d %" PRId64 " )",
(int)mus_sound_write_date(nfile),
mus_sound_length(nfile));
#endif
@@ -2287,7 +2287,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
/* save data in temp file, use insert-samples with file name */
char *ofile;
ofile = edit_list_data_to_temp_file(cp, ed, DELETE_ME, false);
- function = mus_format("%s\n (%s %lld %lld \"%s\" snd chn)", old_function, S_insert_samples, ed->beg, ed->len, ofile);
+ function = mus_format("%s\n (%s %" PRId64 " %" PRId64 " \"%s\" snd chn)", old_function, S_insert_samples, ed->beg, ed->len, ofile);
free(ofile);
}
else function = mus_format("%s\n (%s snd chn)", old_function, ed->origin);
@@ -2300,7 +2300,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
/* save data in temp file, use set-samples with file name */
char *ofile;
ofile = edit_list_data_to_temp_file(cp, ed, DELETE_ME, false);
- function = mus_format("%s\n (set-samples %lld %lld \"%s\" snd chn)", old_function, ed->beg, ed->len, ofile);
+ function = mus_format("%s\n (set-samples %" PRId64 " %" PRId64 " \"%s\" snd chn)", old_function, ed->beg, ed->len, ofile);
free(ofile);
}
else
@@ -2312,7 +2312,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
break;
case DELETION_EDIT:
- function = mus_format("%s\n (%s %lld %lld snd chn)", old_function, S_delete_samples, ed->beg, ed->len);
+ function = mus_format("%s\n (%s %" PRId64 " %" PRId64 " snd chn)", old_function, S_delete_samples, ed->beg, ed->len);
break;
case SCALED_EDIT:
@@ -2329,7 +2329,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
case ZERO_EDIT:
/* origin here is useless (see extend_with_zeros cases) */
- function = mus_format("%s\n (%s %lld %lld snd chn)", old_function, S_pad_channel, ed->beg, ed->len);
+ function = mus_format("%s\n (%s %" PRId64 " %" PRId64 " snd chn)", old_function, S_pad_channel, ed->beg, ed->len);
break;
case MIX_EDIT:
@@ -2412,7 +2412,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
/* save data in temp file, use insert-samples with file name */
char *ofile;
ofile = edit_list_data_to_temp_file(cp, ed, DELETE_ME, false);
- function = mus_format("%s %s(%lld, %lld, \"%s\", snd, chn)",
+ function = mus_format("%s %s(%" PRId64 ", %" PRId64 ", \"%s\", snd, chn)",
function, to_proc_name(S_insert_samples), ed->beg, ed->len, ofile);
free(ofile);
}
@@ -2427,7 +2427,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
/* save data in temp file, use set-samples with file name */
char *ofile;
ofile = edit_list_data_to_temp_file(cp, ed, DELETE_ME, false);
- function = mus_format("%s set_samples(%lld, %lld, \"%s\", snd, chn)",
+ function = mus_format("%s set_samples(%" PRId64 ", %" PRId64 ", \"%s\", snd, chn)",
function, ed->beg, ed->len, ofile);
free(ofile);
}
@@ -2442,7 +2442,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
break;
case DELETION_EDIT:
- function = mus_format("%s%s %s(%lld, %lld, snd, chn)",
+ function = mus_format("%s%s %s(%" PRId64 ", %" PRId64 ", snd, chn)",
function, (first) ? "" : ";", to_proc_name(S_delete_samples), ed->beg, ed->len);
break;
@@ -2460,7 +2460,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
case ZERO_EDIT:
/* origin here is useless (see extend_with_zeros cases) */
- function = mus_format("%s%s %s(%lld, %lld, snd, chn)",
+ function = mus_format("%s%s %s(%" PRId64 ", %" PRId64 ", snd, chn)",
function, (first) ? "" : ";", to_proc_name(S_pad_channel), ed->beg, ed->len);
break;
@@ -2556,7 +2556,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
}
break;
case DELETION_EDIT:
- function = mus_format("%s %lld %lld snd chn %s drop",
+ function = mus_format("%s %" PRId64 " %" PRId64 " snd chn %s drop",
function, ed->beg, ed->len, S_delete_samples);
break;
case INSERTION_EDIT:
@@ -2578,7 +2578,7 @@ char *edit_list_to_function(chan_info *cp, int start_pos, int end_pos)
case ZERO_EDIT:
/* origin here is unpredictable -- most of these extensions should be backed-over and invisible */
/* the one case that should survive (pad-channel) just passes its name as the origin */
- function = mus_format("%s %lld %lld snd chn %s drop",
+ function = mus_format("%s %" PRId64 " %" PRId64 " snd chn %s drop",
function, ed->beg, ed->len, S_pad_channel);
break;
@@ -3640,10 +3640,10 @@ bool insert_complete_file(snd_info *sp, const char *str, mus_long_t chan_beg, fi
char *origin;
ncp = sp->chans[i];
#if HAVE_FORTH
- origin = mus_format("\"%s\" %lld %d %s drop",
+ origin = mus_format("\"%s\" %" PRId64 " %d %s drop",
filename, chan_beg, j, S_insert_sound);
#else
- origin = mus_format("%s" PROC_OPEN "\"%s\"" PROC_SEP "%lld" PROC_SEP "%d",
+ origin = mus_format("%s" PROC_OPEN "\"%s\"" PROC_SEP "%" PRId64 PROC_SEP "%d",
to_proc_name(S_insert_sound), filename, chan_beg, j);
#endif
ok = file_insert_samples(chan_beg, len, filename, ncp, j, auto_delete, origin, ncp->edit_ctr);
@@ -3737,17 +3737,17 @@ static ed_list *delete_section_from_list(mus_long_t beg, mus_long_t num, ed_list
new_state->beg = beg;
new_state->len = num;
#if HAVE_FORTH
- new_state->origin = mus_format("%lld %lld %s drop", beg, num, S_delete_samples);
+ new_state->origin = mus_format("%" PRId64 " %" PRId64 " %s drop", beg, num, S_delete_samples);
#else
#if HAVE_RUBY
{
char *temp;
temp = to_proc_name(S_delete_samples);
- new_state->origin = mus_format("%s" PROC_OPEN "%lld" PROC_SEP "%lld", temp, beg, num);
+ new_state->origin = mus_format("%s" PROC_OPEN "%" PRId64 PROC_SEP "%" PRId64, temp, beg, num);
if (temp) free(temp);
}
#else
- new_state->origin = mus_format("%s" PROC_OPEN "%lld" PROC_SEP "%lld", to_proc_name(S_delete_samples), beg, num);
+ new_state->origin = mus_format("%s" PROC_OPEN "%" PRId64 PROC_SEP "%" PRId64, to_proc_name(S_delete_samples), beg, num);
#endif
#endif
new_state->edit_type = DELETION_EDIT;
@@ -4567,16 +4567,16 @@ bool scale_channel_with_origin(chan_info *cp, mus_float_t scl, mus_long_t beg, m
{
if (num == len)
#if HAVE_FORTH
- new_ed->origin = mus_format("%.3f %lld" PROC_SEP PROC_FALSE " %s", scl, beg, S_scale_channel);
+ new_ed->origin = mus_format("%.3f %" PRId64 PROC_SEP PROC_FALSE " %s", scl, beg, S_scale_channel);
#else
- new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%lld" PROC_SEP PROC_FALSE, to_proc_name(S_scale_channel), scl, beg);
+ new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%" PRId64 PROC_SEP PROC_FALSE, to_proc_name(S_scale_channel), scl, beg);
#endif
else
{
#if HAVE_FORTH
- new_ed->origin = mus_format("%.3f %lld" PROC_SEP "%lld %s", scl, beg, num, S_scale_channel);
+ new_ed->origin = mus_format("%.3f %" PRId64 PROC_SEP "%" PRId64 " %s", scl, beg, num, S_scale_channel);
#else
- new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%lld" PROC_SEP "%lld", to_proc_name(S_scale_channel), scl, beg, num);
+ new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%" PRId64 PROC_SEP "%" PRId64, to_proc_name(S_scale_channel), scl, beg, num);
#endif
}
}
@@ -4664,7 +4664,7 @@ static bool all_ramp_channel(chan_info *cp, double start, double incr, double sc
bool backup = false;
double rstart;
/*
- fprintf(stderr,"ramp: %f %f %f %f %lld %lld\n", start, incr, scaler, offset, beg, num);
+ fprintf(stderr,"ramp: %f %f %f %f %" PRId64 " %" PRId64 "\n", start, incr, scaler, offset, beg, num);
*/
old_ed = cp->edits[pos];
@@ -4817,14 +4817,14 @@ static bool all_ramp_channel(chan_info *cp, double start, double incr, double sc
rmp1 = rstart + incr * (num - 1); /* want end point */
#if HAVE_FORTH
if (num == len)
- new_ed->origin = mus_format("%.3f %.3f %lld" PROC_SEP PROC_FALSE " %s", rmp0, rmp1, beg, origin);
+ new_ed->origin = mus_format("%.3f %.3f %" PRId64 PROC_SEP PROC_FALSE " %s", rmp0, rmp1, beg, origin);
else
- new_ed->origin = mus_format("%.3f %.3f %lld" PROC_SEP "%lld %s", rmp0, rmp1, beg, num, origin);
+ new_ed->origin = mus_format("%.3f %.3f %" PRId64 PROC_SEP "%" PRId64 " %s", rmp0, rmp1, beg, num, origin);
#else
if (num == len)
- new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%.3f" PROC_SEP "%lld" PROC_SEP PROC_FALSE, to_proc_name(origin), rmp0, rmp1, beg);
+ new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%.3f" PROC_SEP "%" PRId64 PROC_SEP PROC_FALSE, to_proc_name(origin), rmp0, rmp1, beg);
else
- new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%.3f" PROC_SEP "%lld" PROC_SEP "%lld", to_proc_name(origin), rmp0, rmp1, beg, num);
+ new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%.3f" PROC_SEP "%" PRId64 PROC_SEP "%" PRId64, to_proc_name(origin), rmp0, rmp1, beg, num);
#endif
}
else
@@ -4833,17 +4833,17 @@ static bool all_ramp_channel(chan_info *cp, double start, double incr, double sc
data = mus_data(e);
#if HAVE_FORTH
if (num == len)
- new_ed->origin = mus_format("%.3f %.3f %.3f %lld" PROC_SEP PROC_FALSE " %s",
+ new_ed->origin = mus_format("%.3f %.3f %.3f %" PRId64 PROC_SEP PROC_FALSE " %s",
data[xramp_seg_loc * 2 + 1], data[xramp_seg_loc * 2 + 3], mus_increment(e), beg, origin);
else
- new_ed->origin = mus_format("%.3f %.3f %.3f %lld" PROC_SEP "%lld %s",
+ new_ed->origin = mus_format("%.3f %.3f %.3f %" PRId64 PROC_SEP "%" PRId64 " %s",
data[xramp_seg_loc * 2 + 1], data[xramp_seg_loc * 2 + 3], mus_increment(e), beg, num, origin);
#else
if (num == len)
- new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%.3f" PROC_SEP "%.3f" PROC_SEP "%lld" PROC_SEP PROC_FALSE,
+ new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%.3f" PROC_SEP "%.3f" PROC_SEP "%" PRId64 PROC_SEP PROC_FALSE,
to_proc_name(origin), data[xramp_seg_loc * 2 + 1], data[xramp_seg_loc * 2 + 3], mus_increment(e), beg);
else
- new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%.3f" PROC_SEP "%.3f" PROC_SEP "%lld" PROC_SEP "%lld",
+ new_ed->origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%.3f" PROC_SEP "%.3f" PROC_SEP "%" PRId64 PROC_SEP "%" PRId64,
to_proc_name(origin), data[xramp_seg_loc * 2 + 1], data[xramp_seg_loc * 2 + 3], mus_increment(e), beg, num);
#endif
}
@@ -4977,7 +4977,7 @@ void sampler_set_safe(snd_fd *sf, mus_long_t dur)
* dur here has to match the number of samples we will read!
*/
- /* fprintf(stderr, "%lld %lld %lld: %lld\n", sf->first, sf->loc, sf->last, dur); */
+ /* fprintf(stderr, "%" PRId64 " %" PRId64 " %" PRId64 ": %" PRId64 "\n", sf->first, sf->loc, sf->last, dur); */
if ((sf->last - sf->loc + 1) >= dur) /* two kinds of counter here: last is sample number, dur is how many samples */
{
@@ -6731,7 +6731,7 @@ static bool s7_equalp_sf(void *s1, void *s2)
static s7_pointer length_sf(s7_scheme *sc, s7_pointer obj)
{
snd_fd *fd;
- fd = (snd_fd *)s7_object_value(obj);
+ fd = (snd_fd *)s7_c_object_value(obj);
return(s7_make_integer(sc, current_samples(fd->cp)));
}
#endif
@@ -6781,10 +6781,10 @@ char *sampler_to_string(snd_fd *fd)
else
{
if (cp)
- snprintf(desc, PRINT_BUFFER_SIZE, "#<sampler: %s[%d: %d] from %lld, at %lld, %s>",
+ snprintf(desc, PRINT_BUFFER_SIZE, "#<sampler: %s[%d: %d] from %" PRId64 ", at %" PRId64 ", %s>",
name, cp->chan, fd->edit_ctr, fd->initial_samp, current_location(fd),
(fd->direction == READ_BACKWARD) ? "backward" : "forward");
- else snprintf(desc, PRINT_BUFFER_SIZE, "#<sampler: %s from %lld, at %lld, %s>",
+ else snprintf(desc, PRINT_BUFFER_SIZE, "#<sampler: %s from %" PRId64 ", at %" PRId64 ", %s>",
name, fd->initial_samp, current_location(fd),
(fd->direction == READ_BACKWARD) ? "backward" : "forward");
}
@@ -7586,7 +7586,7 @@ scale samples in the given sound/channel between beg and beg + num to norm."
else
{
cur_max = channel_local_maxamp(cp, samp, samps, pos, NULL);
- origin = mus_format("%.3f %lld" PROC_SEP "%lld %s", norm, samp, samps, S_normalize_channel);
+ origin = mus_format("%.3f %" PRId64 PROC_SEP "%" PRId64 " %s", norm, samp, samps, S_normalize_channel);
}
#else
if ((samp == 0) && (samps == cp->edits[pos]->samples))
@@ -7597,7 +7597,7 @@ scale samples in the given sound/channel between beg and beg + num to norm."
else
{
cur_max = channel_local_maxamp(cp, samp, samps, pos, NULL);
- origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%lld" PROC_SEP "%lld", to_proc_name(S_normalize_channel), norm, samp, samps);
+ origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%" PRId64 PROC_SEP "%" PRId64, to_proc_name(S_normalize_channel), norm, samp, samps);
}
#endif
@@ -7811,7 +7811,7 @@ mus_float_t channel_local_maxamp(chan_info *cp, mus_long_t beg, mus_long_t num,
next_sound_1(sf);
}
- /* fprintf(stderr, "use %f %lld\n", ymax, mpos); */
+ /* fprintf(stderr, "use %f %" PRId64 "\n", ymax, mpos); */
if ((edpos == 0) &&
(beg == 0) &&
(num = cp->edits[0]->samples))
@@ -7959,9 +7959,9 @@ static Xen g_set_sample(Xen samp_n, Xen val, Xen snd, Xen chn_n, Xen edpos)
ival[0] = fval;
#if HAVE_FORTH
- origin = mus_format("%lld %.4f %s drop", beg, fval, "set-sample");
+ origin = mus_format("%" PRId64 " %.4f %s drop", beg, fval, "set-sample");
#else
- origin = mus_format("%s" PROC_OPEN "%lld" PROC_SEP "%.4f", to_proc_name("set-sample"), beg, fval);
+ origin = mus_format("%s" PROC_OPEN "%" PRId64 PROC_SEP "%.4f", to_proc_name("set-sample"), beg, fval);
#endif
if (change_samples(beg, 1, ival, cp, origin, pos, fabs(fval)))
update_graph(cp);
@@ -8179,7 +8179,7 @@ void check_saved_temp_file(const char *type, Xen filename, Xen date_and_length)
if (old_time != new_time)
{
if (old_bytes != new_bytes)
- buf = mus_format("Saved %s temp file %s: original write date: %s, current: %s, original length: %lldbytes, current: %lld",
+ buf = mus_format("Saved %s temp file %s: original write date: %s, current: %s, original length: %" PRId64 "bytes, current: %" PRId64,
type, file,
snd_strftime(STRFTIME_FORMAT, old_time),
snd_strftime(STRFTIME_FORMAT, new_time),
@@ -8190,7 +8190,7 @@ void check_saved_temp_file(const char *type, Xen filename, Xen date_and_length)
snd_strftime(STRFTIME_FORMAT, old_time),
snd_strftime(STRFTIME_FORMAT, new_time));
}
- else buf = mus_format("Saved %s temp file %s: original length: %lldbytes, current: %lld",
+ else buf = mus_format("Saved %s temp file %s: original length: %" PRId64 "bytes, current: %" PRId64,
type, file,
old_bytes, new_bytes);
snd_warning_without_format(buf);
@@ -8604,9 +8604,9 @@ position.\n " insert_sound_example "\ninserts all of oboe.snd starting at sampl
if (fchn < nc)
{
#if HAVE_FORTH
- origin = mus_format("\"%s\" %lld %d %s drop", filename, beg, fchn, S_insert_sound);
+ origin = mus_format("\"%s\" %" PRId64 " %d %s drop", filename, beg, fchn, S_insert_sound);
#else
- origin = mus_format("%s" PROC_OPEN "\"%s\"" PROC_SEP "%lld" PROC_SEP "%d", to_proc_name(S_insert_sound), filename, beg, fchn);
+ origin = mus_format("%s" PROC_OPEN "\"%s\"" PROC_SEP "%" PRId64 PROC_SEP "%d", to_proc_name(S_insert_sound), filename, beg, fchn);
#endif
if (file_insert_samples(beg, len, filename, cp, fchn, delete_file, origin,
to_c_edit_position(cp, edpos, S_insert_sound, 6)))
@@ -8625,9 +8625,9 @@ position.\n " insert_sound_example "\ninserts all of oboe.snd starting at sampl
for (i = 0; i < nc; i++)
{
#if HAVE_FORTH
- origin = mus_format("\"%s\" %lld %d %s drop", filename, beg, i, S_insert_sound);
+ origin = mus_format("\"%s\" %" PRId64 " %d %s drop", filename, beg, i, S_insert_sound);
#else
- origin = mus_format("%s" PROC_OPEN "\"%s\"" PROC_SEP "%lld" PROC_SEP "%d", to_proc_name(S_insert_sound), filename, beg, i);
+ origin = mus_format("%s" PROC_OPEN "\"%s\"" PROC_SEP "%" PRId64 PROC_SEP "%d", to_proc_name(S_insert_sound), filename, beg, i);
#endif
if (file_insert_samples(beg, len, filename, sp->chans[i], i, delete_file, origin,
/* this edit_position cannot be optimized out -- each channel may have
@@ -8663,9 +8663,9 @@ static Xen g_insert_sample(Xen samp_n, Xen val, Xen snd, Xen chn_n, Xen edpos)
fval = Xen_real_to_C_double(val);
ival[0] = fval;
#if HAVE_FORTH
- origin = mus_format("%lld %.4f %s drop", beg, fval, S_insert_sample);
+ origin = mus_format("%" PRId64 " %.4f %s drop", beg, fval, S_insert_sample);
#else
- origin = mus_format("%s" PROC_OPEN "%lld" PROC_SEP "%.4f", to_proc_name(S_insert_sample), beg, fval);
+ origin = mus_format("%s" PROC_OPEN "%" PRId64 PROC_SEP "%.4f", to_proc_name(S_insert_sample), beg, fval);
#endif
if (insert_samples(beg, 1, ival, cp, origin, pos))
update_graph(cp);
@@ -8713,9 +8713,9 @@ insert data (either a " S_vct ", a list of samples, or a filename) into snd's ch
}
if (mus_sound_framples(filename) <= 0) return(Xen_integer_zero);
#if HAVE_FORTH
- if (!origin) origin = mus_format("%lld" PROC_SEP "%lld \"%s\" %s drop", beg, len, filename, S_insert_samples);
+ if (!origin) origin = mus_format("%" PRId64 PROC_SEP "%" PRId64 " \"%s\" %s drop", beg, len, filename, S_insert_samples);
#else
- if (!origin) origin = mus_format("%s" PROC_OPEN "%lld" PROC_SEP "%lld" PROC_SEP "\"%s\"", to_proc_name(S_insert_samples), beg, len, filename);
+ if (!origin) origin = mus_format("%s" PROC_OPEN "%" PRId64 PROC_SEP "%" PRId64 PROC_SEP "\"%s\"", to_proc_name(S_insert_samples), beg, len, filename);
#endif
file_insert_samples(beg, len, filename, cp, 0, delete_file, origin, pos);
if (filename) free(filename);
@@ -8899,7 +8899,7 @@ static char *snd_to_sample_describe(mus_any *ptr)
}
}
snd_to_sample_buf = (char *)calloc(len, sizeof(char));
- snprintf(snd_to_sample_buf, len, "%s reading %s (%d chan%s) at %lld:[",
+ snprintf(snd_to_sample_buf, len, "%s reading %s (%d chan%s) at %" PRId64 ":[",
mus_name(ptr),
spl->sp->short_filename,
spl->chans,
@@ -9144,7 +9144,12 @@ void g_init_edits(void)
/* pl_fx = s7_make_signature(s7, 2, f, x); */
pl_fx = s7_make_signature(s7, 2, f, smp);
- sf_tag = s7_new_type_x(s7, "<sampler>", print_sf, free_sf, s7_equalp_sf, NULL, s7_read_sample, NULL, length_sf, NULL, NULL, NULL);
+ sf_tag = s7_make_c_type(s7, "<sampler>");
+ s7_c_type_set_print(s7, sf_tag, print_sf);
+ s7_c_type_set_free(s7, sf_tag, free_sf);
+ s7_c_type_set_equal(s7, sf_tag, s7_equalp_sf);
+ s7_c_type_set_apply(s7, sf_tag, s7_read_sample);
+ s7_c_type_set_length(s7, sf_tag, length_sf);
#else
sf_tag = Xen_make_object_type("Sampler", sizeof(snd_fd));
#endif
diff --git a/snd-fft.c b/snd-fft.c
index b2ce554..4e1e641 100644
--- a/snd-fft.c
+++ b/snd-fft.c
@@ -1466,7 +1466,7 @@ static bool memory_is_available(mus_long_t slices, mus_long_t bins)
if (!check_alloc[i])
{
int j;
- snd_warning("can't allocate enough memory to run this set of FFTS: %lld bytes needed", bytes_needed);
+ snd_warning("can't allocate enough memory to run this set of FFTS: %" PRId64 " bytes needed", bytes_needed);
for (j = 0; j < i; j++)
free(check_alloc[j]);
return(false);
@@ -1818,7 +1818,7 @@ void c_convolve(const char *fname, mus_float_t amp, int filec, mus_long_t filehd
(!pbuffer) || (!pbuffer[0]) ||
(!fbuffer) || (!fbuffer[filter_chan]))
{
- snd_error("not enough memory for convolve of %s (filter size: %lld, fft size: %lld)",
+ snd_error("not enough memory for convolve of %s (filter size: %" PRId64 ", fft size: %" PRId64 ")",
fname, filtersize, fftsize);
}
else
@@ -2217,8 +2217,11 @@ static Xen s7_xen_transform_length(s7_scheme *sc, Xen obj)
static void init_xen_transform(void)
{
#if HAVE_SCHEME
- xen_transform_tag = s7_new_type_x(s7, "<transform>", print_xen_transform, free_xen_transform, s7_xen_transform_equalp,
- NULL, NULL, NULL, s7_xen_transform_length, NULL, NULL, NULL);
+ xen_transform_tag = s7_make_c_type(s7, "<transform>");
+ s7_c_type_set_print(s7, xen_transform_tag, print_xen_transform);
+ s7_c_type_set_free(s7, xen_transform_tag, free_xen_transform);
+ s7_c_type_set_equal(s7, xen_transform_tag, s7_xen_transform_equalp);
+ s7_c_type_set_length(s7, xen_transform_tag, s7_xen_transform_length);
#else
#if HAVE_RUBY
xen_transform_tag = Xen_make_object_type("XenTransform", sizeof(xen_transform));
diff --git a/snd-file.c b/snd-file.c
index b650fdd..a37345a 100644
--- a/snd-file.c
+++ b/snd-file.c
@@ -2691,7 +2691,7 @@ static char *raw_data_explanation(const char *filename, file_info *hdr, char **i
reason_str = mus_strcat(reason_str, tmp_str, &len);
/* samples */
- snprintf(tmp_str, LABEL_BUFFER_SIZE, "\nlength: %.3f (%lld samples, %lld bytes total)",
+ snprintf(tmp_str, LABEL_BUFFER_SIZE, "\nlength: %.3f (%" PRId64 " samples, %" PRId64 " bytes total)",
(float)((double)(hdr->samples) / (float)(hdr->chans * hdr->srate)),
hdr->samples,
mus_sound_length(filename));
@@ -2699,7 +2699,7 @@ static char *raw_data_explanation(const char *filename, file_info *hdr, char **i
nsamp = swap_mus_long_t(hdr->samples);
if (nsamp < mus_sound_length(filename))
{
- snprintf(tmp_str, LABEL_BUFFER_SIZE, " (swapped: %lld" , nsamp);
+ snprintf(tmp_str, LABEL_BUFFER_SIZE, " (swapped: %" PRId64 , nsamp);
reason_str = mus_strcat(reason_str, tmp_str, &len);
if ((better_chans) && (better_srate))
{
@@ -2712,13 +2712,13 @@ static char *raw_data_explanation(const char *filename, file_info *hdr, char **i
}
/* data location */
- snprintf(tmp_str, LABEL_BUFFER_SIZE, "\ndata location: %lld", hdr->data_location);
+ snprintf(tmp_str, LABEL_BUFFER_SIZE, "\ndata location: %" PRId64, hdr->data_location);
reason_str = mus_strcat(reason_str, tmp_str, &len);
nsamp = swap_mus_long_t(hdr->data_location);
if ((nsamp > 0) &&
(nsamp <= 1024))
{
- snprintf(tmp_str, LABEL_BUFFER_SIZE, " (swapped: %lld)", nsamp);
+ snprintf(tmp_str, LABEL_BUFFER_SIZE, " (swapped: %" PRId64 ")", nsamp);
reason_str = mus_strcat(reason_str, tmp_str, &len);
}
(*info) = reason_str;
@@ -2813,7 +2813,7 @@ void display_info(snd_info *sp)
buffer = (char *)calloc(INFO_BUFFER_SIZE, sizeof(char));
snprintf(buffer, INFO_BUFFER_SIZE,
- "srate: %d\nchans: %d\nlength: %.3f (%lld %s)\n%s\n",
+ "srate: %d\nchans: %d\nlength: %.3f (%" PRId64 " %s)\n%s\n",
snd_srate(sp),
sp->nchans,
(double)(current_samples(sp->chans[0])) / (double)snd_srate(sp),
diff --git a/snd-find.c b/snd-find.c
index f8cb310..7448e4d 100644
--- a/snd-find.c
+++ b/snd-find.c
@@ -110,7 +110,7 @@ static char *channel_search(chan_info *cp, read_direction_t direction)
s1 = prettyf(chn_sample(samp, cp, cp->edit_ctr), 2);
s2 = x_axis_location_to_string(cp, (double)samp / (double)snd_srate(cp->sound));
- msg = mus_format("%s at %s (%lld)", s1, s2, samp);
+ msg = mus_format("%s at %s (%" PRId64 ")", s1, s2, samp);
cursor_moveto_without_verbosity(cp, samp);
free(s1);
free(s2);
diff --git a/snd-gprefs.c b/snd-gprefs.c
index 09e19d6..a45d13c 100644
--- a/snd-gprefs.c
+++ b/snd-gprefs.c
@@ -2364,7 +2364,7 @@ widget_t make_preferences_dialog(void)
make_top_level_label("transform options", fft_box);
rts_fft_size = transform_size(ss);
- str = mus_format("%lld", rts_fft_size);
+ str = mus_format("%" PRId64, rts_fft_size);
prf = prefs_row_with_number("size", S_transform_size,
str, 12,
fft_box,
diff --git a/snd-gutils.c b/snd-gutils.c
index 747f44a..0730c51 100644
--- a/snd-gutils.c
+++ b/snd-gutils.c
@@ -909,7 +909,7 @@ void widget_mus_long_t_to_text(GtkWidget *w, mus_long_t val)
{
char *str;
str = (char *)calloc(8, sizeof(char));
- snprintf(str, 8, "%lld", val);
+ snprintf(str, 8, "%" PRId64, val);
gtk_entry_set_text(GTK_ENTRY(w), str);
free(str);
}
diff --git a/snd-gxcolormaps.c b/snd-gxcolormaps.c
index 3d2754e..0171ead 100644
--- a/snd-gxcolormaps.c
+++ b/snd-gxcolormaps.c
@@ -1001,8 +1001,12 @@ static Xen s7_colormap_apply(s7_scheme *sc, Xen obj, Xen args)
static void init_xen_colormap(void)
{
#if HAVE_SCHEME
- xen_colormap_tag = s7_new_type_x(s7, "<colormap>", print_xen_colormap, free_xen_colormap, s7_xen_colormap_equalp,
- NULL, s7_colormap_apply, NULL, s7_xen_colormap_length, NULL, NULL, NULL);
+ xen_colormap_tag = s7_make_c_type(s7, "<colormap>");
+ s7_c_type_set_print(s7, xen_colormap_tag, print_xen_colormap);
+ s7_c_type_set_free(s7, xen_colormap_tag, free_xen_colormap);
+ s7_c_type_set_equal(s7, xen_colormap_tag, s7_xen_colormap_equalp);
+ s7_c_type_set_length(s7, xen_colormap_tag, s7_xen_colormap_length);
+ s7_c_type_set_apply(s7, xen_colormap_tag, s7_colormap_apply);
#else
#if HAVE_RUBY
xen_colormap_tag = Xen_make_object_type("XenColormap", sizeof(xen_colormap));
diff --git a/snd-kbd.c b/snd-kbd.c
index 3804131..2dd6ba2 100644
--- a/snd-kbd.c
+++ b/snd-kbd.c
@@ -894,7 +894,7 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
else
{
if (!(delete_mark_samp(cursor_sample(cp), cp)))
- status_report(cp->sound, "no mark at sample %lld", cursor_sample(cp));
+ status_report(cp->sound, "no mark at sample %" PRId64, cursor_sample(cp));
}
if ((keysym == snd_K_M) &&
(cp->sound->sync != 0))
@@ -919,7 +919,7 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
else
{
if (!(delete_mark_samp(cursor_sample(cp), si->cps[i])))
- status_report(cp->sound, "no mark at sample %lld", cursor_sample(cp));
+ status_report(cp->sound, "no mark at sample %" PRId64, cursor_sample(cp));
}
}
si = free_sync_info(si);
@@ -1042,7 +1042,7 @@ void keyboard_command(chan_info *cp, int keysym, int unmasked_state)
if (count > 0)
{
start_selection_creation(cp, cursor_sample(cp));
- status_report(sp, "selection starts at %lld", cursor_sample(cp));
+ status_report(sp, "selection starts at %" PRId64, cursor_sample(cp));
}
break;
diff --git a/snd-lint.scm b/snd-lint.scm
index 8e7f3d2..3d5126a 100644
--- a/snd-lint.scm
+++ b/snd-lint.scm
@@ -220,3 +220,51 @@
two-zero? wave-train? file->frample? frample->file?
mark? mix? mix-sampler? region?))
+
+#|
+;;; a more complicated search:
+
+(let ((old-do-walker (hash-table-ref (*lint* 'walker-functions) 'do)))
+ ;; look for forms like (do ((i 0 (+ i 1))) ((= i 123)) (float-vector-set! v i (* .2 (float-vector-ref v i))))
+
+ (hash-table-set! (*lint* 'walker-functions) 'do
+ (lambda (caller form env)
+ (when (and (pair? (cdr form))
+ (pair? (cddr form)))
+ (let ((vars (cadr form))
+ (end+res (caddr form))
+ (body (cdddr form)))
+ (when (and (pair? vars)
+ (null? (cdr vars))
+ (pair? body)
+ (null? (cdr body))
+ (pair? (car body))
+ (eq? (caar body) 'float-vector-set!)
+ ;(eqv? 0 (cadar vars)) -- we'll use shared-vector if not 0
+ (pair? (cddar vars))
+ (eqv? (length (caddar vars)) 3))
+ (let ((stepper (caddar vars))
+ (expr (cdar body))
+ (end (car end+res)))
+ (when (and (eq? (car stepper) '+)
+ (memq (caar vars) stepper)
+ (memv 1 stepper)
+ (eqv? (length end) 3)
+ (memq (caar vars) end)
+ (memq (car end) '(= >=))
+ (symbol? (car expr))
+ (eq? (cadr expr) (caar vars))
+ (pair? (caddr expr)))
+ (let ((ref (caddr expr)))
+ (when (and (eq? (car ref) '*)
+ (or (and (pair? (cadr ref))
+ (eq? (caadr ref) 'float-vector-ref)
+ (eq? (cadadr ref) (car expr))
+ (eq? (caddr (cadr ref)) (caar vars)))
+ (and (pair? (caddr ref))
+ (eq? (caaddr ref) 'float-vector-ref)
+ (eq? (cadr (caddr ref)) (car expr))
+ (eq? (caddr (caddr ref)) (caar vars)))))
+ (format *stderr* "possible float-vector-scale: ~A~%" form))))))))
+ (old-do-walker caller form env))))
+|#
diff --git a/snd-main.c b/snd-main.c
index d93b985..25c7631 100644
--- a/snd-main.c
+++ b/snd-main.c
@@ -276,7 +276,7 @@ static bool b_ok = false;
static void pss_ss(FILE *fd, const char *name, const char *val) {fprintf(fd, "set_%s(%s)\n", to_proc_name(name), val);}
static void pss_sq(FILE *fd, const char *name, const char *val) {fprintf(fd, "set_%s(\"%s\")\n", to_proc_name(name), val);}
static void pss_sd(FILE *fd, const char *name, int val) {fprintf(fd, "set_%s(%d)\n", to_proc_name(name), val);}
-static void pss_sod(FILE *fd, const char *name, mus_long_t val) {fprintf(fd, "set_%s(%lld)\n", to_proc_name(name), val);}
+static void pss_sod(FILE *fd, const char *name, mus_long_t val) {fprintf(fd, "set_%s(%" PRId64 ")\n", to_proc_name(name), val);}
static void pss_sf(FILE *fd, const char *name, mus_float_t val) {fprintf(fd, "set_%s(%.4f)\n", to_proc_name(name), val);}
static void pss_sl(FILE *fd, const char *name, mus_float_t val1, mus_float_t val2)
@@ -299,7 +299,7 @@ static void pcp_sd(FILE *fd, const char *name, int val, int chan)
{fprintf(fd, "%sset_%s(%d, sfile, %d)\n", white_space, to_proc_name(name), val, chan);}
static void pcp_sod(FILE *fd, const char *name, mus_long_t val, int chan)
- {fprintf(fd, "%sset_%s(%lld, sfile, %d)\n", white_space, to_proc_name(name), val, chan);}
+ {fprintf(fd, "%sset_%s(%" PRId64 ", sfile, %d)\n", white_space, to_proc_name(name), val, chan);}
static void pcp_sf(FILE *fd, const char *name, mus_float_t val, int chan)
{fprintf(fd, "%sset_%s(%.4f, sfile, %d)\n", white_space, to_proc_name(name), val, chan);}
@@ -313,7 +313,7 @@ static void pcp_sl(FILE *fd, const char *name, mus_float_t val1, mus_float_t val
static void pss_ss(FILE *fd, const char *name, const char *val) {fprintf(fd, "%s set-%s drop\n", val, name);}
static void pss_sq(FILE *fd, const char *name, const char *val) {fprintf(fd, "\"%s\" set-%s drop\n", val, name);}
static void pss_sd(FILE *fd, const char *name, int val) {fprintf(fd, "%d set-%s drop\n", val, name);}
-static void pss_sod(FILE *fd, const char *name, mus_long_t val) {fprintf(fd, "%lld set-%s drop\n", val, name);}
+static void pss_sod(FILE *fd, const char *name, mus_long_t val) {fprintf(fd, "%" PRId64 " set-%s drop\n", val, name);}
static void pss_sf(FILE *fd, const char *name, mus_float_t val) {fprintf(fd, "%.4f set-%s drop\n", val, name);}
static void pss_sl(FILE *fd, const char *name, mus_float_t val1, mus_float_t val2)
{fprintf(fd, "%s'( %f %f ) set-%s drop\n", white_space, val1, val2, name);}
@@ -335,7 +335,7 @@ static void pcp_sd(FILE *fd, const char *name, int val, int chan)
{fprintf(fd, "%s%d sfile %d set-%s drop\n", white_space, val, chan, name);}
static void pcp_sod(FILE *fd, const char *name, mus_long_t val, int chan)
- {fprintf(fd, "%s%lld sfile %d set-%s drop\n", white_space, val, chan, name);}
+ {fprintf(fd, "%s%" PRId64 " sfile %d set-%s drop\n", white_space, val, chan, name);}
static void pcp_sf(FILE *fd, const char *name, mus_float_t val, int chan)
{fprintf(fd, "%s%.4f sfile %d set-%s drop\n", white_space, val, chan, name);}
@@ -349,7 +349,7 @@ static void pcp_sl(FILE *fd, const char *name, mus_float_t val1, mus_float_t val
static void pss_ss(FILE *fd, const char *name, const char *val) {fprintf(fd, "(set! (%s) %s)\n", name, val);}
static void pss_sq(FILE *fd, const char *name, const char *val) {fprintf(fd, "(set! (%s) \"%s\")\n", name, val);}
static void pss_sd(FILE *fd, const char *name, int val) {fprintf(fd, "(set! (%s) %d)\n", name, val);}
-static void pss_sod(FILE *fd, const char *name, mus_long_t val) {fprintf(fd, "(set! (%s) %lld)\n", name, val);}
+static void pss_sod(FILE *fd, const char *name, mus_long_t val) {fprintf(fd, "(set! (%s) %" PRId64 ")\n", name, val);}
static void pss_sf(FILE *fd, const char *name, mus_float_t val) {fprintf(fd, "(set! (%s) %.4f)\n", name, val);}
static void pss_sl(FILE *fd, const char *name, mus_float_t val1, mus_float_t val2) {fprintf(fd, "(set! (%s) (list %f %f))\n", name, val1, val2);}
@@ -375,7 +375,7 @@ static void pcp_sd(FILE *fd, const char *name, int val, int chan)
{b_ok = true; fprintf(fd, "%s(set! (%s sfile %d) %d)\n", white_space, name, chan, val);}
static void pcp_sod(FILE *fd, const char *name, mus_long_t val, int chan)
- {b_ok = true; fprintf(fd, "%s(set! (%s sfile %d) %lld)\n", white_space, name, chan, val);}
+ {b_ok = true; fprintf(fd, "%s(set! (%s sfile %d) %" PRId64 ")\n", white_space, name, chan, val);}
static void pcp_sf(FILE *fd, const char *name, mus_float_t val, int chan)
{b_ok = true; fprintf(fd, "%s(set! (%s sfile %d) %.4f)\n", white_space, name, chan, val);}
@@ -659,7 +659,7 @@ void global_fft_state(void)
char *buf;
snd_help_append("\n\nCurrent FFT defaults:\n\n");
buf = (char *)calloc(1024, sizeof(char));
- snprintf(buf, 1024, "fft size: %lld\n type: %s\n window: %s (alpha: %.3f, beta: %.3f)\n",
+ snprintf(buf, 1024, "fft size: %" PRId64 "\n type: %s\n window: %s (alpha: %.3f, beta: %.3f)\n",
transform_size(ss),
TO_VAR_NAME(transform_program_name(transform_type(ss))),
TO_VAR_NAME(mus_fft_window_xen_name(fft_window(ss))),
diff --git a/snd-marks.c b/snd-marks.c
index c53fd89..a96d786 100644
--- a/snd-marks.c
+++ b/snd-marks.c
@@ -2055,7 +2055,7 @@ Xen new_xen_mark(int n)
{
s7_pointer m;
m = Xen_make_object(xen_mark_tag, mx, 0, free_xen_mark);
- s7_object_set_let(m, g_mark_methods);
+ s7_c_object_set_let(m, g_mark_methods);
return(m);
}
#else
@@ -2098,11 +2098,13 @@ static s7_pointer mark_to_let_func = NULL;
static void init_xen_mark(void)
{
#if HAVE_SCHEME
- {
- g_mark_methods = s7_openlet(s7, s7_inlet(s7, s7_list(s7, 2, s7_make_symbol(s7, "object->let"), mark_to_let_func)));
- s7_gc_protect(s7, g_mark_methods);
- xen_mark_tag = s7_new_type_x(s7, "<mark>", print_xen_mark, free_xen_mark, s7_xen_mark_equalp, NULL, NULL, NULL, NULL, s7_xen_mark_copy, NULL, NULL);
- }
+ g_mark_methods = s7_openlet(s7, s7_inlet(s7, s7_list(s7, 2, s7_make_symbol(s7, "object->let"), mark_to_let_func)));
+ s7_gc_protect(s7, g_mark_methods);
+ xen_mark_tag = s7_make_c_type(s7, "<mark>");
+ s7_c_type_set_print(s7, xen_mark_tag, print_xen_mark);
+ s7_c_type_set_free(s7, xen_mark_tag, free_xen_mark);
+ s7_c_type_set_equal(s7, xen_mark_tag, s7_xen_mark_equalp);
+ s7_c_type_set_copy(s7, xen_mark_tag, s7_xen_mark_copy);
#else
#if HAVE_RUBY
xen_mark_tag = Xen_make_object_type("XenMark", sizeof(xen_mark));
@@ -2718,20 +2720,20 @@ static mark *save_mark(chan_info *cp, mark *m, void *info)
#if HAVE_SCHEME
if (m->name)
- fprintf(sv->fd, "(add-mark! %lld sfile %d \"%s\" %s)\n", m->samp, cp->chan, m->name, mapped_sync);
- else fprintf(sv->fd, "(add-mark! %lld sfile %d #f %s)\n", m->samp, cp->chan, mapped_sync);
+ fprintf(sv->fd, "(add-mark! %" PRId64 " sfile %d \"%s\" %s)\n", m->samp, cp->chan, m->name, mapped_sync);
+ else fprintf(sv->fd, "(add-mark! %" PRId64 " sfile %d #f %s)\n", m->samp, cp->chan, mapped_sync);
#endif
#if HAVE_RUBY
if (m->name)
- fprintf(sv->fd, "add_mark!(%lld, sfile, %d, \"%s\", %s)\n", m->samp, cp->chan, m->name, mapped_sync);
- else fprintf(sv->fd, "add_mark!(%lld, sfile, %d, false, %s)\n", m->samp, cp->chan, mapped_sync);
+ fprintf(sv->fd, "add_mark!(%" PRId64 ", sfile, %d, \"%s\", %s)\n", m->samp, cp->chan, m->name, mapped_sync);
+ else fprintf(sv->fd, "add_mark!(%" PRId64 ", sfile, %d, false, %s)\n", m->samp, cp->chan, mapped_sync);
#endif
#if HAVE_FORTH
if (m->name)
- fprintf(sv->fd, "%lld sfile %d \"%s\" %s add-mark! drop\n", m->samp, cp->chan, m->name, mapped_sync);
- else fprintf(sv->fd, "%lld sfile %d #f %s add-mark! drop\n", m->samp, cp->chan, mapped_sync);
+ fprintf(sv->fd, "%" PRId64 " sfile %d \"%s\" %s add-mark! drop\n", m->samp, cp->chan, m->name, mapped_sync);
+ else fprintf(sv->fd, "%" PRId64 " sfile %d #f %s add-mark! drop\n", m->samp, cp->chan, mapped_sync);
#endif
free(mapped_sync);
diff --git a/snd-mix.c b/snd-mix.c
index 4955895..501052f 100644
--- a/snd-mix.c
+++ b/snd-mix.c
@@ -111,8 +111,26 @@ static bool mix_file_untagged(const char *filename, int in_chan, chan_info *cp,
if (kdur > size) kdur = size;
if (sf->runf == next_sample_value_unscaled)
{
+#if (!WITH_VECTORIZE)
for (j = 0; j < kdur; j++)
chandata[j] += (sf->loc > sf->last) ? next_sound(sf) : sf->data[sf->loc++];
+#else
+ for (j = 0; j < kdur; )
+ {
+ mus_long_t ksize;
+ ksize = sf->last - sf->loc + 1;
+ if (ksize == 1)
+ chandata[j++] = next_sound(sf);
+ else
+ {
+ if (j + ksize > kdur) ksize = kdur - j;
+ mus_copy_floats((mus_float_t *)(chandata + j), (mus_float_t *)(sf->data + sf->loc), ksize);
+ j += ksize;
+ if (j < kdur)
+ chandata[j++] = next_sound(sf);
+ }
+ }
+#endif
}
else
{
@@ -274,13 +292,13 @@ static const char *b2s(bool val)
static char *tagged_mix_to_string(const char *mixinfile, mus_long_t beg, int file_channel, bool delete_file)
{
#if HAVE_FORTH
- return(mus_format("\"%s\" %lld %d snd chn %s %s %s to -mix-%d", mixinfile, beg, file_channel, b2s(true), b2s(delete_file), S_mix, mix_infos_ctr));
+ return(mus_format("\"%s\" %" PRId64 " %d snd chn %s %s %s to -mix-%d", mixinfile, beg, file_channel, b2s(true), b2s(delete_file), S_mix, mix_infos_ctr));
#endif
#if HAVE_SCHEME
- return(mus_format("(varlet -env- '-mix-%d (%s \"%s\" %lld %d snd chn %s %s))", mix_infos_ctr, S_mix, mixinfile, beg, file_channel, b2s(true), b2s(delete_file)));
+ return(mus_format("(varlet -env- '-mix-%d (%s \"%s\" %" PRId64 " %d snd chn %s %s))", mix_infos_ctr, S_mix, mixinfile, beg, file_channel, b2s(true), b2s(delete_file)));
#endif
#if HAVE_RUBY
- return(mus_format("_mix_%d = %s(\"%s\", %lld, %d, snd, chn, %s, %s)", mix_infos_ctr, to_proc_name(S_mix), mixinfile, beg, file_channel, b2s(true), b2s(delete_file)));
+ return(mus_format("_mix_%d = %s(\"%s\", %" PRId64 ", %d, snd, chn, %s, %s)", mix_infos_ctr, to_proc_name(S_mix), mixinfile, beg, file_channel, b2s(true), b2s(delete_file)));
#endif
#if (!HAVE_EXTENSION_LANGUAGE)
return(NULL);
@@ -291,13 +309,13 @@ static char *tagged_mix_to_string(const char *mixinfile, mus_long_t beg, int fil
static char *untagged_mix_to_string(const char *mixinfile, mus_long_t beg, int file_channel, bool delete_file)
{
#if HAVE_FORTH
- return(mus_format("\"%s\" %lld %d snd chn %s %s %s", mixinfile, beg, file_channel, b2s(false), b2s(delete_file), S_mix));
+ return(mus_format("\"%s\" %" PRId64 " %d snd chn %s %s %s", mixinfile, beg, file_channel, b2s(false), b2s(delete_file), S_mix));
#endif
#if HAVE_SCHEME
- return(mus_format("(%s \"%s\" %lld %d snd chn %s %s)", S_mix, mixinfile, beg, file_channel, b2s(false), b2s(delete_file)));
+ return(mus_format("(%s \"%s\" %" PRId64 " %d snd chn %s %s)", S_mix, mixinfile, beg, file_channel, b2s(false), b2s(delete_file)));
#endif
#if HAVE_RUBY
- return(mus_format("%s(\"%s\", %lld, %d, snd, chn, %s, %s)", to_proc_name(S_mix), mixinfile, beg, file_channel, b2s(false), b2s(delete_file)));
+ return(mus_format("%s(\"%s\", %" PRId64 ", %d, snd, chn, %s, %s)", to_proc_name(S_mix), mixinfile, beg, file_channel, b2s(false), b2s(delete_file)));
#endif
#if (!HAVE_EXTENSION_LANGUAGE)
return(NULL);
@@ -1498,13 +1516,13 @@ bool mix_set_position_edit(int id, mus_long_t pos)
{
char *origin = NULL;
#if HAVE_FORTH
- origin = mus_format("-mix-%d %lld set-mix-position", id, pos);
+ origin = mus_format("-mix-%d %" PRId64 " set-mix-position", id, pos);
#endif
#if HAVE_SCHEME
- origin = mus_format("(set! (mix-position (car -mix-%d)) %lld)", id, pos);
+ origin = mus_format("(set! (mix-position (car -mix-%d)) %" PRId64 ")", id, pos);
#endif
#if HAVE_RUBY
- origin = mus_format("set_mix_position(_mix_%d, %lld)", id, pos);
+ origin = mus_format("set_mix_position(_mix_%d, %" PRId64 ")", id, pos);
#endif
edited = begin_mix_op(md->cp, old_ms->beg, old_ms->len, pos, old_ms->len, md->cp->edit_ctr, origin); /* this does not change beg or len */
@@ -2787,7 +2805,7 @@ Xen new_xen_mix(int n)
{
s7_pointer m;
m = Xen_make_object(xen_mix_tag, mx, 0, free_xen_mix);
- s7_object_set_let(m, g_mix_methods);
+ s7_c_object_set_let(m, g_mix_methods);
return(m);
}
#else
@@ -2824,7 +2842,12 @@ static void init_xen_mix(void)
#if HAVE_SCHEME
g_mix_methods = s7_openlet(s7, s7_inlet(s7, s7_list(s7, 2, s7_make_symbol(s7, "object->let"), mix_to_let_func)));
s7_gc_protect(s7, g_mix_methods);
- xen_mix_tag = s7_new_type_x(s7, "<mix>", print_xen_mix, free_xen_mix, s7_xen_mix_equalp, NULL, NULL, NULL, s7_xen_mix_length, s7_xen_mix_copy, NULL, NULL);
+ xen_mix_tag = s7_make_c_type(s7, "<mix>");
+ s7_c_type_set_print(s7, xen_mix_tag, print_xen_mix);
+ s7_c_type_set_free(s7, xen_mix_tag, free_xen_mix);
+ s7_c_type_set_equal(s7, xen_mix_tag, s7_xen_mix_equalp);
+ s7_c_type_set_length(s7, xen_mix_tag, s7_xen_mix_length);
+ s7_c_type_set_copy(s7, xen_mix_tag, s7_xen_mix_copy);
#else
#if HAVE_RUBY
xen_mix_tag = Xen_make_object_type("XenMix", sizeof(xen_mix));
@@ -3438,19 +3461,19 @@ mix data (a " S_vct ") into snd's channel chn starting at beg; return the new mi
name++;
else
name = S_mix_vct;
- new_origin = mus_format("%.*s %lld snd chn %s to -mix-%d",
+ new_origin = mus_format("%.*s %" PRId64 " snd chn %s to -mix-%d",
(int)(strlen(edname) - strlen(name) - 1), edname,
bg, name, mix_infos_ctr);
}
- else new_origin = mus_format("vct( 0 ) %lld snd chn %s to -mix-%d", bg, S_mix_vct, mix_infos_ctr);
+ else new_origin = mus_format("vct( 0 ) %" PRId64 " snd chn %s to -mix-%d", bg, S_mix_vct, mix_infos_ctr);
}
#endif
#if HAVE_SCHEME
- new_origin = mus_format("(varlet -env- '-mix-%d (%s %lld snd chn))", mix_infos_ctr, edname, bg);
+ new_origin = mus_format("(varlet -env- '-mix-%d (%s %" PRId64 " snd chn))", mix_infos_ctr, edname, bg);
#endif
#if HAVE_RUBY
/* mix_vct(vct(0.1, 0.2, 0.3), 100, snd, chn, true, "mix_vct(vct(0.1, 0.2, 0.3)") */
- new_origin = mus_format("_mix_%d = %s, %lld, snd, chn)", mix_infos_ctr, edname, bg);
+ new_origin = mus_format("_mix_%d = %s, %" PRId64 ", snd, chn)", mix_infos_ctr, edname, bg);
#endif
mix_id = mix_buffer_with_tag(cp, data, bg, len, new_origin);
@@ -3683,7 +3706,7 @@ static char *mix_sampler_to_string(mix_fd *fd)
{
mix_info *md;
md = fd->md;
- snprintf(desc, PRINT_BUFFER_SIZE, "#<mix-sampler mix %d, (from %lld, at %lld%s): %s>",
+ snprintf(desc, PRINT_BUFFER_SIZE, "#<mix-sampler mix %d, (from %" PRId64 ", at %" PRId64 "%s): %s>",
md->id,
fd->sf->initial_samp,
fd->sf->loc,
@@ -3750,7 +3773,7 @@ Xen g_make_mix_sampler(Xen mix_id, Xen ubeg)
{
s7_pointer m;
m = Xen_make_object(mf_tag, mf, 0, free_mf);
- s7_object_set_let(m, g_mix_sampler_methods);
+ s7_c_object_set_let(m, g_mix_sampler_methods);
return(m);
}
#else
@@ -4215,7 +4238,11 @@ void g_init_mix(void)
#if HAVE_SCHEME
g_mix_sampler_methods = s7_openlet(s7, s7_inlet(s7, s7_list(s7, 2, s7_make_symbol(s7, "object->let"), mix_sampler_to_let_func)));
s7_gc_protect(s7, g_mix_sampler_methods);
- mf_tag = s7_new_type_x(s7, "<mix-sampler>", print_mf, free_mf, s7_equalp_mf, NULL, s7_read_mix_sample, NULL, NULL, NULL, NULL, NULL);
+ mf_tag = s7_make_c_type(s7, "<mix-sampler>");
+ s7_c_type_set_print(s7, mf_tag, print_mf);
+ s7_c_type_set_free(s7, mf_tag, free_mf);
+ s7_c_type_set_equal(s7, mf_tag, s7_equalp_mf);
+ s7_c_type_set_apply(s7, mf_tag, s7_read_mix_sample);
#else
mf_tag = Xen_make_object_type("MixSampler", sizeof(mix_fd));
#endif
diff --git a/snd-motif.c b/snd-motif.c
index 9f0b27a..1ba3f84 100644
--- a/snd-motif.c
+++ b/snd-motif.c
@@ -1,6 +1,8 @@
#include "snd.h"
#include <X11/IntrinsicP.h>
+#include <stdint.h>
+#include <inttypes.h>
#if __GNUC__
#ifdef LESSTIF_VERSION
@@ -596,7 +598,7 @@ static void widget_mus_long_t_to_text(Widget w, mus_long_t val)
{
char *str;
str = (char *)calloc(32, sizeof(char));
- snprintf(str, 32, "%lld", val);
+ snprintf(str, 32, "%" PRId64, val);
XmTextFieldSetString(w, str);
free(str);
}
@@ -9128,7 +9130,7 @@ static void sort_files_and_redisplay(file_pattern_info *fp);
static void file_list_item_activate_callback(Widget w, XtPointer context, XtPointer info)
{
file_popup_info *fd = (file_popup_info *)context;
- pointer_or_int_t data;
+ intptr_t data;
int choice;
XtVaGetValues(w, XmNuserData, &data, NULL);
choice = (int)data;
@@ -14763,8 +14765,8 @@ static void view_files_mix_selected_files(widget_t w, view_files_info *vdat)
{
char *msg;
if (vdat->currently_selected_files == 1)
- msg = mus_format("%s mixed in at %lld", vdat->names[vdat->selected_files[0]], vdat->beg);
- else msg = mus_format("selected files mixed in at %lld", vdat->beg);
+ msg = mus_format("%s mixed in at %" PRId64, vdat->names[vdat->selected_files[0]], vdat->beg);
+ else msg = mus_format("selected files mixed in at %" PRId64, vdat->beg);
vf_post_error(msg, vdat);
vdat->has_error = false;
free(msg);
@@ -14847,8 +14849,8 @@ static void view_files_insert_selected_files(widget_t w, view_files_info *vdat)
{
char *msg;
if (vdat->currently_selected_files == 1)
- msg = mus_format("%s inserted at %lld", vdat->names[vdat->selected_files[0]], vdat->beg);
- else msg = mus_format("selected files inserted at %lld", vdat->beg);
+ msg = mus_format("%s inserted at %" PRId64, vdat->names[vdat->selected_files[0]], vdat->beg);
+ else msg = mus_format("selected files inserted at %" PRId64, vdat->beg);
vf_post_error(msg, vdat);
vdat->has_error = false;
free(msg);
@@ -15608,7 +15610,7 @@ static void sort_view_files_small_to_big(Widget w, XtPointer context, XtPointer
static void sort_view_files_xen(Widget w, XtPointer context, XtPointer info)
{
- pointer_or_int_t index;
+ intptr_t index;
XtVaGetValues(w, XmNuserData, &index, NULL); /* index is location in list of file-sorters */
sort_vf((view_files_info *)context, (int)index);
}
@@ -17669,7 +17671,7 @@ static void set_radio_button(prefs_info *prf, int which)
static int which_radio_button(prefs_info *prf)
{
- pointer_or_int_t which = 0;
+ intptr_t which = 0;
XtVaGetValues(prf->radio_button, XmNuserData, &which, NULL);
return(which);
}
@@ -19968,7 +19970,7 @@ widget_t make_preferences_dialog(void)
fft_label = make_top_level_label("transform options", fft_box);
rts_fft_size = transform_size(ss);
- str = mus_format("%lld", rts_fft_size);
+ str = mus_format("%" PRId64, rts_fft_size);
prf = prefs_row_with_number("size", S_transform_size,
str, 12,
fft_box, fft_label,
@@ -22343,7 +22345,7 @@ void hide_toolbar(void)
static void menu_callback(Widget w, XtPointer info, XtPointer context)
{
- pointer_or_int_t callb;
+ intptr_t callb;
XtVaGetValues(w, XmNuserData, &callb, NULL);
g_menu_callback(call_index(callb)); /* menu option activate callback */
}
@@ -22351,7 +22353,7 @@ static void menu_callback(Widget w, XtPointer info, XtPointer context)
static void GHC_callback(Widget w, XtPointer info, XtPointer context)
{
- pointer_or_int_t slot;
+ intptr_t slot;
XtVaGetValues(w, XmNuserData, &slot, NULL);
g_menu_callback(call_index(slot)); /* main menu cascading callback */
}
@@ -22406,7 +22408,7 @@ static bool clobber_menu(Widget w, const char *name)
(mus_strcmp(name, wname)) &&
(XtIsManaged(w)))
{
- pointer_or_int_t slot;
+ intptr_t slot;
XtVaGetValues(w, XmNuserData, &slot, NULL);
unprotect_callback(call_index(slot));
XtUnmanageChild(w);
@@ -23398,7 +23400,7 @@ static void listener_return(widget_t w, int last_prompt)
static void Tab_completion(Widget w, XEvent *event, char **str, Cardinal *num)
{
int completer;
- pointer_or_int_t data;
+ intptr_t data;
XtVaGetValues(w, XmNuserData, &data, NULL);
completer = (int)data;
@@ -25425,7 +25427,7 @@ static Xen mouse_leave_graph_hook;
static void graph_mouse_enter(Widget w, XtPointer context, XEvent *event, Boolean *flag)
{
- pointer_or_int_t data;
+ intptr_t data;
XEnterWindowEvent *ev = (XEnterWindowEvent *)event;
if (with_pointer_focus(ss))
@@ -25445,7 +25447,7 @@ static void graph_mouse_enter(Widget w, XtPointer context, XEvent *event, Boolea
static void graph_mouse_leave(Widget w, XtPointer context, XEvent *event, Boolean *flag)
{
- pointer_or_int_t data;
+ intptr_t data;
XLeaveWindowEvent *ev = (XLeaveWindowEvent *)event;
XtVaGetValues(w, XmNuserData, &data, NULL);
@@ -25786,8 +25788,8 @@ static void cp_graph_key_press(Widget w, XtPointer context, XEvent *event, Boole
static void channel_drop_watcher(Widget w, const char *str, Position x, Position y, void *context)
{
- pointer_or_int_t data;
- data = (pointer_or_int_t)context;
+ intptr_t data;
+ data = (intptr_t)context;
drag_and_drop_mix_at_x_y((int)data, str, x, y);
}
@@ -25795,7 +25797,7 @@ static void channel_drop_watcher(Widget w, const char *str, Position x, Position
static void channel_drag_watcher(Widget w, const char *str, Position x, Position y, drag_style_t dtype, void *context)
{
int snd, chn;
- pointer_or_int_t data;
+ intptr_t data;
snd_info *sp;
XtVaGetValues(w, XmNuserData, &data, NULL);
chn = unpack_channel(data);
@@ -26078,12 +26080,12 @@ int add_channel_window(snd_info *sp, int channel, int chan_y, int insertion, Wid
XtAddEventHandler(cw[W_graph], PointerMotionMask, false, graph_mouse_motion, (XtPointer)cp);
if (!main)
{
- pointer_or_int_t data;
+ intptr_t data;
XtAddEventHandler(cw[W_graph], EnterWindowMask, false, graph_mouse_enter, (XtPointer)cp);
XtAddEventHandler(cw[W_graph], LeaveWindowMask, false, graph_mouse_leave, (XtPointer)cp);
XtAddEventHandler(cw[W_graph], KeyPressMask, false, cp_graph_key_press, (XtPointer)cp);
- data = (pointer_or_int_t)pack_sound_and_channel(sp->index, cp->chan);
+ data = (intptr_t)pack_sound_and_channel(sp->index, cp->chan);
add_drag_and_drop(cw[W_graph], channel_drop_watcher, channel_drag_watcher, (void *)data);
}
@@ -30230,7 +30232,7 @@ static void notebook_page_changed_callback(Widget w, XtPointer context, XtPointe
if (page)
{
int index;
- pointer_or_int_t data;
+ intptr_t data;
XtVaGetValues(page, XmNuserData, &data, NULL);
index = (int)data;
if ((index < ss->max_sounds) &&
diff --git a/snd-prefs.c b/snd-prefs.c
index f892f61..756c261 100644
--- a/snd-prefs.c
+++ b/snd-prefs.c
@@ -14,7 +14,7 @@ static void mus_long_t_to_textfield(widget_t w, mus_long_t val)
{
char *str;
str = (char *)calloc(32, sizeof(char));
- snprintf(str, 32, "%lld", val);
+ snprintf(str, 32, "%" PRId64, val);
SET_TEXT(w, str);
free(str);
}
diff --git a/snd-region.c b/snd-region.c
index b147809..416a17f 100644
--- a/snd-region.c
+++ b/snd-region.c
@@ -649,13 +649,13 @@ static int paste_region_1(int n, chan_info *cp, bool add, mus_long_t beg, io_err
else
{
#if HAVE_FORTH
- origin = mus_format("%d %s %lld %s drop", n, S_integer_to_region, beg, S_mix_region);
+ origin = mus_format("%d %s %" PRId64 " %s drop", n, S_integer_to_region, beg, S_mix_region);
#endif
#if HAVE_RUBY
- origin = mus_format("%s(%s(%d), %lld", to_proc_name(S_mix_region), to_proc_name(S_integer_to_region), n, beg);
+ origin = mus_format("%s(%s(%d), %" PRId64, to_proc_name(S_mix_region), to_proc_name(S_integer_to_region), n, beg);
#endif
#if HAVE_SCHEME || (!HAVE_EXTENSION_LANGUAGE)
- origin = mus_format("%s (%s %d) %lld", S_mix_region, S_integer_to_region, n, beg);
+ origin = mus_format("%s (%s %d) %" PRId64, S_mix_region, S_integer_to_region, n, beg);
#endif
if (si->chans > 1)
remember_temp(newname, si->chans);
@@ -687,13 +687,13 @@ static int paste_region_1(int n, chan_info *cp, bool add, mus_long_t beg, io_err
}
#if HAVE_FORTH
- origin = mus_format("%d %s %lld %s drop", n, S_integer_to_region, beg, S_insert_region);
+ origin = mus_format("%d %s %" PRId64 " %s drop", n, S_integer_to_region, beg, S_insert_region);
#endif
#if HAVE_RUBY
- origin = mus_format("%s(%s(%d), %lld", to_proc_name(S_insert_region), to_proc_name(S_integer_to_region), n, beg);
+ origin = mus_format("%s(%s(%d), %" PRId64, to_proc_name(S_insert_region), to_proc_name(S_integer_to_region), n, beg);
#endif
#if HAVE_SCHEME || (!HAVE_EXTENSION_LANGUAGE)
- origin = mus_format("%s (%s %d) %lld", S_insert_region, S_integer_to_region, n, beg);
+ origin = mus_format("%s (%s %d) %" PRId64, S_insert_region, S_integer_to_region, n, beg);
#endif
for (i = 0; ((i < r->chans) && (i < si->chans)); i++)
@@ -1127,25 +1127,25 @@ void save_regions(FILE *fd)
else
{
#if HAVE_RUBY
- fprintf(fd, "%s(%d, %d, %lld, %d, %.4f, \"%s\", \"%s\", \"%s\", ",
+ fprintf(fd, "%s(%d, %d, %" PRId64 ", %d, %.4f, \"%s\", \"%s\", \"%s\", ",
"restore_region", i, r->chans, r->framples, r->srate, r->maxamp, r->name, r->start, r->end);
- fprintf(fd, " \"%s\", [%d, %lld])\n",
+ fprintf(fd, " \"%s\", [%d, %" PRId64 "])\n",
newname,
(int)mus_sound_write_date(newname),
mus_sound_length(newname));
#endif
#if HAVE_SCHEME
- fprintf(fd, "(%s %d %d %lld %d %.4f \"%s\" \"%s\" \"%s\"",
+ fprintf(fd, "(%s %d %d %" PRId64 " %d %.4f \"%s\" \"%s\" \"%s\"",
S_restore_region, i, r->chans, r->framples, r->srate, r->maxamp, r->name, r->start, r->end);
- fprintf(fd, " \"%s\" (list %d %lld))\n",
+ fprintf(fd, " \"%s\" (list %d %" PRId64 "))\n",
newname,
(int)mus_sound_write_date(newname),
mus_sound_length(newname));
#endif
#if HAVE_FORTH
- fprintf(fd, "%d %d %lld %d %.4f \"%s\" \"%s\" \"%s\"",
+ fprintf(fd, "%d %d %" PRId64 " %d %.4f \"%s\" \"%s\" \"%s\"",
i, r->chans, r->framples, r->srate, r->maxamp, r->name, r->start, r->end);
- fprintf(fd, " \"%s\" '( %d %lld ) %s drop\n",
+ fprintf(fd, " \"%s\" '( %d %" PRId64 " ) %s drop\n",
newname,
(int)mus_sound_write_date(newname),
mus_sound_length(newname),
@@ -1331,7 +1331,7 @@ io_error_t save_region(int rg, const char *name, mus_sample_t samp_type, mus_hea
for (i = 0; i < chans; i++) bufs[i] = (mus_float_t *)calloc(FILE_BUFFER_SIZE, sizeof(mus_float_t));
if (((framples * chans * mus_sound_datum_size(r->filename)) >> 10) > disk_kspace(name))
- snd_warning("not enough space to save region? -- need %lld bytes",
+ snd_warning("not enough space to save region? -- need %" PRId64 " bytes",
framples * chans * mus_sound_datum_size(r->filename));
for (ioff = 0; ioff < framples; ioff += FILE_BUFFER_SIZE)
@@ -1493,7 +1493,11 @@ static Xen s7_xen_region_length(s7_scheme *sc, Xen obj)
static void init_xen_region(void)
{
#if HAVE_SCHEME
- xen_region_tag = s7_new_type_x(s7, "<region>", print_xen_region, free_xen_region, s7_xen_region_equalp, NULL, NULL, NULL, s7_xen_region_length, NULL, NULL, NULL);
+ xen_region_tag = s7_make_c_type(s7, "<region>");
+ s7_c_type_set_print(s7, xen_region_tag, print_xen_region);
+ s7_c_type_set_free(s7, xen_region_tag, free_xen_region);
+ s7_c_type_set_equal(s7, xen_region_tag, s7_xen_region_equalp);
+ s7_c_type_set_length(s7, xen_region_tag, s7_xen_region_length);
#else
#if HAVE_RUBY
xen_region_tag = Xen_make_object_type("XenRegion", sizeof(xen_region));
@@ -1559,6 +1563,7 @@ static Xen g_restore_region(Xen args)
int i, regn;
Xen arg, pos, chans, len, srate, maxamp, name, start, end, filename, date;
+ Xen_check_type(Xen_list_length(args) == 10, args, 0, S_restore_region, "10 items");
arg = args;
pos = Xen_car(arg);
Xen_check_type(Xen_is_integer(pos), pos, 1, S_restore_region, "a region id");
diff --git a/snd-select.c b/snd-select.c
index 8f9be90..cddedd0 100644
--- a/snd-select.c
+++ b/snd-select.c
@@ -379,13 +379,13 @@ static int mix_selection(chan_info *cp, sync_info *si_out, mus_long_t beg, io_er
{
char *origin = NULL;
#if HAVE_FORTH
- origin = mus_format("%lld snd chn %s", beg, S_mix_selection);
+ origin = mus_format("%" PRId64 " snd chn %s", beg, S_mix_selection);
#else
#if HAVE_SCHEME
- origin = mus_format("-mix-selection- %lld %lld %lld snd chn",
+ origin = mus_format("-mix-selection- %" PRId64 " %" PRId64 " %" PRId64 " snd chn",
beg, selection_beg(cp), selection_len());
#else
- origin = mus_format("%s" PROC_OPEN "%lld", to_proc_name(S_mix_selection), beg);
+ origin = mus_format("%s" PROC_OPEN "%" PRId64, to_proc_name(S_mix_selection), beg);
#endif
#endif
if (si_out->chans > 1)
@@ -461,9 +461,9 @@ static io_error_t insert_selection(chan_info *cp, sync_info *si_out, mus_long_t
cp_in = si_in->cps[i]; /* selection chan to paste in (no wrap-around here) */
len = cp_selection_len(cp_in, NULL);
#if HAVE_FORTH
- origin = mus_format("%lld %s", beg, S_insert_selection);
+ origin = mus_format("%" PRId64 " %s", beg, S_insert_selection);
#else
- origin = mus_format("%s" PROC_OPEN "%lld", to_proc_name(S_insert_selection), beg);
+ origin = mus_format("%s" PROC_OPEN "%" PRId64, to_proc_name(S_insert_selection), beg);
#endif
if (file_insert_samples(beg, len,
tempfile, cp_out, i,
@@ -1038,10 +1038,13 @@ static Xen s7_xen_selection_fill(s7_scheme *sc, Xen args)
static void init_xen_selection(void)
{
#if HAVE_SCHEME
- xen_selection_tag = s7_new_type_x(s7, "<selection>",
- print_xen_selection, free_xen_selection, s7_xen_selection_equalp,
- NULL, NULL, NULL, s7_xen_selection_length,
- s7_xen_selection_copy, NULL, s7_xen_selection_fill);
+ xen_selection_tag = s7_make_c_type(s7, "<selection>");
+ s7_c_type_set_print(s7, xen_selection_tag, print_xen_selection);
+ s7_c_type_set_free(s7, xen_selection_tag, free_xen_selection);
+ s7_c_type_set_equal(s7, xen_selection_tag, s7_xen_selection_equalp);
+ s7_c_type_set_length(s7, xen_selection_tag, s7_xen_selection_length);
+ s7_c_type_set_copy(s7, xen_selection_tag, s7_xen_selection_copy);
+ s7_c_type_set_fill(s7, xen_selection_tag, s7_xen_selection_fill);
#else
#if HAVE_RUBY
xen_selection_tag = Xen_make_object_type("XenSelection", sizeof(xen_selection));
diff --git a/snd-sig.c b/snd-sig.c
index 24307ad..480d4a4 100644
--- a/snd-sig.c
+++ b/snd-sig.c
@@ -584,9 +584,9 @@ bool scale_to(snd_info *sp, chan_info *cp, mus_float_t *ur_scalers, int len, boo
beg = selection_beg(ncp);
framples = selection_end(ncp) - beg + 1;
#if HAVE_FORTH
- origin = mus_format("%.3f" PROC_SEP "%lld" PROC_SEP "%lld %s", norm, beg, framples, S_normalize_channel);
+ origin = mus_format("%.3f" PROC_SEP "%" PRId64 PROC_SEP "%" PRId64 " %s", norm, beg, framples, S_normalize_channel);
#else
- origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%lld" PROC_SEP "%lld", to_proc_name(S_normalize_channel), norm, beg, framples);
+ origin = mus_format("%s" PROC_OPEN "%.3f" PROC_SEP "%" PRId64 PROC_SEP "%" PRId64, to_proc_name(S_normalize_channel), norm, beg, framples);
#endif
}
else
@@ -842,12 +842,12 @@ static char *reverse_channel(chan_info *cp, snd_fd *sf, mus_long_t beg, mus_long
#if HAVE_FORTH
if (dur == cp->edits[edpos]->samples)
- origin = mus_format("%lld" PROC_SEP PROC_FALSE " %s", beg, S_reverse_channel);
- else origin = mus_format("%lld" PROC_SEP "%lld %s", beg, dur, S_reverse_channel);
+ origin = mus_format("%" PRId64 PROC_SEP PROC_FALSE " %s", beg, S_reverse_channel);
+ else origin = mus_format("%" PRId64 PROC_SEP "%" PRId64 " %s", beg, dur, S_reverse_channel);
#else
if (dur == cp->edits[edpos]->samples)
- origin = mus_format("%s" PROC_OPEN "%lld" PROC_SEP PROC_FALSE, to_proc_name(S_reverse_channel), beg);
- else origin = mus_format("%s" PROC_OPEN "%lld" PROC_SEP "%lld", to_proc_name(S_reverse_channel), beg, dur);
+ origin = mus_format("%s" PROC_OPEN "%" PRId64 PROC_SEP PROC_FALSE, to_proc_name(S_reverse_channel), beg);
+ else origin = mus_format("%s" PROC_OPEN "%" PRId64 PROC_SEP "%" PRId64, to_proc_name(S_reverse_channel), beg, dur);
#endif
if (temp_file)
@@ -1095,7 +1095,7 @@ static char *src_channel_with_error(chan_info *cp, snd_fd *sf, mus_long_t beg, m
io_error_t io_err = IO_NO_ERROR;
src_state *sr;
- /* fprintf(stderr, "src: %lld %f %s\n", dur, ratio, origin); */
+ /* fprintf(stderr, "src: %" PRId64 " %f %s\n", dur, ratio, origin); */
if ((!egen) && (sf->edit_ctr == cp->edit_ctr))
{
@@ -1320,12 +1320,12 @@ static char *src_channel_with_error(chan_info *cp, snd_fd *sf, mus_long_t beg, m
#if HAVE_FORTH
if (dur == cp->edits[sf->edit_ctr]->samples)
- new_origin = mus_format("%.4f" PROC_SEP "%lld" PROC_SEP PROC_FALSE " %s", ratio, beg, S_src_channel);
- else new_origin = mus_format("%.4f" PROC_SEP "%lld" PROC_SEP "%lld %s", ratio, beg, dur, S_src_channel);
+ new_origin = mus_format("%.4f" PROC_SEP "%" PRId64 PROC_SEP PROC_FALSE " %s", ratio, beg, S_src_channel);
+ else new_origin = mus_format("%.4f" PROC_SEP "%" PRId64 PROC_SEP "%" PRId64 " %s", ratio, beg, dur, S_src_channel);
#else
if (dur == cp->edits[sf->edit_ctr]->samples)
- new_origin = mus_format("%s" PROC_OPEN "%.4f" PROC_SEP "%lld" PROC_SEP PROC_FALSE, to_proc_name(S_src_channel), ratio, beg);
- else new_origin = mus_format("%s" PROC_OPEN "%.4f" PROC_SEP "%lld" PROC_SEP "%lld", to_proc_name(S_src_channel), ratio, beg, dur);
+ new_origin = mus_format("%s" PROC_OPEN "%.4f" PROC_SEP "%" PRId64 PROC_SEP PROC_FALSE, to_proc_name(S_src_channel), ratio, beg);
+ else new_origin = mus_format("%s" PROC_OPEN "%.4f" PROC_SEP "%" PRId64 PROC_SEP "%" PRId64, to_proc_name(S_src_channel), ratio, beg, dur);
#endif
}
else
@@ -1341,18 +1341,18 @@ static char *src_channel_with_error(chan_info *cp, snd_fd *sf, mus_long_t beg, m
if (base == 1.0)
{
if (dur == cp->edits[sf->edit_ctr]->samples)
- new_origin = mus_format("%s" PROC_SEP "%lld" PROC_SEP PROC_FALSE " %s", envstr, beg, S_src_channel);
- else new_origin = mus_format("%s" PROC_SEP "%lld" PROC_SEP "%lld %s", envstr, beg, dur, S_src_channel);
+ new_origin = mus_format("%s" PROC_SEP "%" PRId64 PROC_SEP PROC_FALSE " %s", envstr, beg, S_src_channel);
+ else new_origin = mus_format("%s" PROC_SEP "%" PRId64 PROC_SEP "%" PRId64 " %s", envstr, beg, dur, S_src_channel);
}
- else new_origin = mus_format("%s :base %.4f :end %lld %s %lld" PROC_SEP "%lld %s", envstr, base, dur, S_make_env, beg, dur, S_src_channel);
+ else new_origin = mus_format("%s :base %.4f :end %" PRId64 " %s %" PRId64 PROC_SEP "%" PRId64 " %s", envstr, base, dur, S_make_env, beg, dur, S_src_channel);
#else
if (base == 1.0)
{
if (dur == cp->edits[sf->edit_ctr]->samples)
- new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%lld" PROC_SEP PROC_FALSE, to_proc_name(S_src_channel), envstr, beg);
- else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%lld" PROC_SEP "%lld", to_proc_name(S_src_channel), envstr, beg, dur);
+ new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%" PRId64 PROC_SEP PROC_FALSE, to_proc_name(S_src_channel), envstr, beg);
+ else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%" PRId64 PROC_SEP "%" PRId64, to_proc_name(S_src_channel), envstr, beg, dur);
}
- else new_origin = mus_format("%s" PROC_OPEN BPAREN "%s" PROC_OPEN "%s" PROC_SEP ":base" PROC_SEP "%.4f" PROC_SEP ":end" PROC_SEP "%lld)" PROC_SEP "%lld" PROC_SEP "%lld",
+ else new_origin = mus_format("%s" PROC_OPEN BPAREN "%s" PROC_OPEN "%s" PROC_SEP ":base" PROC_SEP "%.4f" PROC_SEP ":end" PROC_SEP "%" PRId64 ")" PROC_SEP "%" PRId64 PROC_SEP "%" PRId64,
to_proc_name(S_make_env), to_proc_name(S_src_channel), envstr, base, dur, beg, dur);
#endif
if (envstr) free(envstr);
@@ -2165,13 +2165,13 @@ static char *direct_filter(chan_info *cp, int order, env *e, snd_fd *sf, mus_lon
#if HAVE_FORTH
if (dur == (order + cp->edits[sf->edit_ctr]->samples))
- new_origin = mus_format("%s %d %lld" PROC_SEP PROC_FALSE " %s", vstr, order, beg, S_filter_channel);
- else new_origin = mus_format("%s %d %lld" PROC_SEP "%lld %s", vstr, order, beg, dur, S_filter_channel);
+ new_origin = mus_format("%s %d %" PRId64 PROC_SEP PROC_FALSE " %s", vstr, order, beg, S_filter_channel);
+ else new_origin = mus_format("%s %d %" PRId64 PROC_SEP "%" PRId64 " %s", vstr, order, beg, dur, S_filter_channel);
#else
if (dur == (order + cp->edits[sf->edit_ctr]->samples))
- new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP "%lld" PROC_SEP PROC_FALSE,
+ new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP "%" PRId64 PROC_SEP PROC_FALSE,
to_proc_name(S_filter_channel), vstr, order, beg);
- else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP "%lld" PROC_SEP "%lld",
+ else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP "%" PRId64 PROC_SEP "%" PRId64,
to_proc_name(S_filter_channel), vstr, order, beg, dur);
#endif
@@ -2188,13 +2188,13 @@ static char *direct_filter(chan_info *cp, int order, env *e, snd_fd *sf, mus_lon
#if HAVE_FORTH
if (dur == (order + cp->edits[sf->edit_ctr]->samples))
- new_origin = mus_format("%s %d %lld" PROC_SEP PROC_FALSE " %s", envstr, order, beg, S_filter_channel);
- else new_origin = mus_format("%s %d %lld" PROC_SEP "%lld %s", envstr, order, beg, dur, S_filter_channel);
+ new_origin = mus_format("%s %d %" PRId64 PROC_SEP PROC_FALSE " %s", envstr, order, beg, S_filter_channel);
+ else new_origin = mus_format("%s %d %" PRId64 PROC_SEP "%" PRId64 " %s", envstr, order, beg, dur, S_filter_channel);
#else
if (dur == (order + cp->edits[sf->edit_ctr]->samples))
- new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP "%lld" PROC_SEP PROC_FALSE,
+ new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP "%" PRId64 PROC_SEP PROC_FALSE,
to_proc_name(S_filter_channel), envstr, order, beg);
- else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP "%lld" PROC_SEP "%lld",
+ else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%d" PROC_SEP "%" PRId64 PROC_SEP "%" PRId64,
to_proc_name(S_filter_channel), envstr, order, beg, dur);
#endif
if (envstr) free(envstr);
@@ -2410,14 +2410,14 @@ static char *edit_list_envelope(mus_any *egen, mus_long_t beg, mus_long_t env_du
{
#if HAVE_FORTH
if (base == 1.0)
- new_origin = mus_format("%s %lld" PROC_SEP PROC_FALSE " %s", envstr, beg, S_env_channel);
- else new_origin = mus_format("%s %.4f %lld" PROC_SEP PROC_FALSE " %s",
+ new_origin = mus_format("%s %" PRId64 PROC_SEP PROC_FALSE " %s", envstr, beg, S_env_channel);
+ else new_origin = mus_format("%s %.4f %" PRId64 PROC_SEP PROC_FALSE " %s",
envstr, base, beg, S_env_channel_with_base);
#else
if (base == 1.0)
- new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%lld" PROC_SEP PROC_FALSE,
+ new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%" PRId64 PROC_SEP PROC_FALSE,
to_proc_name(S_env_channel), envstr, beg);
- else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%.4f" PROC_SEP "%lld" PROC_SEP PROC_FALSE,
+ else new_origin = mus_format("%s" PROC_OPEN "%s" PROC_SEP "%.4f" PROC_SEP "%" PRId64 PROC_SEP PROC_FALSE,
to_proc_name(S_env_channel_with_base), envstr, base, beg);
#endif
}
@@ -2425,10 +2425,10 @@ static char *edit_list_envelope(mus_any *egen, mus_long_t beg, mus_long_t env_du
{
/* env dur was apparently not chan dur, or called dur was not full sound? */
#if HAVE_FORTH
- new_origin = mus_format("%s :base %.4f :end %lld %s %lld" PROC_SEP "%lld %s",
+ new_origin = mus_format("%s :base %.4f :end %" PRId64 " %s %" PRId64 PROC_SEP "%" PRId64 " %s",
envstr, base, env_dur, S_make_env, beg, called_dur, S_env_channel);
#else
- new_origin = mus_format("%s" PROC_OPEN BPAREN "%s" PROC_OPEN "%s" PROC_SEP ":base" PROC_SEP "%.4f" PROC_SEP ":end" PROC_SEP "%lld)" PROC_SEP "%lld" PROC_SEP "%lld",
+ new_origin = mus_format("%s" PROC_OPEN BPAREN "%s" PROC_OPEN "%s" PROC_SEP ":base" PROC_SEP "%.4f" PROC_SEP ":end" PROC_SEP "%" PRId64 ")" PROC_SEP "%" PRId64 PROC_SEP "%" PRId64,
to_proc_name(S_env_channel), to_proc_name(S_make_env), envstr, base, env_dur, beg, called_dur);
#endif
}
@@ -3079,9 +3079,9 @@ static void smooth_channel(chan_info *cp, mus_long_t beg, mus_long_t dur, int ed
y1 = chn_sample(beg + dur, cp, edpos); /* one past end -- this is a debatable choice */
#if HAVE_FORTH
- origin = mus_format("%lld" PROC_SEP "%lld %s", beg, dur, S_smooth_channel);
+ origin = mus_format("%" PRId64 PROC_SEP "%" PRId64 " %s", beg, dur, S_smooth_channel);
#else
- origin = mus_format("%s" PROC_OPEN "%lld" PROC_SEP "%lld", to_proc_name(S_smooth_channel), beg, dur);
+ origin = mus_format("%s" PROC_OPEN "%" PRId64 PROC_SEP "%" PRId64, to_proc_name(S_smooth_channel), beg, dur);
#endif
data = (mus_float_t *)malloc(dur * sizeof(mus_float_t));
@@ -3358,7 +3358,7 @@ static Xen map_channel_to_temp_file(chan_info *cp, snd_fd *sf, Xen proc, mus_lon
data[0] = (mus_float_t *)malloc(MAX_BUFFER_SIZE * sizeof(mus_float_t));
ss->stopped_explicitly = false;
- /* fprintf(stderr, "tempfile %d, %lld %s\n", __LINE__, num, DISPLAY(body)); */
+ /* fprintf(stderr, "tempfile %d, %" PRId64 " %s\n", __LINE__, num, DISPLAY(body)); */
for (kp = 0; kp < num; kp++)
{
/* changed here to remove catch 24-Mar-02 */
@@ -3655,7 +3655,7 @@ static Xen map_channel_to_buffer(chan_info *cp, snd_fd *sf, Xen proc, mus_long_t
proc_loc = s7_gc_protect(s7, proc);
#endif
- /* fprintf(stderr, "map %lld: body: %s\n", num, s7_object_to_c_string(s7, body)); */
+ /* fprintf(stderr, "map %" PRId64 ": body: %s\n", num, s7_object_to_c_string(s7, body)); */
data = (mus_float_t *)calloc(num, sizeof(mus_float_t));
#if HAVE_SCHEME
@@ -4006,7 +4006,7 @@ static Xen g_sp_scan(Xen proc_and_list, Xen s_beg, Xen s_end, Xen snd, Xen chn,
use_apply = true;
}
- /* fprintf(stderr, "scan %lld: body: %s\n", num, s7_object_to_c_string(s7, body)); */
+ /* fprintf(stderr, "scan %" PRId64 ": body: %s\n", num, s7_object_to_c_string(s7, body)); */
reporting = ((num > REPORTING_SIZE) && (!(cp->squelch_update)));
if (reporting) start_progress_report(cp);
@@ -4070,7 +4070,7 @@ static Xen g_sp_scan(Xen proc_and_list, Xen s_beg, Xen s_end, Xen snd, Xen chn,
if (ss->stopped_explicitly)
{
ss->stopped_explicitly = false;
- status_report(sp, "%s stopped at sample %lld", caller, kp + beg);
+ status_report(sp, "%s stopped at sample %" PRId64, caller, kp + beg);
break;
}
}
diff --git a/snd-snd.c b/snd-snd.c
index b994cf2..0903d91 100644
--- a/snd-snd.c
+++ b/snd-snd.c
@@ -1749,19 +1749,19 @@ static bool apply_controls(apply_state *ap)
else filterstr = mus_strdup(PROC_FALSE);
#if HAVE_FORTH
if (orig_apply_dur == 0)
- ap->origin = mus_format(" '( %s %s %s %s %s %s ) %lld" PROC_SEP PROC_FALSE " %s",
+ ap->origin = mus_format(" '( %s %s %s %s %s %s ) %" PRId64 PROC_SEP PROC_FALSE " %s",
ampstr, speedstr, contraststr, expandstr, reverbstr, filterstr,
apply_beg, S_controls_to_channel);
- else ap->origin = mus_format(" '( %s %s %s %s %s %s ) %lld" PROC_SEP "%lld %s",
+ else ap->origin = mus_format(" '( %s %s %s %s %s %s ) %" PRId64 PROC_SEP "%" PRId64 " %s",
ampstr, speedstr, contraststr, expandstr, reverbstr, filterstr,
apply_beg, apply_dur, S_controls_to_channel);
#else
if (orig_apply_dur == 0)
- ap->origin = mus_format("%s" PROC_OPEN LIST_OPEN "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" LIST_CLOSE PROC_SEP "%lld" PROC_SEP PROC_FALSE,
+ ap->origin = mus_format("%s" PROC_OPEN LIST_OPEN "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" LIST_CLOSE PROC_SEP "%" PRId64 PROC_SEP PROC_FALSE,
to_proc_name(S_controls_to_channel),
ampstr, speedstr, contraststr, expandstr, reverbstr, filterstr,
apply_beg);
- else ap->origin = mus_format("%s" PROC_OPEN LIST_OPEN "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" LIST_CLOSE PROC_SEP "%lld" PROC_SEP "%lld",
+ else ap->origin = mus_format("%s" PROC_OPEN LIST_OPEN "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" PROC_SEP "%s" LIST_CLOSE PROC_SEP "%" PRId64 PROC_SEP "%" PRId64,
to_proc_name(S_controls_to_channel),
ampstr, speedstr, contraststr, expandstr, reverbstr, filterstr,
apply_beg, apply_dur);
@@ -2307,8 +2307,13 @@ static Xen s7_xen_sound_fill(s7_scheme *sc, Xen args)
static void init_xen_sound(void)
{
#if HAVE_SCHEME
- xen_sound_tag = s7_new_type_x(s7, "<sound>", print_xen_sound, free_xen_sound, s7_xen_sound_equalp,
- NULL, NULL, NULL, s7_xen_sound_length, s7_xen_sound_copy, NULL, s7_xen_sound_fill);
+ xen_sound_tag = s7_make_c_type(s7, "<sound>");
+ s7_c_type_set_print(s7, xen_sound_tag, print_xen_sound);
+ s7_c_type_set_free(s7, xen_sound_tag, free_xen_sound);
+ s7_c_type_set_equal(s7, xen_sound_tag, s7_xen_sound_equalp);
+ s7_c_type_set_length(s7, xen_sound_tag, s7_xen_sound_length);
+ s7_c_type_set_copy(s7, xen_sound_tag, s7_xen_sound_copy);
+ s7_c_type_set_fill(s7, xen_sound_tag, s7_xen_sound_fill);
#else
#if HAVE_RUBY
xen_sound_tag = Xen_make_object_type("XenSound", sizeof(xen_sound));
@@ -3963,7 +3968,7 @@ open filename (as if opened from File:Open menu option), and return the new soun
return(Xen_false);
}
-
+#if (!HAVE_SCHEME)
static Xen kw_header_type, kw_file, kw_srate, kw_channel, kw_sound, kw_edit_position, kw_channels, kw_size, kw_comment, kw_sample_type;
static void init_sound_keywords(void)
@@ -3979,6 +3984,7 @@ static void init_sound_keywords(void)
kw_size = Xen_make_keyword("size");
kw_comment = Xen_make_keyword("comment");
}
+#endif
#define H_open_raw_sound "(" S_open_raw_sound " file channels srate sample-type): \
open file assuming the data matches the attributes indicated unless the file actually has a header"
@@ -4160,9 +4166,6 @@ static Xen g_view_sound(Xen filename)
return(Xen_false);
}
-
-static Xen g_save_sound_as(Xen arglist)
-{
#if HAVE_SCHEME
#define save_as_example "(" S_save_sound_as " \"test.snd\" index 44100 " S_mus_bshort " " S_mus_next ")"
#endif
@@ -4177,6 +4180,97 @@ static Xen g_save_sound_as(Xen arglist)
save sound in file using the indicated attributes. If channel is specified, only that channel is saved (extracted). \
Omitted arguments take their value from the sound being saved.\n " save_as_example
+#if HAVE_SCHEME
+static s7_pointer g_save_sound_as(s7_scheme *sc, s7_pointer args)
+{
+ snd_info *sp = NULL;
+ file_info *hdr;
+ mus_header_t ht;
+ mus_sample_t df;
+ char *fname = NULL;
+ int sr, chan;
+ const char *outcom, *file;
+ io_error_t io_err = IO_NO_ERROR;
+ s7_pointer p, fp, index, edpos, pchan, filep;
+ bool free_outcom = false;
+ int i, edit_position = AT_CURRENT_EDIT_POSITION;
+
+ /* fprintf(stderr, "args: %s\n", s7_object_to_c_string(sc, args)); */
+
+ fp = s7_car(args);
+ filep = fp;
+ if (fp != Xen_false)
+ {
+ if (!s7_is_string(fp))
+ return(s7_wrong_type_arg_error(sc, S_save_sound_as, 1, fp, "a string (a filename)"));
+ file = s7_string(fp);
+ }
+ else file = NULL;
+
+ index = s7_cadr(args);
+ Snd_assert_sound(S_save_sound_as, index, 2);
+ sp = get_sp(index);
+ if (!sp)
+ return(snd_no_such_sound_error(S_save_sound_as, index));
+ hdr = sp->hdr;
+
+ p = s7_cddr(args);
+ fp = s7_car(p);
+ if (fp != Xen_false)
+ {
+ if (!s7_is_integer(fp))
+ return(s7_wrong_type_arg_error(sc, S_save_sound_as, 3, fp, "an integer (srate)"));
+ sr = s7_integer(fp);
+ if (sr <= 0)
+ Xen_error(Xen_make_error_type("cannot-save"),
+ Xen_list_2(C_string_to_Xen_string(S_save_sound_as ": srate (~A) can't be <= 0"), fp));
+ }
+ else sr = -1;
+
+ fp = s7_cadr(p);
+ if (fp != Xen_false)
+ {
+ if (!s7_is_integer(fp))
+ return(s7_wrong_type_arg_error(sc, S_save_sound_as, 4, fp, "an integer (sample type)"));
+ df = (mus_sample_t)s7_integer(fp);
+ }
+ else df = MUS_UNKNOWN_SAMPLE;
+
+ p = s7_cddr(p);
+ fp = s7_car(p);
+ if (fp != Xen_false)
+ {
+ if (!s7_is_integer(fp))
+ return(s7_wrong_type_arg_error(sc, S_save_sound_as, 5, fp, "an integer (header type)"));
+ ht = (mus_header_t)s7_integer(fp);
+ }
+ else ht = MUS_UNKNOWN_HEADER;
+
+ fp = s7_cadr(p);
+ pchan = fp;
+ if (fp != Xen_false)
+ {
+ if (!s7_is_integer(fp))
+ return(s7_wrong_type_arg_error(sc, S_save_sound_as, 6, fp, "an integer (channel)"));
+ chan = s7_integer(fp);
+ }
+ else chan = -1;
+
+ p = s7_cddr(p);
+ edpos = s7_car(p);
+
+ fp = s7_cadr(p);
+ if (fp != Xen_false)
+ {
+ if (!s7_is_string(fp))
+ return(s7_wrong_type_arg_error(sc, S_save_sound_as, 8, fp, "a string"));
+ outcom = s7_string(fp);
+ }
+ else outcom = NULL;
+
+#else
+static Xen g_save_sound_as(Xen arglist)
+{
snd_info *sp;
file_info *hdr;
mus_header_t ht = MUS_UNKNOWN_HEADER;
@@ -4189,8 +4283,8 @@ Omitted arguments take their value from the sound being saved.\n " save_as_exam
Xen keys[8];
int orig_arg[8] = {0, 0, 0, 0, 0, 0, 0, 0};
int vals, i, arglist_len;
- Xen edpos = Xen_undefined, index = Xen_undefined;
- bool got_edpos = false, free_outcom = false;
+ Xen edpos = Xen_undefined, index = Xen_undefined, pchan;
+ bool free_outcom = false, filep;
keys[0] = kw_file;
keys[1] = kw_sound;
@@ -4223,14 +4317,13 @@ Omitted arguments take their value from the sound being saved.\n " save_as_exam
C_int_to_Xen_integer(sr)));
chan = mus_optkey_to_int(keys[5], S_save_sound_as, orig_arg[5], chan);
- if (!(Xen_is_keyword(keys[6])))
- {
- edpos = keys[6];
- if ((Xen_is_integer(edpos)) || (Xen_is_procedure(edpos)))
- got_edpos = true;
- }
+ if (!(Xen_is_keyword(keys[6])))
+ edpos = keys[6];
outcom = mus_optkey_to_string(keys[7], S_save_sound_as, orig_arg[7], NULL);
}
+ pchan = keys[5];
+ filep = keys[0];
+#endif
if ((!file) ||
(is_directory(file)))
@@ -4291,9 +4384,9 @@ Omitted arguments take their value from the sound being saved.\n " save_as_exam
C_string_to_Xen_string(mus_header_type_name(ht))));
if (chan >= (int)(sp->nchans))
- return(snd_no_such_channel_error(S_save_sound_as, index, keys[5]));
+ return(snd_no_such_channel_error(S_save_sound_as, index, pchan));
- if (got_edpos)
+ if (Xen_is_integer(edpos))
{
edit_position = to_c_edit_position(sp->chans[(chan >= 0) ? chan : 0], edpos, S_save_sound_as, 7);
for (i = 0; i < (int)sp->nchans; i++)
@@ -4343,7 +4436,7 @@ Omitted arguments take their value from the sound being saved.\n " save_as_exam
}
if (fname) free(fname);
- return(args[orig_arg[0] - 1]);
+ return(filep);
}
#if HAVE_SCHEME
@@ -5208,22 +5301,22 @@ where each inner list entry can also be " PROC_FALSE "."
#if HAVE_EXTENSION_LANGUAGE
#if HAVE_FORTH
if (!(Xen_is_number(dur)))
- ap->origin = mus_format("%s %lld" PROC_SEP PROC_FALSE " %s",
+ ap->origin = mus_format("%s %" PRId64 PROC_SEP PROC_FALSE " %s",
Xen_object_to_C_string(settings),
apply_beg, S_controls_to_channel);
- else ap->origin = mus_format("%s " PROC_SEP "%lld" PROC_SEP "%lld %s",
+ else ap->origin = mus_format("%s " PROC_SEP "%" PRId64 PROC_SEP "%" PRId64 " %s",
Xen_object_to_C_string(settings),
apply_beg, apply_dur, S_controls_to_channel);
#else
{
char *temp = NULL;
if (!(Xen_is_number(dur)))
- ap->origin = mus_format("%s" PROC_OPEN "%s%s" PROC_SEP "%lld" PROC_SEP PROC_FALSE,
+ ap->origin = mus_format("%s" PROC_OPEN "%s%s" PROC_SEP "%" PRId64 PROC_SEP PROC_FALSE,
to_proc_name(S_controls_to_channel),
PROC_QUOTE,
temp = Xen_object_to_C_string(settings),
apply_beg);
- else ap->origin = mus_format("%s" PROC_OPEN "%s%s" PROC_SEP "%lld" PROC_SEP "%lld",
+ else ap->origin = mus_format("%s" PROC_OPEN "%s%s" PROC_SEP "%" PRId64 PROC_SEP "%" PRId64,
to_proc_name(S_controls_to_channel),
PROC_QUOTE,
temp = Xen_object_to_C_string(settings),
@@ -5962,7 +6055,6 @@ Xen_wrap_1_optional_arg(g_save_sound_w, g_save_sound)
Xen_wrap_1_arg(g_open_sound_w, g_open_sound)
Xen_wrap_1_arg(g_view_sound_w, g_view_sound)
Xen_wrap_1_optional_arg(g_revert_sound_w, g_revert_sound)
-Xen_wrap_any_args(g_save_sound_as_w, g_save_sound_as)
Xen_wrap_4_optional_args(g_apply_controls_w, g_apply_controls)
Xen_wrap_6_optional_args(g_controls_to_channel_w, g_controls_to_channel)
Xen_wrap_1_optional_arg(g_filter_control_envelope_w, g_filter_control_envelope)
@@ -6049,6 +6141,7 @@ Xen_wrap_2_optional_args(g_status_report_w, g_status_report)
#define g_set_speed_control_style_w g_set_speed_control_style_reversed
#define g_set_speed_control_tones_w g_set_speed_control_tones_reversed
#else
+Xen_wrap_any_args(g_save_sound_as_w, g_save_sound_as)
Xen_wrap_any_args(g_new_sound_w, g_new_sound)
Xen_wrap_any_args(g_open_raw_sound_w, g_open_raw_sound)
Xen_wrap_2_optional_args(g_set_filter_control_envelope_w, g_set_filter_control_envelope)
@@ -6146,7 +6239,9 @@ void g_init_snd(void)
#endif
init_xen_sound();
+#if (!HAVE_SCHEME)
init_sound_keywords();
+#endif
#define H_name_click_hook S_name_click_hook " (snd): called when sound name clicked. \
If it returns " PROC_TRUE ", the usual informative status babbling is squelched."
@@ -6207,14 +6302,15 @@ If it returns " PROC_TRUE ", the usual informative status babbling is squelched.
Xen_define_unsafe_typed_procedure(S_open_sound, g_open_sound_w, 1, 0, 0, H_open_sound, s7_make_signature(s7, 2, sd, s));
Xen_define_unsafe_typed_procedure(S_view_sound, g_view_sound_w, 1, 0, 0, H_view_sound, s7_make_signature(s7, 2, sd, s));
Xen_define_unsafe_typed_procedure(S_revert_sound, g_revert_sound_w, 0, 1, 0, H_revert_sound, s7_make_signature(s7, 2, sd, sd));
- Xen_define_unsafe_typed_procedure(S_save_sound_as, g_save_sound_as_w, 0, 0, 1, H_save_sound_as, s7_make_circular_signature(s7, 0, 1, t));
#if HAVE_SCHEME
s7_define_function_star(s7, S_new_sound, g_new_sound, "file channels srate sample-type header-type comment size", H_new_sound);
+ s7_define_function_star(s7, S_save_sound_as, g_save_sound_as, "file sound srate sample-type header-type channel edit-position comment", H_save_sound_as);
s7_define_function_star(s7, S_open_raw_sound, g_open_raw_sound, "file channels srate sample-type", H_open_raw_sound);
#else
Xen_define_unsafe_typed_procedure(S_new_sound, g_new_sound_w, 0, 0, 1, H_new_sound, s7_make_circular_signature(s7, 0, 1, t));
Xen_define_unsafe_typed_procedure(S_open_raw_sound, g_open_raw_sound_w, 0, 0, 1, H_open_raw_sound, s7_make_circular_signature(s7, 0, 1, t));
+ Xen_define_unsafe_typed_procedure(S_save_sound_as, g_save_sound_as_w, 0, 0, 1, H_save_sound_as, s7_make_circular_signature(s7, 0, 1, t));
#endif
Xen_define_typed_procedure(S_apply_controls, g_apply_controls_w, 0, 4, 0, H_apply_controls, s7_make_signature(s7, 5, t, t, i, i, i));
diff --git a/snd-test.rb b/snd-test.rb
index 8ed4274..2274b81 100644
--- a/snd-test.rb
+++ b/snd-test.rb
@@ -2,8 +2,7 @@
# Translator/Author: Michael Scholz <mi-scholz@users.sourceforge.net>
# Created: 2005/02/18 10:18:34
-# Changed: 2016/11/17 15:25:21
-# Changed: 2016/12/29 00:20:51
+# Changed: 2017/08/14 06:13:35
# Tags: FIXME - something is wrong
# XXX - info marker
@@ -33884,9 +33883,8 @@ def test_23_04
map_channel(lambda do |y| pvocoder(pv, rd) end)
close_sound(ind)
#
- make_birds
- if $with_test_nogui
- puts
+ with_sound(:to_snd, :snd) do
+ make_birds
end
Snd.sounds.apply(:close_sound)
#
diff --git a/snd-test.scm b/snd-test.scm
index 1e9e82f..201e05c 100644
--- a/snd-test.scm
+++ b/snd-test.scm
@@ -1235,7 +1235,8 @@
(rational? newval)
(> (abs (- newval nowval)) 0.01)))
(snd-display "~A is not ~A (~A)" star-name newval nowval))
- (eval `(set! ,star-name ,initval))
+ ;(eval `(set! ,star-name ,initval))
+ (apply set! star-name initval ())
(if (not (morally-equal? (getfnc) initval))
(snd-display "* ~A is not ~A" name initval))
(eval `(set! ,star-name ,newval))
@@ -18917,11 +18918,11 @@ EDITS: 2
(if (not (equal? (selected-sound) nind)) (snd-display "selected-sound: ~A?" (selected-sound)))
(if (not (= (selected-channel) 0)) (snd-display "selected-channel: ~A?" (selected-channel)))
- (let ((decay-dur 1.0000)
- (low-pass #f)
- (volume 0.1000)
- (amp-env #f))
- (let ((allpass1 (make-all-pass -0.700 0.700 1051))
+ (let ((decay-dur 1.0000))
+ (let ((amp-env #f)
+ (low-pass #f)
+ (volume 0.1000)
+ (allpass1 (make-all-pass -0.700 0.700 1051))
(allpass2 (make-all-pass -0.700 0.700 337))
(allpass3 (make-all-pass -0.700 0.700 113))
(comb1 (make-comb 0.742 4799))
@@ -19962,23 +19963,23 @@ EDITS: 2
(lambda (args)
(for-each
(lambda (n)
- (let ((gen (catch #t
- (lambda () (apply n args))
- (lambda args (car args)))))
- (if (mus-generator? gen)
+ (catch #t
+ (lambda ()
+ (let ((gen (apply n args)))
(for-each
(lambda (arg)
(catch #t
(lambda () (gen arg))
(lambda args (car args))))
- random-args))))
+ random-args)))
+ (lambda args (car args))))
gen-make-procs))))
(random-gen ())
- (let ((a1 (list #f))
- (a2 (list #f #f))
- (a3 (list #f #f #f))
- (a4 (list #f #f #f #f)))
+ (let ((a1 (make-list 1 #f))
+ (a2 (make-list 2 #f))
+ (a3 (make-list 3 #f))
+ (a4 (make-list 4 #f)))
(let ((a22 (cdr a2))
(a32 (cdr a3))
(a42 (cdr a4))
@@ -36818,27 +36819,26 @@ EDITS: 1
(float-vector-set! fv i (- i))))
(test (fv43) #r(0 -1 -2 -3))
- (define (permute op . args)
- (let ((form `(let ()
- (define (t1)
- (let ((x 1.5) (y 3.5) (g0 (make-oscil 1000)) (g1 (make-oscil 2000)) (fv (make-float-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) fv)
- (float-vector-set! fv i (,op ,@args)))))
- (define (t2)
- (let ((x 1.5) (y 3.5) (g0 (make-oscil 1000)) (g1 (make-oscil 2000)) (v (make-vector 4)))
- (do ((i 0 (+ i 1)))
- ((= i 4) v)
- (vector-set! v i (,op ,@args)))))
- (let ((v1 (t1))
- (v2 (copy (t2) (make-float-vector 4))))
- (if (not (morally-equal? v1 v2))
- (do ((max-diff 0.0)
- (i 0 (+ i 1)))
- ((= i 4)
- (format *stderr* "~A: ~A -> ~A ~A: ~A~%" op args v1 v2 max-diff))
- (set! max-diff (max max-diff (abs (- (v1 i) (v2 i)))))))))))
- (eval (copy form :readable))))
+ (define (permute op args)
+ (let ()
+ (define (t1)
+ (let ((x 1.5) (y 3.5) (g0 (make-oscil 1000)) (g1 (make-oscil 2000)) (fv (make-float-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) fv)
+ (float-vector-set! fv i (eval `(,op ,@args))))))
+ (define (t2)
+ (let ((x 1.5) (y 3.5) (g0 (make-oscil 1000)) (g1 (make-oscil 2000)) (v (make-vector 4)))
+ (do ((i 0 (+ i 1)))
+ ((= i 4) v)
+ (vector-set! v i (eval `(,op ,@args))))))
+ (let ((v1 (t1))
+ (v2 (copy (t2) (make-float-vector 4))))
+ (if (not (morally-equal? v1 v2))
+ (do ((max-diff 0.0)
+ (i 0 (+ i 1)))
+ ((= i 4)
+ (format *stderr* "~A: ~A -> ~A ~A: ~A~%" op args v1 v2 max-diff))
+ (set! max-diff (max max-diff (abs (- (v1 i) (v2 i))))))))))
(set! (*s7* 'morally-equal-float-epsilon) 1e-12)
(for-each
@@ -36846,7 +36846,7 @@ EDITS: 1
(for-each-subset
(lambda s-args
(if (pair? s-args)
- (for-each-permutation (lambda args (apply permute op args)) s-args)))
+ (for-each-permutation (lambda args (permute op args)) s-args)))
(list 'x '(oscil g0) 2.0 '(oscil g1) 'y)))
'(+ * -))
@@ -36854,7 +36854,7 @@ EDITS: 1
(for-each-subset
(lambda s-args
(if (pair? s-args)
- (for-each-permutation (lambda args (apply permute '/ args)) s-args)))
+ (for-each-permutation (lambda args (permute '/ args)) s-args)))
(list 'x '(+ .01 (oscil g0)) 2.0 '(+ .01 (oscil g1)) 'y))
(define (fv44)
@@ -38303,7 +38303,7 @@ EDITS: 1
(define (Q) (mus-copy G))
(define (try1 form gen)
- (let ((make-gen (string->symbol (string-append "make-" (symbol->string gen)))))
+ (let ((make-gen (symbol "make-" (symbol->string gen))))
(let ((body
`(let ()
(define (tester-1)
@@ -38367,7 +38367,7 @@ EDITS: 1
(the-body))))
(define (try2 form gen)
- (let ((make-gen (string->symbol (string-append "make-" (symbol->string gen)))))
+ (let ((make-gen (symbol "make-" (symbol->string gen))))
(let ((body
`(let ()
(define (tester-1)
@@ -38459,7 +38459,7 @@ EDITS: 1
(the-body))))
(define (try34 form gen)
- (let ((make-gen (string->symbol (string-append "make-" (symbol->string gen)))))
+ (let ((make-gen (symbol "make-" (symbol->string gen))))
(let ((body
`(let ()
(define (tester-1)
diff --git a/snd-trans.c b/snd-trans.c
index 30bb473..e75a517 100644
--- a/snd-trans.c
+++ b/snd-trans.c
@@ -41,7 +41,7 @@ static int64_t snd_checked_write(int fd, unsigned char *buf, int64_t bytes, cons
if (kfree < (bytes >> 10))
{
snprintf(write_error_buffer, PRINT_BUFFER_SIZE,
- "only %lld bytes left on device (we need %" PRId64 " bytes)",
+ "only %" PRId64 " bytes left on device (we need %" PRId64 " bytes)",
kfree << 10, bytes);
return(MUS_ERROR);
}
diff --git a/snd-utils.c b/snd-utils.c
index cef989a..3e10ec0 100644
--- a/snd-utils.c
+++ b/snd-utils.c
@@ -243,7 +243,7 @@ disk_space_t disk_has_space(mus_long_t bytes, const char *filename)
kneeded = bytes >> 10;
if (kfree < kneeded)
{
- snd_error("not enough space left on disk: only %lld kbytes available", kfree);
+ snd_error("not enough space left on disk: only %" PRId64 " kbytes available", kfree);
return(NOT_ENOUGH_DISK_SPACE);
}
return(DISK_SPACE_OK);
diff --git a/snd-xen.c b/snd-xen.c
index c0d12be..014fcba 100644
--- a/snd-xen.c
+++ b/snd-xen.c
@@ -767,11 +767,10 @@ Xen eval_str_wrapper(void *data)
static Xen eval_file_wrapper(void *data)
{
- Xen error;
last_file_loaded = (char *)data;
- error = Xen_load((char *)data); /* error only meaningful in Ruby */
+ Xen_load((char *)data);
last_file_loaded = NULL;
- return(error);
+ return(Xen_true);
}
@@ -1486,7 +1485,7 @@ mus_long_t string_to_mus_long_t(const char *str, mus_long_t lo, const char *fiel
mus_long_t val;
val = Xen_llong_to_C_llong(res);
if (val < lo)
- snd_error("%s: %lld is invalid", field_name, val);
+ snd_error("%s: %" PRId64 " is invalid", field_name, val);
else return(val);
}
else snd_error("%s: %s is not a number", field_name, str);
@@ -1495,12 +1494,12 @@ mus_long_t string_to_mus_long_t(const char *str, mus_long_t lo, const char *fiel
mus_long_t res = 0;
if (str)
{
- if (!(sscanf(str, "%lld" , &res)))
+ if (!(sscanf(str, "%" PRId64, &res)))
snd_error("%s: %s is not a number", field_name, str);
else
{
if (res < lo)
- snd_error("%s: %lld is invalid", field_name, res);
+ snd_error("%s: %" PRId64 " is invalid", field_name, res);
}
}
return(res);
diff --git a/snd-xref.c b/snd-xref.c
index 8e54b73..742d01f 100644
--- a/snd-xref.c
+++ b/snd-xref.c
@@ -1744,7 +1744,7 @@ static const char *Reverb_urls[] = {
#if HAVE_SCHEME
-static const char *snd_names[11596] = {
+static const char *snd_names[11598] = {
"*clm-array-print-length*", "ws.scm",
"*clm-channels*", "ws.scm",
"*clm-clipped*", "ws.scm",
@@ -4103,6 +4103,7 @@ static const char *snd_names[11596] = {
"fegetexceptflag", "libc.scm",
"fegetround", "libc.scm",
"feholdexcept", "libc.scm",
+ "fenv_t.make", "libc.scm",
"feof", "libc.scm",
"feraiseexcept", "libc.scm",
"ferror", "libc.scm",
@@ -7547,7 +7548,7 @@ static const char *snd_names[11596] = {
static void autoload_info(s7_scheme *sc)
{
- s7_autoload_set_names(sc, snd_names, 5798);
+ s7_autoload_set_names(sc, snd_names, 5799);
}
#endif
diff --git a/snd.h b/snd.h
index 322d312..39a128d 100644
--- a/snd.h
+++ b/snd.h
@@ -55,11 +55,11 @@
#include "snd-strings.h"
-#define SND_DATE "3-Aug-17"
+#define SND_DATE "11-Sep-17"
#ifndef SND_VERSION
-#define SND_VERSION "17.6"
+#define SND_VERSION "17.7"
#endif
#define SND_MAJOR_VERSION "17"
-#define SND_MINOR_VERSION "6"
+#define SND_MINOR_VERSION "7"
#endif
diff --git a/sndlib.h b/sndlib.h
index 08d4a4f..3944c62 100644
--- a/sndlib.h
+++ b/sndlib.h
@@ -2,12 +2,14 @@
#define SNDLIB_H
#define SNDLIB_VERSION 24
-#define SNDLIB_REVISION 5
-#define SNDLIB_DATE "27-Jun-17"
+#define SNDLIB_REVISION 6
+#define SNDLIB_DATE "3-Aug-17"
#include <stdio.h>
#include <time.h>
#include <sys/types.h>
+#include <stdint.h>
+#include <inttypes.h>
/* not sure how to handle this one cleanly: */
#ifndef __cplusplus
@@ -23,7 +25,7 @@
#endif
typedef double mus_float_t;
-typedef long long int mus_long_t;
+typedef int64_t mus_long_t;
#if defined(__sun) && defined(__SVR4)
#define HAVE_SUN 1
diff --git a/sndscm.html b/sndscm.html
index 3591593..c1b6e92 100644
--- a/sndscm.html
+++ b/sndscm.html
@@ -8806,11 +8806,11 @@ of harmonics, then the minimum peak amplitude, then (log peak n).
123 11.016 0.4986 | 123 11.088 0.4999 | 12 3.787 0.5359 | 10 3.602 0.5565
125 11.105 0.4986 | 127 11.268 0.5000 | 13 3.973 0.5378 | 5 2.477 0.5635
7 2.639 0.4988 | 112 10.582 0.5000 | 11 3.656 0.5406 | 4 2.192 0.5662
-256 16.004 0.5000 | 3 1.739 0.5035 | 10 3.559 0.5513 | 8 3.263 0.5687
-512 23.415 0.5055 | 512 23.717 0.5075 | 8 3.198 0.5590 | 256 23.955 0.5728
-1024 33.340 0.5059 | 256 16.933 0.5102 | 9 3.454 0.5641 | 7 3.062 0.5750
-2048 49.598 0.5120 | 1024 34.393 0.5104 | 7 3.047 0.5726 | 6 2.805 0.5757
-4 2.039 0.5139 | 2048 49.287 0.5112 | 6 2.837 0.5820 | 512 38.603 0.5856
+256 15.997 0.5000 | 3 1.739 0.5035 | 10 3.559 0.5513 | 8 3.263 0.5687
+512 23.405 0.5054 | 512 23.688 0.5073 | 8 3.198 0.5590 | 256 23.955 0.5728
+1024 33.328 0.5059 | 256 16.836 0.5092 | 9 3.454 0.5641 | 7 3.062 0.5750
+2048 49.568 0.5119 | 1024 34.273 0.5099 | 7 3.047 0.5726 | 6 2.805 0.5757
+4 2.039 0.5139 | 2048 49.045 0.5105 | 6 2.837 0.5820 | 512 38.603 0.5856
6 2.549 0.5223 | 4 2.045 0.5161 | 5 2.605 0.5948 | 2048 95.904 0.5985
5 2.343 0.5292 | 6 2.523 0.5164 | 3 2.021 0.6406 | 1024 65.349 0.6030
3 1.980 0.6217 | 5 2.307 0.5195 | 4 2.431 0.6406 | 3 1.980 0.6217
diff --git a/sound.c b/sound.c
index ada0b85..fb85166 100644
--- a/sound.c
+++ b/sound.c
@@ -491,7 +491,7 @@ static void display_sound_file_entry(FILE *fp, const char *name, sound_file *sf)
strftime(timestr, TIME_BUFFER_SIZE, "%a %d-%b-%Y %H:%M:%S", localtime(&date));
else snprintf(timestr, TIME_BUFFER_SIZE, "(date cleared)");
- fprintf(fp, " %s: %s, chans: %d, srate: %d, header: %s, data: %s, samps: %lld",
+ fprintf(fp, " %s: %s, chans: %d, srate: %d, header: %s, data: %s, samps: %" PRId64,
name,
timestr,
sf->chans,
@@ -1305,7 +1305,7 @@ int mus_sound_set_maxamps(const char *ifile, int chans, mus_float_t *vals, mus_l
sound_file *sf;
int result = MUS_NO_ERROR;
- /* fprintf(stderr, "set %s maxamps: %d %.3f %lld\n", ifile, chans, vals[0], times[0]); */
+ /* fprintf(stderr, "set %s maxamps: %d %.3f %" PRId64 "\n", ifile, chans, vals[0], times[0]); */
sf = get_sf(ifile);
if (sf)
{
@@ -1382,7 +1382,7 @@ mus_float_t mus_sound_channel_maxamp(const char *file, int chan, mus_long_t *pos
void mus_sound_channel_set_maxamp(const char *file, int chan, mus_float_t mx, mus_long_t pos)
{
sound_file *sf;
- /* fprintf(stderr, "set %s maxamp: %.3f %lld\n", file, mx, pos); */
+ /* fprintf(stderr, "set %s maxamp: %.3f %" PRId64 "\n", file, mx, pos); */
sf = get_sf(file);
if ((sf) &&
(sf->chans > chan))
diff --git a/stuff.scm b/stuff.scm
index 197a61e..2d5680b 100644
--- a/stuff.scm
+++ b/stuff.scm
@@ -263,6 +263,15 @@
(cdr places))
(set! ,last ,tmp))))
+#|
+(define (rotate! lst)
+ (if (and (pair? lst)
+ (pair? (cdr lst)))
+ (let ((lr (reverse! lst)))
+ (cons (car lr) (reverse! (cdr lr))))
+ lst))
+|#
+
(define-macro (progv vars vals . body)
`(apply (apply lambda ,vars ',body) ,vals))
diff --git a/tools/compare-calls.scm b/tools/compare-calls.scm
index 4addb77..76296c5 100644
--- a/tools/compare-calls.scm
+++ b/tools/compare-calls.scm
@@ -122,7 +122,7 @@
(get-overheads-1 file line))
(set! overheads (sort! overheads (lambda (a b) (< (car a) (car b)))))
- (format *stderr* "~{~^~A~%~}" (list-tail overheads (max 10 (- (length overheads) 40))))
+ (format *stderr* "~{~^~A~%~}" (list-tail overheads (max 10 (- (length overheads) 60))))
(format *stderr* "total: ~A~%" total)))))
diff --git a/tools/ffitest.c b/tools/ffitest.c
index f95b46d..94370c1 100644
--- a/tools/ffitest.c
+++ b/tools/ffitest.c
@@ -98,7 +98,7 @@ static bool equal_dax(void *val1, void *val2)
static void mark_dax(void *val)
{
dax *o = (dax *)val;
- if (o) s7_mark_object(o->data);
+ if (o) s7_mark_c_object(o->data);
}
static int dax_type_tag = 0;
@@ -111,27 +111,27 @@ static s7_pointer make_dax(s7_scheme *sc, s7_pointer args)
if (s7_cdr(args) != s7_nil(sc))
o->data = s7_car(s7_cdr(args));
else o->data = s7_nil(sc);
- return(s7_make_object(sc, dax_type_tag, (void *)o));
+ return(s7_make_c_object(sc, dax_type_tag, (void *)o));
}
static s7_pointer is_dax(s7_scheme *sc, s7_pointer args)
{
return(s7_make_boolean(sc,
- s7_is_object(s7_car(args)) &&
- s7_object_type(s7_car(args)) == dax_type_tag));
+ s7_is_c_object(s7_car(args)) &&
+ s7_c_object_type(s7_car(args)) == dax_type_tag));
}
static s7_pointer dax_x(s7_scheme *sc, s7_pointer args)
{
dax *o;
- o = (dax *)s7_object_value(s7_car(args));
+ o = (dax *)s7_c_object_value(s7_car(args));
return(s7_make_real(sc, o->x));
}
static s7_pointer set_dax_x(s7_scheme *sc, s7_pointer args)
{
dax *o;
- o = (dax *)s7_object_value(s7_car(args));
+ o = (dax *)s7_c_object_value(s7_car(args));
o->x = s7_real(s7_car(s7_cdr(args)));
return(s7_car(s7_cdr(args)));
}
@@ -139,14 +139,14 @@ static s7_pointer set_dax_x(s7_scheme *sc, s7_pointer args)
static s7_pointer dax_data(s7_scheme *sc, s7_pointer args)
{
dax *o;
- o = (dax *)s7_object_value(s7_car(args));
+ o = (dax *)s7_c_object_value(s7_car(args));
return(o->data);
}
static s7_pointer set_dax_data(s7_scheme *sc, s7_pointer args)
{
dax *o;
- o = (dax *)s7_object_value(s7_car(args));
+ o = (dax *)s7_c_object_value(s7_car(args));
o->data = s7_car(s7_cdr(args));
return(o->data);
}
@@ -271,21 +271,21 @@ static s7_pointer g_make_block(s7_scheme *sc, s7_pointer args)
g = (g_block *)calloc(1, sizeof(g_block));
g->size = (size_t)s7_integer(s7_car(args));
g->data = (double *)calloc(g->size, sizeof(double));
- new_g = s7_make_object(sc, g_block_type, (void *)g);
- s7_object_set_let(new_g, g_block_methods);
+ new_g = s7_make_c_object(sc, g_block_type, (void *)g);
+ s7_c_object_set_let(new_g, g_block_methods);
s7_openlet(sc, new_g);
return(new_g);
}
static s7_pointer g_to_block(s7_scheme *sc, s7_pointer args)
{
- #define g_block_help "(block ...) returns a block object with the arguments as its contents."
+#define g_block_help "(block ...) returns a block c_object with the arguments as its contents."
s7_pointer p, b;
size_t i, len;
g_block *gb;
len = s7_list_length(sc, args);
b = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, len), s7_nil(sc)));
- gb = (g_block *)s7_object_value(b);
+ gb = (g_block *)s7_c_object_value(b);
for (i = 0, p = args; i < len; i++, p = s7_cdr(p))
gb->data[i] = s7_number_to_real(sc, s7_car(p));
return(b);
@@ -315,7 +315,7 @@ static void g_block_mark(void *val)
static s7_pointer g_block_ref(s7_scheme *sc, s7_pointer obj, s7_pointer args)
{
- g_block *g = (g_block *)s7_object_value(obj);
+ g_block *g = (g_block *)s7_c_object_value(obj);
size_t index;
index = (size_t)s7_integer(s7_car(args));
if (index < g->size)
@@ -325,7 +325,7 @@ static s7_pointer g_block_ref(s7_scheme *sc, s7_pointer obj, s7_pointer args)
static s7_pointer g_block_set(s7_scheme *sc, s7_pointer obj, s7_pointer args)
{
- g_block *g = (g_block *)s7_object_value(obj);
+ g_block *g = (g_block *)s7_c_object_value(obj);
s7_int index;
index = s7_integer(s7_car(args));
if ((index >= 0) && (index < g->size))
@@ -338,7 +338,7 @@ static s7_pointer g_block_set(s7_scheme *sc, s7_pointer obj, s7_pointer args)
static s7_pointer g_block_length(s7_scheme *sc, s7_pointer obj)
{
- g_block *g = (g_block *)s7_object_value(obj);
+ g_block *g = (g_block *)s7_c_object_value(obj);
return(s7_make_integer(sc, g->size));
}
@@ -347,9 +347,9 @@ static s7_pointer g_block_copy(s7_scheme *sc, s7_pointer args)
s7_pointer obj, new_g;
g_block *g, *g1;
obj = s7_car(args);
- g = (g_block *)s7_object_value(obj);
+ g = (g_block *)s7_c_object_value(obj);
new_g = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, g->size), s7_nil(sc)));
- g1 = (g_block *)s7_object_value(new_g);
+ g1 = (g_block *)s7_c_object_value(new_g);
memcpy((void *)(g1->data), (void *)(g->data), g->size * sizeof(double));
return(new_g);
}
@@ -357,11 +357,11 @@ static s7_pointer g_block_copy(s7_scheme *sc, s7_pointer args)
static s7_pointer g_block_reverse(s7_scheme *sc, s7_pointer obj)
{
size_t i, j;
- g_block *g = (g_block *)s7_object_value(obj);
+ g_block *g = (g_block *)s7_c_object_value(obj);
g_block *g1;
s7_pointer new_g;
new_g = g_make_block(sc, s7_cons(sc, s7_make_integer(sc, g->size), s7_nil(sc)));
- g1 = (g_block *)s7_object_value(new_g);
+ g1 = (g_block *)s7_c_object_value(new_g);
for (i = 0, j = g->size - 1; i < g->size; i++, j--)
g1->data[i] = g->data[j];
return(new_g);
@@ -374,7 +374,7 @@ static s7_pointer g_block_fill(s7_scheme *sc, s7_pointer args)
double fill_val;
g_block *g;
obj = s7_car(args);
- g = (g_block *)s7_object_value(obj);
+ g = (g_block *)s7_c_object_value(obj);
fill_val = s7_number_to_real(sc, s7_cadr(args));
for (i = 0; i < g->size; i++)
g->data[i] = fill_val;
@@ -962,7 +962,12 @@ int main(int argc, char **argv)
{fprintf(stderr, "%d: %s is not 32?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
- dax_type_tag = s7_new_type("dax", print_dax, free_dax, equal_dax, mark_dax, NULL, NULL);
+ dax_type_tag = s7_make_c_type(sc, "dax");
+ s7_c_type_set_print(sc, dax_type_tag, print_dax);
+ s7_c_type_set_free(sc, dax_type_tag, free_dax);
+ s7_c_type_set_equal(sc, dax_type_tag, equal_dax);
+ s7_c_type_set_mark(sc, dax_type_tag, mark_dax);
+
s7_define_function(sc, "make-dax", make_dax, 2, 0, false, "(make-dax x data) makes a new dax");
s7_define_function(sc, "dax?", is_dax, 1, 0, false, "(dax? anything) returns #t if its argument is a dax object");
@@ -978,12 +983,12 @@ int main(int argc, char **argv)
p = make_dax(sc, s7_cons(sc, s7_make_real(sc, 1.0), s7_cons(sc, TO_S7_INT(2), s7_nil(sc))));
gc_loc = s7_gc_protect(sc, p);
- if (!s7_is_object(p))
- {fprintf(stderr, "%d: %s is not an object?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+ if (!s7_is_c_object(p))
+ {fprintf(stderr, "%d: %s is not a c_object?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
p1 = s7_apply_function(sc, s7_name_to_value(sc, "dax?"), s7_cons(sc, p, s7_nil(sc)));
if (p1 != s7_t(sc))
- {fprintf(stderr, "%d: %s is not a dax object?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
+ {fprintf(stderr, "%d: %s is not a dax c_object?\n", __LINE__, s1 = TO_STR(p)); free(s1);}
s1 = TO_STR(p);
if (strcmp(s1, "#<dax 1.000 2>") != 0)
@@ -1402,7 +1407,7 @@ int main(int argc, char **argv)
{fprintf(stderr, "%d: begin_hook is not null?\n", __LINE__);}
tested_begin_hook = false;
s7_set_begin_hook(sc, test_begin_hook);
- s7_eval_c_string(sc, "(begin (+ 1 2))");
+ s7_eval_c_string(sc, "(begin #f (+ 1 2))");
if (!tested_begin_hook)
{fprintf(stderr, "%d: begin_hook not called?\n", __LINE__);}
if (s7_begin_hook(sc) != test_begin_hook)
@@ -1486,11 +1491,17 @@ int main(int argc, char **argv)
fprintf(stderr, "%d: %s should be #<eof> and iter should be done\n", __LINE__, TO_STR(x));
}
- g_block_type = s7_new_type_x(sc, "#<block>",
- g_block_display, g_block_free,
- g_block_is_equal, g_block_mark,
- g_block_ref, g_block_set, g_block_length,
- g_block_copy, g_block_reverse, g_block_fill);
+ g_block_type = s7_make_c_type(sc, "#<block>");
+ s7_c_type_set_print(sc, g_block_type, g_block_display);
+ s7_c_type_set_free(sc, g_block_type, g_block_free);
+ s7_c_type_set_equal(sc, g_block_type, g_block_is_equal);
+ s7_c_type_set_mark(sc, g_block_type, g_block_mark);
+ s7_c_type_set_apply(sc, g_block_type, g_block_ref);
+ s7_c_type_set_set(sc, g_block_type, g_block_set);
+ s7_c_type_set_length(sc, g_block_type, g_block_length);
+ s7_c_type_set_copy(sc, g_block_type, g_block_copy);
+ s7_c_type_set_reverse(sc, g_block_type, g_block_reverse);
+ s7_c_type_set_fill(sc, g_block_type, g_block_fill);
s7_define_function(sc, "make-block", g_make_block, 1, 0, false, g_make_block_help);
s7_define_function(sc, "block", g_to_block, 0, 0, true, g_block_help);
@@ -1504,13 +1515,13 @@ int main(int argc, char **argv)
gp = g_make_block(sc, s7_list(sc, 1, TO_S7_INT(32)));
gc_loc = s7_gc_protect(sc, gp);
- if (!s7_is_object(gp))
- {fprintf(stderr, "%d: g_block %s is not an object?\n", __LINE__, s1 = TO_STR(gp)); free(s1);}
- g = (g_block *)s7_object_value(gp);
- if (s7_object_type(gp) != g_block_type)
- {fprintf(stderr, "%d: g_block types: %d %d\n", __LINE__, g_block_type, s7_object_type(gp));}
- if (s7_object_value_checked(gp, g_block_type) != g)
- {fprintf(stderr, "%d: checked g_block types: %d %d\n", __LINE__, g_block_type, s7_object_type(gp));}
+ if (!s7_is_c_object(gp))
+ {fprintf(stderr, "%d: g_block %s is not a c_object?\n", __LINE__, s1 = TO_STR(gp)); free(s1);}
+ g = (g_block *)s7_c_object_value(gp);
+ if (s7_c_object_type(gp) != g_block_type)
+ {fprintf(stderr, "%d: g_block types: %d %d\n", __LINE__, g_block_type, s7_c_object_type(gp));}
+ if (s7_c_object_value_checked(gp, g_block_type) != g)
+ {fprintf(stderr, "%d: checked g_block types: %d %d\n", __LINE__, g_block_type, s7_c_object_type(gp));}
s7_gc_unprotect_at(sc, gc_loc);
}
diff --git a/tools/gdbinit b/tools/gdbinit
index 658bc89..f49a0df 100644
--- a/tools/gdbinit
+++ b/tools/gdbinit
@@ -167,7 +167,7 @@ define s7cell
end
if (($type == T_CHARACTER) || ($is_bad_type))
- printf "chr: c: %c, up_c: %c, alpha_c: %d, digit_c: %d, space_c: %d, upper_c: %d, lower_c: %d", \
+ printf "chr: c: %c, up_c: %c, alpha_c: %d, digit_c: %d, space_c: %d, upper_c: %d, lower_c: %d\n", \
$cell.object.chr.c, $cell.object.chr.up_c, \
$cell.object.chr.alpha_c, $cell.object.chr.digit_c, $cell.object.chr.space_c, $cell.object.chr.upper_c, $cell.object.chr.lower_c
if ($type == T_CHARACTER)
@@ -225,7 +225,7 @@ define s7cell
end
if (($type == T_CONTINUATION) || ($is_bad_type))
- printf "continuation: continuation: %p, stack: %p, start_start: %p, stack_end: %p, op_stack: %p, key: %d\n", \
+ printf "continuation: continuation: %p, stack: %p,\n start_start: %p, stack_end: %p, op_stack: %p, key: %d\n", \
$cell.object.cwcc.continuation, $cell.object.cwcc.stack, $cell.object.cwcc.stack_start, $cell.object.cwcc.stack_end, $cell.object.cwcc.op_stack, \
$cell.object.cwcc.continuation->local_key
end
@@ -261,9 +261,9 @@ define s7cell
end
if (($type == T_OPTLIST) || ($is_bad_type))
- printf("optlist: opts: %p, num_exprs: %d, num_args: %d, len: %d, addr: %d, pc: %d, tag: %d\n", \
+ printf "optlist: opts: %p, num_exprs: %d, num_args: %d, len: %d, addr: %d, pc: %d\n", \
$cell.object.opt.opts, $cell.object.opt.num_exprs, $cell.object.opt.num_args, \
- $cell.object.opt.len, $cell.object.opt.addr, $cell.object.opt.pc, $cell.object.opt.tag
+ $cell.object.opt.len, $cell.object.opt.addr, $cell.object.opt.pc
end
if (($type == T_CLOSURE) || ($type == T_CLOSURE_STAR) || ($type == T_MACRO) || ($type == T_BACRO) || ($is_bad_type))
diff --git a/tools/gtk-header-diffs b/tools/gtk-header-diffs
index 3536520..dbadedf 100755
--- a/tools/gtk-header-diffs
+++ b/tools/gtk-header-diffs
@@ -1,7 +1,7 @@
#!/bin/csh -f
-set gtkolddir = /home/bil/test/gtk+-3.91.0
-set gtknewdir = /home/bil/test/gtk+-3.91.1
+set gtkolddir = /home/bil/test/gtk+-3.91.1
+set gtknewdir = /home/bil/test/gtk+-3.91.2
# set pangoolddir = /home/bil/test/pango-1.36.8
# set pangonewdir = /home/bil/test/pango-1.40.2
# set glibolddir = /home/bil/test/glib-2.39.3
diff --git a/tools/makexg.scm b/tools/makexg.scm
index f18387e..99d719e 100755
--- a/tools/makexg.scm
+++ b/tools/makexg.scm
@@ -1604,15 +1604,19 @@
(hay "static s7_pointer make_xm_obj(s7_scheme *sc, void *ptr)~%")
(hay "{~%")
-(hay " return(s7_make_object(sc, xm_obj_tag, ptr));~%")
+(hay " return(s7_make_c_object(sc, xm_obj_tag, ptr));~%")
(hay "}~%")
(hey "static void define_xm_obj(void)~%")
(hay "static void define_xm_obj(s7_scheme *sc)~%")
(hoy "{~%")
(hey "#if HAVE_SCHEME~%")
-(hey " xm_obj_tag = s7_new_type_x(s7, \"<XmObj>\", NULL, xm_obj_free, s7_equalp_xm, NULL, NULL, NULL, NULL, NULL, NULL, NULL);~%")
-(hay " xm_obj_tag = s7_new_type_x(sc, \"<XmObj>\", NULL, xm_obj_free, s7_equalp_xm, NULL, NULL, NULL, NULL, NULL, NULL, NULL);~%")
+(hey " xm_obj_tag = s7_make_c_type(s7, \"<XmObj>\");~%")
+(hay " xm_obj_tag = s7_make_c_type(sc, \"XgObj\");~%")
+(hey " s7_c_type_set_free(s7, xm_obj_tag, xm_obj_free);~%")
+(hay " s7_c_type_set_free(sc, xm_obj_tag, xm_obj_free);~%")
+(hey " s7_c_type_set_equal(s7, xm_obj_tag, s7_equalp_xm);~%")
+(hay " s7_c_type_set_equal(sc, xm_obj_tag, s7_equalp_xm);~%")
(hey "#else~%")
(hey " xm_obj_tag = Xen_make_object_type(\"XmObj\", sizeof(void *));~%")
(hey "#endif~%")
@@ -1649,8 +1653,10 @@
(cdr all-types))
(define other-types
- (list 'idler 'GtkCellRendererPixbuf_ 'GtkScrollbar_ 'GtkSeparator_ 'GtkSeparatorMenuItem_
- 'GdkEventExpose_ 'GdkEventNoExpose_ 'GdkEventVisibility_ 'GdkEventButton_ 'GdkEventScroll_ 'GdkEventCrossing_
+ (list 'idler 'GtkCellRendererPixbuf_ ;'GtkScrollbar_
+ 'GtkSeparator_ 'GtkSeparatorMenuItem_
+ 'GdkEventExpose_ 'GdkEventNoExpose_ 'GdkEventVisibility_ 'GdkEventButton_ ;'GdkEventScroll_
+ 'GdkEventCrossing_
'GdkEventFocus_ 'GdkEventConfigure_ 'GdkEventProperty_ 'GdkEventSelection_ 'GdkEventProximity_ 'GdkEventSetting_
'GdkEventWindowState_ 'GdkEventDND_ 'GtkFileChooserDialog_ 'GtkFileChooserWidget_ 'GtkColorButton_ 'GtkAccelMap
'GtkCellRendererCombo_ 'GtkCellRendererProgress_ 'GtkCellRendererAccel_ 'GtkCellRendererSpin_ 'GtkRecentChooserDialog_
@@ -2045,6 +2051,24 @@
(hay " s7_cadr((s7_pointer)data))) != lg_false);~%")
(hay "}~%~%")
+(hoy "#if (!GTK_CHECK_VERSION(3, 90, 0))~%")
+(hey "static Xen gxg_gtk_widget_set_events(Xen widget, Xen events)~%")
+(hay "static s7_pointer lg_gtk_widget_set_events(s7_scheme *sc, s7_pointer args)~%")
+(hoy "{~%")
+(hoy " #define H_gtk_widget_set_events \"void gtk_widget_set_events(GtkWidget* widget, gint events)\"~%")
+(hay " s7_pointer widget, events;~%")
+(hay " widget = s7_car(args);~%")
+(hay " events = s7_cadr(args);~%")
+(hey " Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, \"gtk_widget_set_events\", \"GtkWidget*\");~%")
+(hey " Xen_check_type(Xen_is_gint(events), events, 2, \"gtk_widget_set_events\", \"gint\");~%")
+(hey " gtk_widget_set_events(Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(events));~%")
+(hay " gtk_widget_set_events((GtkWidget*)s7_c_pointer(widget), (gint)s7_integer(events));~%")
+(hey " return(Xen_false);~%")
+(hay " return(lg_false);~%")
+(hoy "}~%")
+(hoy "#endif~%~%")
+
+
(hey "~%~%/* ---------------------------------------- functions ---------------------------------------- */~%~%")
@@ -3252,6 +3276,7 @@
(hey "#else~%")
(hey "Xen_wrap_2_optional_args(gxg_gtk_init_w, gxg_gtk_init)~%")
(hey "Xen_wrap_2_optional_args(gxg_gtk_init_check_w, gxg_gtk_init_check)~%")
+(hey "Xen_wrap_2_args(gxg_gtk_widget_set_events_w, gxg_gtk_widget_set_events)~%")
(hey "#endif~%")
(define (ruby-cast func) (hey "Xen_wrap_1_arg(gxg_~A_w, gxg_~A)~%" (no-arg (car func)) (no-arg (car func))))
@@ -3518,6 +3543,8 @@
(hey " Xg_define_procedure(gtk_init_check, gxg_gtk_init_check_w, 0, 2, 0, H_gtk_init_check, NULL);~%")
(hay " s7_define_function(sc, \"gtk_init\", lg_gtk_init, 0, 2, 0, NULL);~%")
(hay " s7_define_function(sc, \"gtk_init_check\", lg_gtk_init_check, 0, 2, 0, NULL);~%")
+(hey " Xg_define_procedure(gtk_widget_set_events, gxg_gtk_widget_set_events_w, 2, 0, 0, H_gtk_widget_set_events, pl_tui);~%")
+(hay " s7_define_function(sc, \"gtk_widget_set_events\", lg_gtk_widget_set_events, 2, 0, 0, H_gtk_widget_set_events);~%")
(hoy "#endif~%")
(define (check-out func)
diff --git a/tools/tauto.scm b/tools/tauto.scm
index 8a577e8..8b189a8 100644
--- a/tools/tauto.scm
+++ b/tools/tauto.scm
@@ -41,7 +41,7 @@
'((1 2) (3 4)) '((1 (2)) (((3) 4))) "" (list #i(1) "1") '(1 2 . 3) (list (cons 'a 2) (cons 'b 3))
#i(1 2) (vector 1 '(3)) (let ((x 3)) (lambda (y) (+ x y))) abs 'a 'b one
(lambda args args) (lambda* ((a 3) (b 2)) (+ a b)) (lambda () 3)
- (sublet () 'a 1) (rootlet)
+ (sublet () 'a 1) ;(rootlet)
*load-hook* *error-hook* (random-state 123)
quasiquote macroexpand begin let letrec* if case cond (call-with-exit (lambda (goto) goto))
(with-baffle (call/cc (lambda (cc) cc)))
@@ -83,9 +83,10 @@
(lambda ()
;(format *stderr* "args: ~A~%" args)
(apply func args))
- (lambda any
+ (lambda (type info)
(if (and (positive? args-now)
- (memq (car any) '(wrong-type-arg wrong-number-of-args syntax-error)))
+ (memq type '(wrong-type-arg wrong-number-of-args out-of-range syntax-error io-error
+ division-by-zero format-error missing-method error invalid-escape-function)))
(quit)))))
(let ((c-args (vector-ref auto-arglists args-now)))
@@ -118,12 +119,14 @@
(catch #t
(lambda ()
(apply func c-args))
- (lambda any
- (if (and (memq (car any) '(wrong-type-arg wrong-number-of-args syntax-error))
- (pair? (cdadr any))
- (pair? (cddadr any))
- (integer? (caddr (cadr any))) ; if just 1 arg, arg num can be omitted
- (< (caddr (cadr any)) low))
+ (lambda (type info)
+ (if (or (memq type '(wrong-number-of-args out-of-range syntax-error io-error
+ division-by-zero format-error error missing-method invalid-escape-function))
+ (and (eq? type 'wrong-type-arg)
+ (pair? (cdr info))
+ (pair? (cddr info))
+ (integer? (caddr info)) ; if just 1 arg, arg num can be omitted
+ (< (caddr info) low)))
(quit))))
(if checker ; map-values -> function here
diff --git a/tools/testsnd b/tools/testsnd
index ae68e84..7100a61 100755
--- a/tools/testsnd
+++ b/tools/testsnd
@@ -19,6 +19,7 @@ echo ' '
./snd -noinit s7test.scm
./snd lint.scm -e '(begin (lint "s7test.scm" #f) (exit))'
+./snd -e '(begin (load "snd-lint.scm") (lint "snd-test.scm") (exit))'
valgrind ./snd -noinit -l snd-test
echo ' '
diff --git a/tools/tform.scm b/tools/tform.scm
index 13cab71..c8f6fc7 100644
--- a/tools/tform.scm
+++ b/tools/tform.scm
@@ -23,7 +23,7 @@
;;(openlet (inlet 'i 0 'list-set! (lambda (l . args) (apply #_list-set! l ((car args) 'i) (cdr args))))))
(define-constant constants (vector #f #t () #\a (/ most-positive-fixnum) (/ -1 most-positive-fixnum) 1.5+i
- "hi455" :key hi: 'hi (list 1) (list 1 2) (cons 1 2) (list (list 1 2)) (list (list 1)) (list ()) #()
+ "hi455" "\n \t\x65;" :key hi: 'hi (list 1) (list 1 2) (cons 1 2) (list (list 1 2)) (list (list 1)) (list ()) #()
1/0+i 0+0/0i 0+1/0i 1+0/0i 0/0+0i 0/0+0/0i 1+1/0i 0/0+i cons ''2
1+i 1+1e10i 1e15+1e15i 0+1e18i 1e18 (integer->char 255) (string (integer->char 255)) 1e308
most-positive-fixnum most-negative-fixnum (- most-positive-fixnum 1) (+ most-negative-fixnum 1)
@@ -31,7 +31,7 @@
'((1 2) (3 4)) '((1 (2)) (((3) 4))) "" (list #(1) "1") '(1 2 . 3) (list (cons 'a 2) (cons 'b 3))
#(1 2) (vector 1 '(3)) (let ((x 3)) (lambda (y) (+ x y))) abs 'a 'b one apply
(lambda args args) (lambda* ((a 3) (b 2)) (+ a b)) (lambda () 3)
- (sublet () (cons 'a 1)) (rootlet)
+ (sublet () (cons 'a 1)) ;(rootlet)
*load-hook* *error-hook* (random-state 123)
quasiquote macroexpand cond-expand begin let letrec* if case cond (call-with-exit (lambda (goto) goto))
(with-baffle (call/cc (lambda (cc) cc)))
@@ -77,11 +77,11 @@
(do ((size 2 (+ size 1))
(size1 3 (+ size1 1))
(tries 4000 (+ tries 2000))
- (pos 0 0)
- (ctrl-str ""))
+ (pos 0)
+ (ctrl-str (make-string 16 #\space)))
((= size 15))
(format *stderr* "~D " size)
- (set! ctrl-str (make-string size1))
+ (string-set! ctrl-str size1 #\null)
(string-set! ctrl-str 0 #\~)
(do ((i 0 (+ i 1)))
((= i tries))
diff --git a/tools/xgdata.scm b/tools/xgdata.scm
index 6d42a29..cd23d87 100644
--- a/tools/xgdata.scm
+++ b/tools/xgdata.scm
@@ -2093,10 +2093,10 @@
(CINT "GTK_WRAP_WORD" "GtkWrapMode")
(CINT "GTK_SORT_ASCENDING" "GtkSortType")
(CINT "GTK_SORT_DESCENDING" "GtkSortType")
-(CCAST "GTK_EVENT_BOX(obj)" "GtkEventBox*")
-(CCHK "GTK_IS_EVENT_BOX(obj)" "GtkEventBox*")
+;;; 3.91.2 (CCAST "GTK_EVENT_BOX(obj)" "GtkEventBox*")
+;;; 3.91.2 (CCHK "GTK_IS_EVENT_BOX(obj)" "GtkEventBox*")
;;;;(CFNC "GType gtk_event_box_get_type void")
-(CFNC "GtkWidget* gtk_event_box_new void")
+;;; 3.91.2 (CFNC "GtkWidget* gtk_event_box_new void")
;;; entire thing deprecated 2.11.0
;;; (CCAST "GTK_FILE_SELECTION(obj)" "GtkFileSelection*")
@@ -3786,7 +3786,7 @@
(CFNC "void gtk_widget_queue_draw_area GtkWidget* widget gint x gint y gint width gint height")
(CFNC "void gtk_widget_queue_resize GtkWidget* widget")
;;; (CFNC-gtk2 "void gtk_widget_size_request GtkWidget* widget GtkRequisition* requisition")
-(CFNC "void gtk_widget_size_allocate GtkWidget* widget GtkAllocation* allocation")
+;;; 3.91.2 (CFNC "void gtk_widget_size_allocate GtkWidget* widget GtkAllocation* allocation")
;;; (CFNC-gtk2 "void gtk_widget_get_child_requisition GtkWidget* widget GtkRequisition* requisition")
(CFNC "void gtk_widget_add_accelerator GtkWidget* widget gchar* accel_signal GtkAccelGroup* accel_group guint accel_key GdkModifierType accel_mods GtkAccelFlags accel_flags")
(CFNC "gboolean gtk_widget_remove_accelerator GtkWidget* widget GtkAccelGroup* accel_group guint accel_key GdkModifierType accel_mods")
@@ -4619,10 +4619,10 @@
(CFNC "gboolean gtk_check_menu_item_get_draw_as_radio GtkCheckMenuItem* check_menu_item")
(CFNC "void gtk_entry_set_completion GtkEntry* entry GtkEntryCompletion* completion")
(CFNC "GtkEntryCompletion* gtk_entry_get_completion GtkEntry* entry")
-(CFNC "gboolean gtk_event_box_get_visible_window GtkEventBox* event_box")
-(CFNC "void gtk_event_box_set_visible_window GtkEventBox* event_box gboolean visible_window")
-(CFNC "gboolean gtk_event_box_get_above_child GtkEventBox* event_box")
-(CFNC "void gtk_event_box_set_above_child GtkEventBox* event_box gboolean above_child")
+;;; 3.91.2 (CFNC "gboolean gtk_event_box_get_visible_window GtkEventBox* event_box")
+;;; 3.91.2 (CFNC "void gtk_event_box_set_visible_window GtkEventBox* event_box gboolean visible_window")
+;;; 3.91.2 (CFNC "gboolean gtk_event_box_get_above_child GtkEventBox* event_box")
+;;; 3.91.2 (CFNC "void gtk_event_box_set_above_child GtkEventBox* event_box gboolean above_child")
;;; (CFNC "void gtk_icon_source_set_icon_name GtkIconSource* source gchar* icon_name")
;;; (CFNC "gchar* gtk_icon_source_get_icon_name GtkIconSource* source") ;const return
(CFNC "void gtk_menu_attach GtkMenu* menu GtkWidget* child guint left_attach guint right_attach guint top_attach guint bottom_attach")
@@ -6826,7 +6826,7 @@
(CFNC "gboolean gtk_tree_view_is_rubber_banding_active GtkTreeView* tree_view")
;;; for 2.11.6
-(CFNC "void gtk_icon_view_convert_widget_to_bin_window_coords GtkIconView* icon_view gint wx gint wy gint* [bx] gint* [by]")
+;;; 3.91.2 (CFNC "void gtk_icon_view_convert_widget_to_bin_window_coords GtkIconView* icon_view gint wx gint wy gint* [bx] gint* [by]")
(CFNC "void gtk_icon_view_set_tooltip_item GtkIconView* icon_view GtkTooltip* tooltip GtkTreePath* path")
(CFNC "void gtk_icon_view_set_tooltip_cell GtkIconView* icon_view GtkTooltip* tooltip GtkTreePath* path GtkCellRenderer* cell")
(CFNC "gboolean gtk_icon_view_get_tooltip_context GtkIconView* icon_view gint* [x] gint* [y] gboolean keyboard_tip GtkTreeModel** [model] GtkTreePath** [path] GtkTreeIter* @iter")
@@ -6931,7 +6931,7 @@
;;; 3.1.12 (CFNC-2.14 "GtkWidget* gtk_font_selection_dialog_get_cancel_button GtkFontSelectionDialog* fsd")
;;; 3.3.2 (CFNC-2.14 "gboolean gtk_handle_box_get_child_detached GtkHandleBox* handle_box")
-(CFNC-2.14 "GdkWindow* gtk_layout_get_bin_window GtkLayout* layout")
+;;; 3.91.2 (CFNC-2.14 "GdkWindow* gtk_layout_get_bin_window GtkLayout* layout")
(CFNC-2.14 "gchar* gtk_menu_get_accel_path GtkMenu* menu" 'const)
(CFNC-2.14 "gint gtk_menu_get_monitor GtkMenu* menu")
(CFNC-2.14 "gchar* gtk_menu_item_get_accel_path GtkMenuItem* menu_item" 'const)
@@ -7199,7 +7199,7 @@
;;; (CINT-2.18 "GTK_FILE_CHOOSER_PROP_CREATE_FOLDERS" "GtkFileChooserProp")
;;; 2.17.8
-;(CFNC-2.18 "void gtk_widget_set_allocation GtkWidget* widget GtkAllocation* allocation")
+;;; 3.91.2 ;(CFNC-2.18 "void gtk_widget_set_allocation GtkWidget* widget GtkAllocation* allocation")
;;; 2.17.10
@@ -7312,7 +7312,7 @@
;;; 2.91.6 (CFNC-2.20 "gboolean gtk_widget_has_rc_style GtkWidget* widget")
;;; 2.19.5
-(CFNC-2.20 "GdkWindow* gtk_paned_get_handle_window GtkPaned* paned")
+;;; 3.91.2 (CFNC-2.20 "GdkWindow* gtk_paned_get_handle_window GtkPaned* paned")
;;; 2.99.1 (CFNC-2.20 "void gtk_widget_style_attach GtkWidget* style")
(CFNC-2.20 "void gtk_widget_set_realized GtkWidget* widget gboolean realized")
(CFNC-2.20 "gboolean gtk_widget_get_realized GtkWidget* widget")
@@ -8535,7 +8535,7 @@
(CFNC-3.10 "GtkBaselinePosition gtk_grid_get_row_baseline_position GtkGrid* grid gint row")
(CFNC-3.10 "void gtk_grid_set_baseline_row GtkGrid* grid gint row")
(CFNC-3.10 "gint gtk_grid_get_baseline_row GtkGrid* grid")
-(CFNC-3.10 "void gtk_widget_size_allocate_with_baseline GtkWidget* widget GtkAllocation* allocation gint baseline")
+;;; 3.91.2 (CFNC-3.10 "void gtk_widget_size_allocate_with_baseline GtkWidget* widget GtkAllocation* allocation gint baseline")
;;; 3.89.2 (CFNC-3.10 "void gtk_widget_get_preferred_height_and_baseline_for_width GtkWidget* widget gint width gint* [minimum_height] gint* [natural_height] gint* [minimum_baseline] gint* [natural_baseline]")
;;; (CFNC-3.10 "void gtk_widget_get_preferred_size_and_baseline GtkWidget* widget GtkRequisition* minimum_size GtkRequisition* natural_size gint* [minimum_baseline] gint* [natural_baseline]")
(CFNC-3.10 "int gtk_widget_get_allocated_baseline GtkWidget* widget")
@@ -8897,7 +8897,7 @@
;;; 3.13.2:
(CFNC-3.14 "gboolean gdk_window_show_window_menu GdkWindow* window GdkEvent* event")
-(CFNC-3.14 "void gtk_widget_set_clip GtkWidget* widget GtkAllocation* clip" 'const)
+;;; 3.91.2 (CFNC-3.14 "void gtk_widget_set_clip GtkWidget* widget GtkAllocation* clip" 'const)
(CFNC-3.14 "void gtk_widget_get_clip GtkWidget* widget GtkAllocation* clip")
(CCAST-3.14 "GTK_GESTURE" "GtkGesture*")
@@ -9618,3 +9618,23 @@
(CFNC-3.99 "gboolean gdk_rectangle_contains_point GdkRectangle* rect int x int y")
(CFNC-3.99 "GtkWidget* gtk_get_event_target GdkEvent* event")
;;; GtkWidget* gtk_get_event_target_with_type GdkEvent* event GType type
+
+
+;;; 3.91.2
+
+(CFNC-3.99 "void gtk_accel_label_set_label GtkAccelLabel* accel_label char* text" 'const)
+(CFNC-3.99 "char* gtk_accel_label_get_label GtkAccelLabel* accel_label" 'const-return)
+(CFNC-3.99 "void gtk_accel_label_set_use_underline GtkAccelLabel* accel_label gboolean setting")
+(CFNC-3.99 "gboolean gtk_accel_label_get_use_underline GtkAccelLabel* accel_label")
+(CFNC-3.99 "void gtk_scrollbar_set_adjustment GtkScrollbar* self GtkAdjustment* adjustment")
+(CFNC-3.99 "GtkAdjustment* gtk_scrollbar_get_adjustment GtkScrollbar* self")
+(CFNC-3.99 "double gtk_scrollbar_get_wheel_delta GtkScrollbar* self GdkEventScroll* event" 'const)
+(CFNC-3.99 "char* gtk_spin_button_get_text GtkSpinButton* spin_button" 'const-return)
+(CFNC-3.99 "void gtk_spin_button_set_text GtkSpinButton* spin_button char* text" 'const)
+(CFNC-3.99 "int gtk_spin_button_get_max_width_chars GtkSpinButton* spin_button")
+(CFNC-3.99 "void gtk_spin_button_set_max_width_chars GtkSpinButton* spin_button int max_width_chars")
+(CFNC-3.99 "int gtk_spin_button_get_width_chars GtkSpinButton* spin_button")
+(CFNC-3.99 "void gtk_spin_button_set_width_chars GtkSpinButton* spin_button int width_chars;")
+(CFNC-3.99 "void gtk_widget_size_allocate GtkWidget* widget GtkAllocation* allocation int baseline GtkAllocation* out_clip")
+
+
diff --git a/vct.c b/vct.c
index c3f6b74..0ff405e 100644
--- a/vct.c
+++ b/vct.c
@@ -59,7 +59,7 @@
#pragma warning(disable: 4244)
#endif
-#if (defined(__GNUC__) && __GNUC__ >= 5)
+#if (defined(__GNUC__) && __GNUC__ >= 5) && (!CLM)
#define WITH_VECTORIZE 1
#else
#define WITH_VECTORIZE 0
@@ -239,7 +239,7 @@ Xen_wrap_free(vct, free_vct, vct_free)
static char *mus_vct_to_string(vct *v)
{
- int len, size;
+ mus_long_t len, size;
char *buf;
char flt[VCT_PRINT_BUFFER_SIZE];
mus_float_t *d;
@@ -250,7 +250,7 @@ static char *mus_vct_to_string(vct *v)
d = mus_vct_data(v);
size = (len + 1) * VCT_PRINT_BUFFER_SIZE;
buf = (char *)calloc(size, sizeof(char));
- snprintf(buf, size, "#<vct[len=%lld" "]", mus_vct_length(v));
+ snprintf(buf, size, "#<vct[len=%" PRId64 "]", mus_vct_length(v));
if ((len > 0) && (d))
{
diff --git a/vct.h b/vct.h
index 07ba5b3..cbeaf62 100644
--- a/vct.h
+++ b/vct.h
@@ -11,7 +11,7 @@ typedef struct vct vct;
extern "C" {
#endif
-#if (defined(__GNUC__) && __GNUC__ >= 5)
+#if (defined(__GNUC__) && __GNUC__ >= 5) && (!CLM)
MUS_EXPORT void mus_clear_floats(mus_float_t *arr, mus_long_t len) __attribute__ ((optimize("tree-vectorize")));
MUS_EXPORT void mus_copy_floats(mus_float_t *dst, mus_float_t *src, mus_long_t len) __attribute__ ((optimize("tree-vectorize")));
MUS_EXPORT void mus_add_floats(mus_float_t *dst, mus_float_t *src, mus_long_t len) __attribute__ ((optimize("tree-vectorize")));
diff --git a/write.scm b/write.scm
index 5f38733..8145a39 100644
--- a/write.scm
+++ b/write.scm
@@ -11,8 +11,8 @@
(any? (lambda (f sequence) ; this and every? ought to be built-in!
(call-with-exit
(lambda (return)
- (for-each (lambda (arg) (if (not (f arg)) (return #f))) sequence)
- #t)))))
+ (for-each (lambda (arg) (if (f arg) (return #t))) sequence)
+ #f)))))
(define pretty-print-1
(letrec ((messy-number (lambda (z)
@@ -428,8 +428,8 @@
h)))
;; pretty-print-1
- (lambda (obj port column)
-
+ (lambda (obj port column)
+
(cond ((number? obj)
(if (rational? obj)
(write obj port)
@@ -694,4 +694,26 @@
(apply string-append (append (reverse! strs) (list "...")))
(apply string-append (reverse! strs))))
(set! strs (cons (format #f "~S " entry) strs)))))
+
+
+;;; pretty-print method:
+(let ((v (openlet (inlet 'value #(0 1 2 3)
+ 'pretty-print (lambda (obj port column)
+ (display "#(... 2 ...)" port))))))
+ (pretty-print (list 1 v 3)))
+
+;;; local pretty-print settings:
+(let ((v (openlet (inlet 'value (* pi 1000)
+ 'pretty-print (lambda (obj port column)
+ (let-temporarily ((((funclet pretty-print) '*pretty-print-float-format*) "~E"))
+ (pretty-print (obj 'value) port column)))))))
+ (pretty-print (list (* pi 1000) v)))
+
+;;; or simpler:
+(let ((v (* 1000 pi)))
+ (let-temporarily ((((funclet pretty-print) '*pretty-print-float-format*) "~E"))
+ (pretty-print v))
+ (newline)
+ (pretty-print v))
+
|#
diff --git a/ws.rb b/ws.rb
index 0477a3d..0a643f0 100644
--- a/ws.rb
+++ b/ws.rb
@@ -1,6 +1,6 @@
# ws.rb -- with_sound and friends for Snd/Ruby
-# Copyright (c) 2003-2015 Michael Scholz <mi-scholz@users.sourceforge.net>
+# Copyright (c) 2003-2017 Michael Scholz <mi-scholz@users.sourceforge.net>
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -25,7 +25,7 @@
# SUCH DAMAGE.
#
# Created: 03/04/08 17:05:03
-# Changed: 15/03/04 16:38:12
+# Changed: 17/08/14 05:49:00
# module WS
# ws_getlogin
@@ -440,7 +440,7 @@ end
with_silence do
# warning: undefined variable
- $clm_version = "ruby 2015/03/04"
+ $clm_version = "ruby 2017/08/14"
$output ||= false
$reverb ||= false
$clm_array_print_length ||= 8
@@ -1658,7 +1658,7 @@ Example: clm_mix(\"tmp\")")
def clm_mix(infile, *args)
output, output_frame, frames, input_frame, scaler = nil
optkey(args, binding,
- [:output, false],
+ [:output, false], # dummy arg
[:output_frame, 0],
[:frames, framples(infile)],
[:input_frame, 0],
@@ -1668,8 +1668,6 @@ Example: clm_mix(\"tmp\")")
Snd.raise(:no_such_file, infile, "file name required")
end
end
- # to silence "warning: assigned but unused variable - output"
- output = "not_used"
[channels(snd), @channels].min.times do |chn|
if scaler and scaler.nonzero?
scale_channel(scaler, input_frame, frames, snd, chn)
@@ -1679,6 +1677,9 @@ Example: clm_mix(\"tmp\")")
end
snd.revert
close_sound_extend(snd)
+ # INFO: output
+ # silence "warning: assigned but unused variable - output"
+ output
end
protected
diff --git a/xen.c b/xen.c
index e19a83a..1e3fa0e 100644
--- a/xen.c
+++ b/xen.c
@@ -1376,7 +1376,7 @@ void xen_repl(int argc, char **argv)
void xen_gc_mark(Xen val)
{
- s7_mark_object(val);
+ s7_mark_c_object(val);
}
diff --git a/xen.h b/xen.h
index 0ab0188..48fa504 100644
--- a/xen.h
+++ b/xen.h
@@ -10,11 +10,13 @@
*/
#define XEN_MAJOR_VERSION 3
-#define XEN_MINOR_VERSION 26
-#define XEN_VERSION "3.26"
+#define XEN_MINOR_VERSION 27
+#define XEN_VERSION "3.27"
/* HISTORY:
*
+ * 2-Aug-17: changed XEN_MAKE_OBJECT_TYPE in s7.
+ * --------
* 29-Jul-16: Xen_define_unsafe_typed_procedure.
* --------
* 20-Aug-15: Xen_define_typed_procedure, Xen_define_typed_dilambda.
@@ -313,7 +315,7 @@
#define XEN_NAME_AS_C_STRING_TO_VALUE(a) xen_rb_gv_get(a)
#define XEN_EVAL_C_STRING(Arg) xen_rb_eval_string_with_error(Arg)
#define XEN_TO_STRING(Obj) xen_rb_obj_as_string(Obj)
-#define XEN_LOAD_FILE(a) xen_rb_load_file_with_error(C_TO_XEN_STRING(a))
+#define XEN_LOAD_FILE(a) rb_load(C_TO_XEN_STRING(a), 0)
#define XEN_LOAD_PATH XEN_NAME_AS_C_STRING_TO_VALUE("$LOAD_PATH")
#define XEN_ADD_TO_LOAD_PATH(Path) xen_rb_add_to_load_path(Path)
@@ -450,7 +452,7 @@
/* ---- keywords, etc ---- */
#define XEN_KEYWORD_EQ_P(k1, k2) ((k1) == (k2))
#define XEN_MAKE_KEYWORD(Arg) xen_rb_make_keyword(Arg)
-#define XEN_PROVIDE(a) rb_provide(a)
+#define XEN_PROVIDE(a) rb_provide(xen_strdup(a))
#define XEN_PROTECT_FROM_GC(Var) rb_gc_register_address(&(Var))
#define XEN_UNPROTECT_FROM_GC(Var) rb_gc_unregister_address(&(Var))
@@ -1066,7 +1068,7 @@ extern size_t xen_s7_number_location, xen_s7_denominator_location;
#define XEN_ULONG_LONG_P(Arg) s7_is_ulong_long(Arg)
#define XEN_TO_C_ULONG_LONG(Arg) s7_ulong_long(Arg)
-#define C_TO_XEN_ULONG_LONG(Arg) s7_make_ulong_long(s7, (unsigned long long)Arg)
+#define C_TO_XEN_ULONG_LONG(Arg) s7_make_ulong_long(s7, (uint64_t)Arg)
#define C_TO_XEN_LONG_LONG(Arg) s7_make_integer(s7, Arg)
#define XEN_TO_C_LONG_LONG(Arg) s7_integer(Arg)
@@ -1203,16 +1205,29 @@ typedef XEN (*XEN_CATCH_BODY_TYPE) (void *dat
#define XEN_MARK_OBJECT_TYPE void
#define XEN_MAKE_OBJECT_TYPE(Name, Print, Free, Equal, Gc_Mark, Apply, Set, Length, Copy, Reverse, Fill) \
- s7_new_type_x(Name, Print, Free, Equal, Gc_Mark, Apply, Set, Length, Copy, Reverse, Fill)
+ ({ int32_t tag; \
+ tag = s7_make_c_type(s7, Name); \
+ if (Print) s7_c_type_set_print(s7, tag, Print); \
+ if (Free) s7_c_type_set_free(s7, tag, Free); \
+ if (Equal) s7_c_type_set_equal(s7, tag, Equal); \
+ if (Gc_Mark) s7_c_type_set_mark(s7, tag, Gc_Mark); \
+ if (Apply) s7_c_type_set_apply(s7, tag, Apply); \
+ if (Set) s7_c_type_set_set(s7, tag, Set); \
+ if (Length) s7_c_type_set_length(s7, tag, Length); \
+ if (Copy) s7_c_type_set_copy(s7, tag, Copy); \
+ if (Reverse) s7_c_type_set_reverse(s7, tag, Reverse); \
+ if (Fill) s7_c_type_set_fill(s7, tag, Fill); \
+ tag; })
+
#define XEN_MAKE_OBJECT_FREE_PROCEDURE(Type, Wrapped_Free, Original_Free) \
static void Wrapped_Free(void *obj) {Original_Free((Type *)obj);}
#define XEN_MAKE_OBJECT_PRINT_PROCEDURE(Type, Wrapped_Print, Original_Print) \
static char *Wrapped_Print(s7_scheme *sc, void *obj) {return(Original_Print((Type *)obj));}
-#define XEN_MAKE_AND_RETURN_OBJECT(Tag, Val, ig1, ig2) return(s7_make_object(s7, Tag, Val))
-#define XEN_MAKE_OBJECT(Tag, Val, ig1, ig2) s7_make_object(s7, Tag, Val)
-#define XEN_OBJECT_REF(Arg) s7_object_value(Arg)
+#define XEN_MAKE_AND_RETURN_OBJECT(Tag, Val, ig1, ig2) return(s7_make_c_object(s7, Tag, Val))
+#define XEN_MAKE_OBJECT(Tag, Val, ig1, ig2) s7_make_c_object(s7, Tag, Val)
+#define XEN_OBJECT_REF(Arg) s7_c_object_value(Arg)
#define XEN_OBJECT_TYPE int /* tag type */
-#define XEN_OBJECT_TYPE_P(Obj, Tag) (s7_object_type(Obj) == Tag)
+#define XEN_OBJECT_TYPE_P(Obj, Tag) (s7_c_object_type(Obj) == Tag)
#define XEN_HOOK_P(Arg) ((Arg) != XEN_FALSE)
#define XEN_DEFINE_HOOK(Name, Descr, Arity, Help) s7_define_constant_with_documentation(s7, Name, s7_eval_c_string(s7, Descr), Help)
@@ -1495,10 +1510,10 @@ void xen_no_ext_lang_check_args(const char *name, int args, int req_args, int op
#define XEN_UNWRAP_C_POINTER(a) s7_c_pointer(a)
#else
#if (SIZEOF_VOID_P == 4)
- #define XEN_WRAP_C_POINTER(a) ((XEN)(C_TO_XEN_ULONG((unsigned int)a)))
+ #define XEN_WRAP_C_POINTER(a) ((XEN)(C_TO_XEN_ULONG((unsigned long)a)))
#define XEN_UNWRAP_C_POINTER(a) XEN_TO_C_ULONG(a)
#else
- #define XEN_WRAP_C_POINTER(a) C_TO_XEN_ULONG_LONG((unsigned long long int)(a))
+ #define XEN_WRAP_C_POINTER(a) C_TO_XEN_ULONG_LONG((uint64_t)(a))
#define XEN_UNWRAP_C_POINTER(a) XEN_TO_C_ULONG_LONG(a)
#endif
#endif
diff --git a/xg.c b/xg.c
index 15c1f84..fcf91d1 100644
--- a/xg.c
+++ b/xg.c
@@ -177,7 +177,9 @@ static Xen make_xm_obj(void *ptr)
static void define_xm_obj(void)
{
#if HAVE_SCHEME
- xm_obj_tag = s7_new_type_x(s7, "<XmObj>", NULL, xm_obj_free, s7_equalp_xm, NULL, NULL, NULL, NULL, NULL, NULL, NULL);
+ xm_obj_tag = s7_make_c_type(s7, "<XmObj>");
+ s7_c_type_set_free(s7, xm_obj_tag, xm_obj_free);
+ s7_c_type_set_equal(s7, xm_obj_tag, s7_equalp_xm);
#else
xm_obj_tag = Xen_make_object_type("XmObj", sizeof(void *));
#endif
@@ -204,7 +206,7 @@ static void define_xm_obj(void)
#define Xg_field_pre "F"
#endif
-static Xen xg_GtkCenterBox__symbol, xg_GtkCheckButton__symbol, xg_GdkDrawContext__symbol, xg_GtkDrawingAreaDrawFunc_symbol, xg_GtkShortcutLabel__symbol, xg_GtkPadActionType_symbol, xg_GtkPadActionEntry__symbol, xg_GActionGroup__symbol, xg_GtkPadController__symbol, xg_GdkDevicePadFeature_symbol, xg_GdkDevicePad__symbol, xg_GdkDrawingContext__symbol, xg_GdkSubpixelLayout_symbol, xg_GdkMonitor__symbol, xg_GdkDeviceTool__symbol, xg_GdkAxisFlags_symbol, xg_GdkSeatGrabPrepareFunc_symbol, xg_GdkSeatCapabilities_symbol, xg_GdkGrabStatus_symbol, xg_GtkPopoverConstraint_symbol, xg_GtkShortcutsWindow__symbol, xg_GtkStackSidebar__symbol, xg_GtkSearchEntry__symbol, xg_GtkPopoverMenu__symbol, xg_GtkStyleContext__symbol, xg_GdkGLContext__symbol, xg_GtkGLArea__symbol, xg_GtkPropagationPhase_symbol, xg_GtkEventController__symbol, xg_GtkGestureZoom__symbol, xg_GtkGestureSwipe__symbol, xg_GtkGestureSingle__symbol, xg_GtkGestureRotate__symbol, xg_GtkGestureMultiPress__symbol, xg_GtkGesturePan__symbol, xg_GtkGestureDrag__symbol, xg_GdkEventSequence__symbol, xg_GtkEventSequenceState_symbol, xg_GtkGesture__symbol, xg_GtkPopover__symbol, xg_GtkActionBar__symbol, xg_GtkFlowBox__symbol, xg_GtkFlowBoxChild__symbol, xg_GdkEventType_symbol, xg_GtkSearchBar__symbol, xg_GtkListBox__symbol, xg_GtkListBoxRow__symbol, xg_GtkHeaderBar__symbol, xg_GtkRevealerTransitionType_symbol, xg_GtkRevealer__symbol, xg_GtkStackTransitionType_symbol, xg_GtkStack__symbol, xg_GtkStackSwitcher__symbol, xg_GtkPlacesSidebar__symbol, xg_GtkPlacesOpenFlags_symbol, xg_GtkBaselinePosition_symbol, xg_GdkFullscreenMode_symbol, xg_GtkInputHints_symbol, xg_GtkInputPurpose_symbol, xg_GtkLevelBarMode_symbol, xg_GtkLevelBar__symbol, xg_GtkMenuButton__symbol, xg_GtkColorChooser__symbol, xg_GtkApplicationWindow__symbol, xg_GtkApplication__symbol, xg_GMenuModel__symbol, xg_guint___symbol, xg_GdkModifierIntent_symbol, xg_GtkFontChooser__symbol, xg_GdkScrollDirection_symbol, xg_GtkOverlay__symbol, xg_GtkWidgetPath__symbol, xg_GtkStateFlags_symbol, xg_GdkScreen___symbol, xg_GtkToolShell__symbol, xg_GtkWindowGroup__symbol, xg_GtkInvisible__symbol, xg_GtkOrientable__symbol, xg_GtkCellArea__symbol, xg_GtkBorder__symbol, xg_GtkSwitch__symbol, xg_GtkScrollablePolicy_symbol, xg_GtkScrollable__symbol, xg_GtkGrid__symbol, xg_GdkRGBA__symbol, xg_GtkComboBoxText__symbol, xg_GtkAlign_symbol, xg_GtkSizeRequestMode_symbol, xg_cairo_region_overlap_t_symbol, xg_cairo_rectangle_int_t__symbol, xg_double__symbol, xg_cairo_rectangle_t__symbol, xg_cairo_device_t__symbol, xg_cairo_bool_t_symbol, xg_cairo_text_cluster_flags_t__symbol, xg_cairo_text_cluster_t___symbol, xg_cairo_glyph_t___symbol, xg_cairo_text_cluster_flags_t_symbol, xg_cairo_text_cluster_t__symbol, xg_cairo_region_t__symbol, xg_GtkMessageDialog__symbol, xg_GdkDevice__symbol, xg_GtkAccessible__symbol, xg_GdkModifierType__symbol, xg_GtkToolPaletteDragTargets_symbol, xg_GtkToolItemGroup__symbol, xg_GtkToolPalette__symbol, xg_GtkSpinner__symbol, xg_GtkEntryBuffer__symbol, xg_GtkMessageType_symbol, xg_GtkInfoBar__symbol, xg_GIcon__symbol, xg_GtkEntryIconPosition_symbol, xg_GFile__symbol, xg_GtkScaleButton__symbol, xg_GtkCalendarDetailFunc_symbol, xg_GtkTooltip__symbol, xg_cairo_rectangle_list_t__symbol, xg_void__symbol, xg_cairo_filter_t_symbol, xg_cairo_extend_t_symbol, xg_cairo_format_t_symbol, xg_cairo_path_t__symbol, xg_cairo_destroy_func_t_symbol, xg_cairo_user_data_key_t__symbol, xg_cairo_text_extents_t__symbol, xg_cairo_font_extents_t__symbol, xg_cairo_font_face_t__symbol, xg_cairo_glyph_t__symbol, xg_cairo_scaled_font_t__symbol, xg_cairo_font_weight_t_symbol, xg_cairo_font_slant_t_symbol, xg_cairo_hint_metrics_t_symbol, xg_cairo_hint_style_t_symbol, xg_cairo_subpixel_order_t_symbol, xg_cairo_status_t_symbol, xg_bool_symbol, xg_cairo_matrix_t__symbol, xg_cairo_line_join_t_symbol, xg_cairo_line_cap_t_symbol, xg_cairo_fill_rule_t_symbol, xg_cairo_antialias_t_symbol, xg_cairo_operator_t_symbol, xg_cairo_pattern_t__symbol, xg_cairo_content_t_symbol, xg_GtkPageSet_symbol, xg_GtkPageRange__symbol, xg_GtkPrintPages_symbol, xg_GtkPrintQuality_symbol, xg_GtkPrintDuplex_symbol, xg_GtkPaperSize__symbol, xg_GtkPageOrientation_symbol, xg_GtkPrintSettingsFunc_symbol, xg_GtkPageSetupDoneFunc_symbol, xg_GtkPrintStatus_symbol, xg_GtkPrintOperationAction_symbol, xg_GtkPrintOperationResult_symbol, xg_GtkUnit_symbol, xg_GtkPrintSettings__symbol, xg_GtkPrintOperation__symbol, xg_GtkPageSetup__symbol, xg_GtkPrintContext__symbol, xg_cairo_surface_t__symbol, xg_GtkTreeViewGridLines_symbol, xg_GtkRecentData__symbol, xg_GtkTextBufferDeserializeFunc_symbol, xg_GtkTextBufferSerializeFunc_symbol, xg_time_t_symbol, xg_GtkRecentChooserMenu__symbol, xg_GtkRecentManager__symbol, xg_GtkRecentFilter__symbol, xg_GtkRecentSortFunc_symbol, xg_GtkRecentSortType_symbol, xg_GtkRecentChooser__symbol, xg_GtkLinkButton__symbol, xg_GtkAssistantPageType_symbol, xg_GtkAssistantPageFunc_symbol, xg_GtkAssistant__symbol, xg_GDestroyNotify_symbol, xg_GtkTreeViewSearchPositionFunc_symbol, xg_GtkSensitivityType_symbol, xg_GtkClipboardRichTextReceivedFunc_symbol, xg_GtkMenuBar__symbol, xg_GtkPackDirection_symbol, xg_GtkIconViewDropPosition_symbol, xg_GValue__symbol, xg_GLogFunc_symbol, xg_PangoMatrix__symbol, xg_PangoRenderPart_symbol, xg_PangoRenderer__symbol, xg_GtkClipboardImageReceivedFunc_symbol, xg_GtkMenuToolButton__symbol, xg_GtkFileChooserButton__symbol, xg_PangoScriptIter__symbol, xg_PangoScript_symbol, xg_PangoAttrFilterFunc_symbol, xg_PangoEllipsizeMode_symbol, xg_GtkIconViewForeachFunc_symbol, xg_GtkAboutDialog__symbol, xg_GtkTreeViewRowSeparatorFunc_symbol, xg_GtkCellView__symbol, xg_GtkAccelMap__symbol, xg_GtkClipboardTargetsReceivedFunc_symbol, xg_GtkOrientation_symbol, xg_GtkToolButton__symbol, xg_GtkIconLookupFlags_symbol, xg_GtkIconInfo__symbol, xg_GtkIconTheme__symbol, xg_GtkFileChooser__symbol, xg_GtkCellLayoutDataFunc_symbol, xg_GtkCellLayout__symbol, xg_GtkFileFilterFunc_symbol, xg_GtkFileFilterFlags_symbol, xg_GtkFileFilter__symbol, xg_GSourceFunc_symbol, xg_GtkToggleToolButton__symbol, xg_GtkSeparatorToolItem__symbol, xg_GtkRadioToolButton__symbol, xg_GtkEntryCompletionMatchFunc_symbol, xg_GtkFontButton__symbol, xg_GtkExpander__symbol, xg_GtkComboBox__symbol, xg_GtkTreeModelFilter__symbol, xg_GtkFileChooserAction_symbol, xg_GtkToolItem__symbol, xg_GtkEventBox__symbol, xg_GtkCalendarDisplayOptions_symbol, xg_GdkScreen__symbol, xg_PangoLayoutRun__symbol, xg_PangoLayoutIter__symbol, xg_PangoLayoutLine__symbol, xg_int__symbol, xg_PangoAlignment_symbol, xg_PangoWrapMode_symbol, xg_PangoItem__symbol, xg_PangoGlyphString__symbol, xg_PangoFontMap__symbol, xg_PangoGlyph_symbol, xg_PangoFontFace__symbol, xg_PangoFontFace___symbol, xg_PangoFontFamily__symbol, xg_PangoFontMask_symbol, xg_PangoFontDescription___symbol, xg_PangoCoverageLevel_symbol, xg_PangoCoverage__symbol, xg_PangoFontMetrics__symbol, xg_PangoFontset__symbol, xg_PangoFont__symbol, xg_PangoFontFamily___symbol, xg_PangoLogAttr__symbol, xg_PangoAnalysis__symbol, xg_PangoAttrList___symbol, xg_PangoAttrIterator__symbol, xg_PangoRectangle__symbol, xg_PangoUnderline_symbol, xg_PangoStretch_symbol, xg_PangoVariant_symbol, xg_PangoWeight_symbol, xg_PangoStyle_symbol, xg_guint16_symbol, xg_PangoAttribute__symbol, xg_PangoAttrType_symbol, xg_PangoColor__symbol, xg_GdkGravity_symbol, xg_GtkWindowPosition_symbol, xg_GtkWindowType_symbol, xg_GtkWindow__symbol, xg_GtkTextDirection_symbol, xg_AtkObject__symbol, xg_GtkDirectionType_symbol, xg_GtkAllocation__symbol, xg_GtkViewport__symbol, xg_GtkTreeViewSearchEqualFunc_symbol, xg_GtkTreeViewDropPosition_symbol, xg_GtkTreeViewMappingFunc_symbol, xg_GtkTreeViewColumnDropFunc_symbol, xg_GtkTreeViewColumnSizing_symbol, xg_GtkTreeCellDataFunc_symbol, xg_GtkTreeStore__symbol, xg_GtkTreeIterCompareFunc_symbol, xg_GtkSortType_symbol, xg_GtkTreeSortable__symbol, xg_GtkTreeSelectionForeachFunc_symbol, xg_GtkTreeModel___symbol, xg_GtkTreeSelectionFunc_symbol, xg_GtkSelectionMode_symbol, xg_GtkTreeModelSort__symbol, xg_GtkTreeModelForeachFunc_symbol, xg_GtkTreeModelFlags_symbol, xg_GtkTreeRowReference__symbol, xg_GtkTreeDragDest__symbol, xg_GtkTreeDragSource__symbol, xg_GtkToolbarStyle_symbol, xg_GtkToolbar__symbol, xg_GtkToggleButton__symbol, xg_PangoTabArray__symbol, xg_GtkWrapMode_symbol, xg_GtkTextWindowType_symbol, xg_GtkTextView__symbol, xg_GtkTextTagTableForeach_symbol, xg_GtkTextAttributes__symbol, xg_GtkTextSearchFlags_symbol, xg_GtkTextCharPredicate_symbol, xg_GtkTextMark__symbol, xg_GtkTextChildAnchor__symbol, xg_GtkTextIter__symbol, xg_GtkTextTagTable__symbol, xg_GtkTextBuffer__symbol, xg_GtkStatusbar__symbol, xg_GtkSpinType_symbol, xg_GtkSpinButtonUpdatePolicy_symbol, xg_GtkSpinButton__symbol, xg_GtkSizeGroupMode_symbol, xg_GtkSizeGroup__symbol, xg_GtkSettings__symbol, xg_GtkCornerType_symbol, xg_GtkPolicyType_symbol, xg_GtkScrolledWindow__symbol, xg_GtkScale__symbol, xg_GtkRange__symbol, xg_GtkRadioMenuItem__symbol, xg_GtkRadioButton__symbol, xg_GtkProgressBar__symbol, xg_GtkPaned__symbol, xg_GtkPositionType_symbol, xg_GtkNotebook__symbol, xg_GtkMenuShell__symbol, xg_gint__symbol, xg_GtkMenuItem__symbol, xg_GtkMenu__symbol, xg_PangoLanguage__symbol, xg_GtkListStore__symbol, xg_GtkLayout__symbol, xg_GtkJustification_symbol, xg_GtkLabel__symbol, xg_guint16__symbol, xg_GtkIMContextSimple__symbol, xg_GdkEventKey__symbol, xg_PangoAttrList__symbol, xg_GtkIMContext__symbol, xg_GtkImageType_symbol, xg_GtkImage__symbol, xg_GtkShadowType_symbol, xg_GtkFrame__symbol, xg_GtkFixed__symbol, xg_PangoLayout__symbol, xg_GtkEntry__symbol, xg_GtkEditable__symbol, xg_GtkTargetList__symbol, xg_GtkDestDefaults_symbol, xg_etc_symbol, xg_GtkDialog__symbol, xg_GtkCallback_symbol, xg_GtkContainer__symbol, xg_GtkClipboardTextReceivedFunc_symbol, xg_GtkClipboardReceivedFunc_symbol, xg_GtkClipboardClearFunc_symbol, xg_GtkClipboardGetFunc_symbol, xg_GtkTargetEntry__symbol, xg_GtkCheckMenuItem__symbol, xg_GtkCellRendererToggle__symbol, xg_GtkCellRendererText__symbol, xg_GtkCellRendererState_symbol, xg_GtkCellEditable__symbol, xg_GtkCalendar__symbol, xg_GtkReliefStyle_symbol, xg_GtkButton__symbol, xg_GtkPackType_symbol, xg_GtkBox__symbol, xg_GtkBin__symbol, xg_GtkBindingSet__symbol, xg_GtkButtonBox__symbol, xg_GtkButtonBoxStyle_symbol, xg_GtkAspectFrame__symbol, xg_GtkAdjustment__symbol, xg_GtkAccelMapForeach_symbol, xg_GtkAccelLabel__symbol, xg_GtkAccelGroupEntry__symbol, xg_lambda3_symbol, xg_GSList__symbol, xg_GObject__symbol, xg_GtkAccelFlags_symbol, xg_GtkAccelGroup__symbol, xg_GTimeVal__symbol, xg_GdkPixbufAnimationIter__symbol, xg_GdkPixbufAnimation__symbol, xg_GdkInterpType_symbol, xg_double_symbol, xg_gfloat_symbol, xg_guchar_symbol, xg_char___symbol, xg_GdkPixbufDestroyNotify_symbol, xg_GError__symbol, xg_int_symbol, xg_GdkColorspace_symbol, xg_GdkWindowTypeHint_symbol, xg_GdkWindowHints_symbol, xg_GdkGeometry__symbol, xg_GdkWindowEdge_symbol, xg_GdkWMFunction_symbol, xg_GdkWMDecoration_symbol, xg_GdkEventMask_symbol, xg_GdkWindowState_symbol, xg_GdkFilterFunc_symbol, xg_GdkWindowType_symbol, xg_GdkPropMode_symbol, xg_guchar__symbol, xg_PangoContext__symbol, xg_PangoDirection_symbol, xg_GdkKeymapKey__symbol, xg_GdkKeymap__symbol, xg_GdkRectangle__symbol, xg_char__symbol, xg_gchar___symbol, xg_GdkEventFunc_symbol, xg_gdouble_symbol, xg_GList__symbol, xg_guint32_symbol, xg_GdkDragAction_symbol, xg_GdkDragContext__symbol, xg_GdkCursorType_symbol, xg_GdkDisplay__symbol, xg_GdkCursor__symbol, xg_GSignalMatchType_symbol, xg_GConnectFlags_symbol, xg_GtkDestroyNotify_symbol, xg_GSignalEmissionHook_symbol, xg_gulong_symbol, xg_GSignalInvocationHint__symbol, xg_GQuark_symbol, xg_guint__symbol, xg_GSignalQuery__symbol, xg_GType__symbol, xg_GSignalCMarshaller_symbol, xg_gpointer_symbol, xg_GSignalAccumulator_symbol, xg_GSignalFlags_symbol, xg_GType_symbol, xg_GClosureNotify_symbol, xg_GCallback_symbol, xg_GNormalizeMode_symbol, xg_glong_symbol, xg_gssize_symbol, xg_gunichar__symbol, xg_void_symbol, xg_GtkDrawingArea__symbol, xg_GdkSeat__symbol, xg_GtkRecentInfo__symbol, xg_gsize_symbol, xg_guint8__symbol, xg_GdkAtom_symbol, xg_GLogLevelFlags_symbol, xg_GdkPixbuf__symbol, xg_GtkIconView__symbol, xg_GtkEntryCompletion__symbol, xg_GtkFileFilterInfo__symbol, xg_GtkTreeSelection__symbol, xg_GtkCellRenderer__symbol, xg_GtkTreeViewColumn__symbol, xg_GtkTreeView__symbol, xg_gunichar_symbol, xg_gint_symbol, xg_GdkAtom__symbol, xg_GtkSelectionData__symbol, xg_GtkClipboard__symbol, xg_GtkTreeIter__symbol, xg_GtkTreePath__symbol, xg_GtkTreeModel__symbol, xg_gboolean_symbol, xg_GdkModifierType_symbol, xg_guint_symbol, xg_gchar__symbol, xg_GtkTextTag__symbol, xg_GdkXEvent__symbol, xg_GtkWidget__symbol, xg_lambda_data_symbol, xg_GClosure__symbol, xg_GtkAccelKey__symbol, xg_GdkEventMotion__symbol, xg_gdouble__symbol, xg_GdkEventAny__symbol, xg_GdkEvent__symbol, xg_GdkWindow__symbol, xg_cairo_t__symbol, xg_cairo_font_options_t__symbol, xg_PangoFontDescription__symbol, xg_idler_symbol, xg_GtkCellRendererPixbuf__symbol, xg_GtkScrollbar__symbol, xg_GtkSeparator__symbol, xg_GtkSeparatorMenuItem__symbol, xg_GdkEventExpose__symbol, xg_GdkEventNoExpose__symbol, xg_GdkEventVisibility__symbol, xg_GdkEventButton__symbol, xg_GdkEventScroll__symbol, xg_GdkEventCrossing__symbol, xg_GdkEventFocus__symbol, xg_GdkEventConfigure__symbol, xg_GdkEventProperty__symbol, xg_GdkEventSelection__symbol, xg_GdkEventProximity__symbol, xg_GdkEventSetting__symbol, xg_GdkEventWindowState__symbol, xg_GdkEventDND__symbol, xg_GtkFileChooserDialog__symbol, xg_GtkFileChooserWidget__symbol, xg_GtkColorButton__symbol, xg_GtkAccelMap_symbol, xg_GtkCellRendererCombo__symbol, xg_GtkCellRendererProgress__symbol, xg_GtkCellRendererAccel__symbol, xg_GtkCellRendererSpin__symbol, xg_GtkRecentChooserDialog__symbol, xg_GtkRecentChooserWidget__symbol, xg_GtkCellRendererSpinner__symbol, xg_gboolean__symbol, xg_GtkFontChooserDialog__symbol, xg_GtkFontChooserWidget__symbol, xg_GtkColorChooserDialog__symbol, xg_GtkColorChooserWidget__symbol, xg_GtkColorWidget__symbol, xg_GtkGestureLongPress__symbol;
+static Xen xg_GdkEventScroll__symbol, xg_GtkScrollbar__symbol, xg_GtkCenterBox__symbol, xg_GtkCheckButton__symbol, xg_GdkDrawContext__symbol, xg_GtkDrawingAreaDrawFunc_symbol, xg_GtkShortcutLabel__symbol, xg_GtkPadActionType_symbol, xg_GtkPadActionEntry__symbol, xg_GActionGroup__symbol, xg_GtkPadController__symbol, xg_GdkDevicePadFeature_symbol, xg_GdkDevicePad__symbol, xg_GdkDrawingContext__symbol, xg_GdkSubpixelLayout_symbol, xg_GdkMonitor__symbol, xg_GdkDeviceTool__symbol, xg_GdkAxisFlags_symbol, xg_GdkSeatGrabPrepareFunc_symbol, xg_GdkSeatCapabilities_symbol, xg_GdkGrabStatus_symbol, xg_GtkPopoverConstraint_symbol, xg_GtkShortcutsWindow__symbol, xg_GtkStackSidebar__symbol, xg_GtkSearchEntry__symbol, xg_GtkPopoverMenu__symbol, xg_GtkStyleContext__symbol, xg_GdkGLContext__symbol, xg_GtkGLArea__symbol, xg_GtkPropagationPhase_symbol, xg_GtkEventController__symbol, xg_GtkGestureZoom__symbol, xg_GtkGestureSwipe__symbol, xg_GtkGestureSingle__symbol, xg_GtkGestureRotate__symbol, xg_GtkGestureMultiPress__symbol, xg_GtkGesturePan__symbol, xg_GtkGestureDrag__symbol, xg_GdkEventSequence__symbol, xg_GtkEventSequenceState_symbol, xg_GtkGesture__symbol, xg_GtkAllocation__symbol, xg_GtkPopover__symbol, xg_GtkActionBar__symbol, xg_GtkFlowBox__symbol, xg_GtkFlowBoxChild__symbol, xg_GdkEventType_symbol, xg_GtkSearchBar__symbol, xg_GtkListBox__symbol, xg_GtkListBoxRow__symbol, xg_GtkHeaderBar__symbol, xg_GtkRevealerTransitionType_symbol, xg_GtkRevealer__symbol, xg_GtkStackTransitionType_symbol, xg_GtkStack__symbol, xg_GtkStackSwitcher__symbol, xg_GtkPlacesSidebar__symbol, xg_GtkPlacesOpenFlags_symbol, xg_GtkBaselinePosition_symbol, xg_GdkFullscreenMode_symbol, xg_GtkInputHints_symbol, xg_GtkInputPurpose_symbol, xg_GtkLevelBarMode_symbol, xg_GtkLevelBar__symbol, xg_GtkMenuButton__symbol, xg_GtkColorChooser__symbol, xg_GtkApplicationWindow__symbol, xg_GtkApplication__symbol, xg_GMenuModel__symbol, xg_guint___symbol, xg_GdkModifierIntent_symbol, xg_GtkFontChooser__symbol, xg_GdkScrollDirection_symbol, xg_GtkOverlay__symbol, xg_GtkWidgetPath__symbol, xg_GtkStateFlags_symbol, xg_GdkScreen___symbol, xg_GtkToolShell__symbol, xg_GtkWindowGroup__symbol, xg_GtkInvisible__symbol, xg_GtkOrientable__symbol, xg_GtkCellArea__symbol, xg_GtkBorder__symbol, xg_GtkSwitch__symbol, xg_GtkScrollablePolicy_symbol, xg_GtkScrollable__symbol, xg_GtkGrid__symbol, xg_GdkRGBA__symbol, xg_GtkComboBoxText__symbol, xg_GtkAlign_symbol, xg_GtkSizeRequestMode_symbol, xg_cairo_region_overlap_t_symbol, xg_cairo_rectangle_int_t__symbol, xg_double__symbol, xg_cairo_rectangle_t__symbol, xg_cairo_device_t__symbol, xg_cairo_bool_t_symbol, xg_cairo_text_cluster_flags_t__symbol, xg_cairo_text_cluster_t___symbol, xg_cairo_glyph_t___symbol, xg_cairo_text_cluster_flags_t_symbol, xg_cairo_text_cluster_t__symbol, xg_cairo_region_t__symbol, xg_GtkMessageDialog__symbol, xg_GdkDevice__symbol, xg_GtkAccessible__symbol, xg_GdkModifierType__symbol, xg_GtkToolPaletteDragTargets_symbol, xg_GtkToolItemGroup__symbol, xg_GtkToolPalette__symbol, xg_GtkSpinner__symbol, xg_GtkEntryBuffer__symbol, xg_GtkMessageType_symbol, xg_GtkInfoBar__symbol, xg_GIcon__symbol, xg_GtkEntryIconPosition_symbol, xg_GFile__symbol, xg_GtkScaleButton__symbol, xg_GtkCalendarDetailFunc_symbol, xg_GtkTooltip__symbol, xg_cairo_rectangle_list_t__symbol, xg_void__symbol, xg_cairo_filter_t_symbol, xg_cairo_extend_t_symbol, xg_cairo_format_t_symbol, xg_cairo_path_t__symbol, xg_cairo_destroy_func_t_symbol, xg_cairo_user_data_key_t__symbol, xg_cairo_text_extents_t__symbol, xg_cairo_font_extents_t__symbol, xg_cairo_font_face_t__symbol, xg_cairo_glyph_t__symbol, xg_cairo_scaled_font_t__symbol, xg_cairo_font_weight_t_symbol, xg_cairo_font_slant_t_symbol, xg_cairo_hint_metrics_t_symbol, xg_cairo_hint_style_t_symbol, xg_cairo_subpixel_order_t_symbol, xg_cairo_status_t_symbol, xg_bool_symbol, xg_cairo_matrix_t__symbol, xg_cairo_line_join_t_symbol, xg_cairo_line_cap_t_symbol, xg_cairo_fill_rule_t_symbol, xg_cairo_antialias_t_symbol, xg_cairo_operator_t_symbol, xg_cairo_pattern_t__symbol, xg_cairo_content_t_symbol, xg_GtkPageSet_symbol, xg_GtkPageRange__symbol, xg_GtkPrintPages_symbol, xg_GtkPrintQuality_symbol, xg_GtkPrintDuplex_symbol, xg_GtkPaperSize__symbol, xg_GtkPageOrientation_symbol, xg_GtkPrintSettingsFunc_symbol, xg_GtkPageSetupDoneFunc_symbol, xg_GtkPrintStatus_symbol, xg_GtkPrintOperationAction_symbol, xg_GtkPrintOperationResult_symbol, xg_GtkUnit_symbol, xg_GtkPrintSettings__symbol, xg_GtkPrintOperation__symbol, xg_GtkPageSetup__symbol, xg_GtkPrintContext__symbol, xg_cairo_surface_t__symbol, xg_GtkTreeViewGridLines_symbol, xg_GtkRecentData__symbol, xg_GtkTextBufferDeserializeFunc_symbol, xg_GtkTextBufferSerializeFunc_symbol, xg_time_t_symbol, xg_GtkRecentChooserMenu__symbol, xg_GtkRecentManager__symbol, xg_GtkRecentFilter__symbol, xg_GtkRecentSortFunc_symbol, xg_GtkRecentSortType_symbol, xg_GtkRecentChooser__symbol, xg_GtkLinkButton__symbol, xg_GtkAssistantPageType_symbol, xg_GtkAssistantPageFunc_symbol, xg_GtkAssistant__symbol, xg_GDestroyNotify_symbol, xg_GtkTreeViewSearchPositionFunc_symbol, xg_GtkSensitivityType_symbol, xg_GtkClipboardRichTextReceivedFunc_symbol, xg_GtkMenuBar__symbol, xg_GtkPackDirection_symbol, xg_GtkIconViewDropPosition_symbol, xg_GValue__symbol, xg_GLogFunc_symbol, xg_PangoMatrix__symbol, xg_PangoRenderPart_symbol, xg_PangoRenderer__symbol, xg_GtkClipboardImageReceivedFunc_symbol, xg_GtkMenuToolButton__symbol, xg_GtkFileChooserButton__symbol, xg_PangoScriptIter__symbol, xg_PangoScript_symbol, xg_PangoAttrFilterFunc_symbol, xg_PangoEllipsizeMode_symbol, xg_GtkIconViewForeachFunc_symbol, xg_GtkAboutDialog__symbol, xg_GtkTreeViewRowSeparatorFunc_symbol, xg_GtkCellView__symbol, xg_GtkAccelMap__symbol, xg_GtkClipboardTargetsReceivedFunc_symbol, xg_GtkOrientation_symbol, xg_GtkToolButton__symbol, xg_GtkIconLookupFlags_symbol, xg_GtkIconInfo__symbol, xg_GtkIconTheme__symbol, xg_GtkFileChooser__symbol, xg_GtkCellLayoutDataFunc_symbol, xg_GtkCellLayout__symbol, xg_GtkFileFilterFunc_symbol, xg_GtkFileFilterFlags_symbol, xg_GtkFileFilter__symbol, xg_GSourceFunc_symbol, xg_GtkToggleToolButton__symbol, xg_GtkSeparatorToolItem__symbol, xg_GtkRadioToolButton__symbol, xg_GtkEntryCompletionMatchFunc_symbol, xg_GtkFontButton__symbol, xg_GtkExpander__symbol, xg_GtkComboBox__symbol, xg_GtkTreeModelFilter__symbol, xg_GtkFileChooserAction_symbol, xg_GtkToolItem__symbol, xg_GtkCalendarDisplayOptions_symbol, xg_GdkScreen__symbol, xg_PangoLayoutRun__symbol, xg_PangoLayoutIter__symbol, xg_PangoLayoutLine__symbol, xg_int__symbol, xg_PangoAlignment_symbol, xg_PangoWrapMode_symbol, xg_PangoItem__symbol, xg_PangoGlyphString__symbol, xg_PangoFontMap__symbol, xg_PangoGlyph_symbol, xg_PangoFontFace__symbol, xg_PangoFontFace___symbol, xg_PangoFontFamily__symbol, xg_PangoFontMask_symbol, xg_PangoFontDescription___symbol, xg_PangoCoverageLevel_symbol, xg_PangoCoverage__symbol, xg_PangoFontMetrics__symbol, xg_PangoFontset__symbol, xg_PangoFont__symbol, xg_PangoFontFamily___symbol, xg_PangoLogAttr__symbol, xg_PangoAnalysis__symbol, xg_PangoAttrList___symbol, xg_PangoAttrIterator__symbol, xg_PangoRectangle__symbol, xg_PangoUnderline_symbol, xg_PangoStretch_symbol, xg_PangoVariant_symbol, xg_PangoWeight_symbol, xg_PangoStyle_symbol, xg_guint16_symbol, xg_PangoAttribute__symbol, xg_PangoAttrType_symbol, xg_PangoColor__symbol, xg_GdkGravity_symbol, xg_GtkWindowPosition_symbol, xg_GtkWindowType_symbol, xg_GtkWindow__symbol, xg_GtkTextDirection_symbol, xg_AtkObject__symbol, xg_GtkDirectionType_symbol, xg_GtkViewport__symbol, xg_GtkTreeViewSearchEqualFunc_symbol, xg_GtkTreeViewDropPosition_symbol, xg_GtkTreeViewMappingFunc_symbol, xg_GtkTreeViewColumnDropFunc_symbol, xg_GtkTreeViewColumnSizing_symbol, xg_GtkTreeCellDataFunc_symbol, xg_GtkTreeStore__symbol, xg_GtkTreeIterCompareFunc_symbol, xg_GtkSortType_symbol, xg_GtkTreeSortable__symbol, xg_GtkTreeSelectionForeachFunc_symbol, xg_GtkTreeModel___symbol, xg_GtkTreeSelectionFunc_symbol, xg_GtkSelectionMode_symbol, xg_GtkTreeModelSort__symbol, xg_GtkTreeModelForeachFunc_symbol, xg_GtkTreeModelFlags_symbol, xg_GtkTreeRowReference__symbol, xg_GtkTreeDragDest__symbol, xg_GtkTreeDragSource__symbol, xg_GtkToolbarStyle_symbol, xg_GtkToolbar__symbol, xg_GtkToggleButton__symbol, xg_PangoTabArray__symbol, xg_GtkWrapMode_symbol, xg_GtkTextWindowType_symbol, xg_GtkTextView__symbol, xg_GtkTextTagTableForeach_symbol, xg_GtkTextAttributes__symbol, xg_GtkTextSearchFlags_symbol, xg_GtkTextCharPredicate_symbol, xg_GtkTextMark__symbol, xg_GtkTextChildAnchor__symbol, xg_GtkTextIter__symbol, xg_GtkTextTagTable__symbol, xg_GtkTextBuffer__symbol, xg_GtkStatusbar__symbol, xg_GtkSpinType_symbol, xg_GtkSpinButtonUpdatePolicy_symbol, xg_GtkSpinButton__symbol, xg_GtkSizeGroupMode_symbol, xg_GtkSizeGroup__symbol, xg_GtkSettings__symbol, xg_GtkCornerType_symbol, xg_GtkPolicyType_symbol, xg_GtkScrolledWindow__symbol, xg_GtkScale__symbol, xg_GtkRange__symbol, xg_GtkRadioMenuItem__symbol, xg_GtkRadioButton__symbol, xg_GtkProgressBar__symbol, xg_GtkPaned__symbol, xg_GtkPositionType_symbol, xg_GtkNotebook__symbol, xg_GtkMenuShell__symbol, xg_gint__symbol, xg_GtkMenuItem__symbol, xg_GtkMenu__symbol, xg_PangoLanguage__symbol, xg_GtkListStore__symbol, xg_GtkLayout__symbol, xg_GtkJustification_symbol, xg_GtkLabel__symbol, xg_guint16__symbol, xg_GtkIMContextSimple__symbol, xg_GdkEventKey__symbol, xg_PangoAttrList__symbol, xg_GtkIMContext__symbol, xg_GtkImageType_symbol, xg_GtkImage__symbol, xg_GtkShadowType_symbol, xg_GtkFrame__symbol, xg_GtkFixed__symbol, xg_PangoLayout__symbol, xg_GtkEntry__symbol, xg_GtkEditable__symbol, xg_GtkTargetList__symbol, xg_GtkDestDefaults_symbol, xg_etc_symbol, xg_GtkDialog__symbol, xg_GtkCallback_symbol, xg_GtkContainer__symbol, xg_GtkClipboardTextReceivedFunc_symbol, xg_GtkClipboardReceivedFunc_symbol, xg_GtkClipboardClearFunc_symbol, xg_GtkClipboardGetFunc_symbol, xg_GtkTargetEntry__symbol, xg_GtkCheckMenuItem__symbol, xg_GtkCellRendererToggle__symbol, xg_GtkCellRendererText__symbol, xg_GtkCellRendererState_symbol, xg_GtkCellEditable__symbol, xg_GtkCalendar__symbol, xg_GtkReliefStyle_symbol, xg_GtkButton__symbol, xg_GtkPackType_symbol, xg_GtkBox__symbol, xg_GtkBin__symbol, xg_GtkBindingSet__symbol, xg_GtkButtonBox__symbol, xg_GtkButtonBoxStyle_symbol, xg_GtkAspectFrame__symbol, xg_GtkAdjustment__symbol, xg_GtkAccelMapForeach_symbol, xg_GtkAccelLabel__symbol, xg_GtkAccelGroupEntry__symbol, xg_lambda3_symbol, xg_GSList__symbol, xg_GObject__symbol, xg_GtkAccelFlags_symbol, xg_GtkAccelGroup__symbol, xg_GTimeVal__symbol, xg_GdkPixbufAnimationIter__symbol, xg_GdkPixbufAnimation__symbol, xg_GdkInterpType_symbol, xg_double_symbol, xg_gfloat_symbol, xg_guchar_symbol, xg_char___symbol, xg_GdkPixbufDestroyNotify_symbol, xg_GError__symbol, xg_int_symbol, xg_GdkColorspace_symbol, xg_GdkWindowTypeHint_symbol, xg_GdkWindowHints_symbol, xg_GdkGeometry__symbol, xg_GdkWindowEdge_symbol, xg_GdkWMFunction_symbol, xg_GdkWMDecoration_symbol, xg_GdkEventMask_symbol, xg_GdkWindowState_symbol, xg_GdkFilterFunc_symbol, xg_GdkWindowType_symbol, xg_GdkPropMode_symbol, xg_guchar__symbol, xg_PangoContext__symbol, xg_PangoDirection_symbol, xg_GdkKeymapKey__symbol, xg_GdkKeymap__symbol, xg_GdkRectangle__symbol, xg_char__symbol, xg_gchar___symbol, xg_GdkEventFunc_symbol, xg_gdouble_symbol, xg_GList__symbol, xg_guint32_symbol, xg_GdkDragAction_symbol, xg_GdkDragContext__symbol, xg_GdkCursorType_symbol, xg_GdkDisplay__symbol, xg_GdkCursor__symbol, xg_GSignalMatchType_symbol, xg_GConnectFlags_symbol, xg_GtkDestroyNotify_symbol, xg_GSignalEmissionHook_symbol, xg_gulong_symbol, xg_GSignalInvocationHint__symbol, xg_GQuark_symbol, xg_guint__symbol, xg_GSignalQuery__symbol, xg_GType__symbol, xg_GSignalCMarshaller_symbol, xg_gpointer_symbol, xg_GSignalAccumulator_symbol, xg_GSignalFlags_symbol, xg_GType_symbol, xg_GClosureNotify_symbol, xg_GCallback_symbol, xg_GNormalizeMode_symbol, xg_glong_symbol, xg_gssize_symbol, xg_gunichar__symbol, xg_void_symbol, xg_GtkDrawingArea__symbol, xg_GdkSeat__symbol, xg_GtkRecentInfo__symbol, xg_gsize_symbol, xg_guint8__symbol, xg_GdkAtom_symbol, xg_GLogLevelFlags_symbol, xg_GdkPixbuf__symbol, xg_GtkIconView__symbol, xg_GtkEntryCompletion__symbol, xg_GtkFileFilterInfo__symbol, xg_GtkTreeSelection__symbol, xg_GtkCellRenderer__symbol, xg_GtkTreeViewColumn__symbol, xg_GtkTreeView__symbol, xg_gunichar_symbol, xg_gint_symbol, xg_GdkAtom__symbol, xg_GtkSelectionData__symbol, xg_GtkClipboard__symbol, xg_GtkTreeIter__symbol, xg_GtkTreePath__symbol, xg_GtkTreeModel__symbol, xg_gboolean_symbol, xg_GdkModifierType_symbol, xg_guint_symbol, xg_gchar__symbol, xg_GtkTextTag__symbol, xg_GdkXEvent__symbol, xg_GtkWidget__symbol, xg_lambda_data_symbol, xg_GClosure__symbol, xg_GtkAccelKey__symbol, xg_GdkEventMotion__symbol, xg_gdouble__symbol, xg_GdkEventAny__symbol, xg_GdkEvent__symbol, xg_GdkWindow__symbol, xg_cairo_t__symbol, xg_cairo_font_options_t__symbol, xg_PangoFontDescription__symbol, xg_idler_symbol, xg_GtkCellRendererPixbuf__symbol, xg_GtkSeparator__symbol, xg_GtkSeparatorMenuItem__symbol, xg_GdkEventExpose__symbol, xg_GdkEventNoExpose__symbol, xg_GdkEventVisibility__symbol, xg_GdkEventButton__symbol, xg_GdkEventCrossing__symbol, xg_GdkEventFocus__symbol, xg_GdkEventConfigure__symbol, xg_GdkEventProperty__symbol, xg_GdkEventSelection__symbol, xg_GdkEventProximity__symbol, xg_GdkEventSetting__symbol, xg_GdkEventWindowState__symbol, xg_GdkEventDND__symbol, xg_GtkFileChooserDialog__symbol, xg_GtkFileChooserWidget__symbol, xg_GtkColorButton__symbol, xg_GtkAccelMap_symbol, xg_GtkCellRendererCombo__symbol, xg_GtkCellRendererProgress__symbol, xg_GtkCellRendererAccel__symbol, xg_GtkCellRendererSpin__symbol, xg_GtkRecentChooserDialog__symbol, xg_GtkRecentChooserWidget__symbol, xg_GtkCellRendererSpinner__symbol, xg_gboolean__symbol, xg_GtkFontChooserDialog__symbol, xg_GtkFontChooserWidget__symbol, xg_GtkColorChooserDialog__symbol, xg_GtkColorChooserWidget__symbol, xg_GtkColorWidget__symbol, xg_GtkGestureLongPress__symbol;
#define wrap_for_Xen(Name, Value) Xen_list_2(xg_ ## Name ## _symbol, Xen_wrap_C_pointer(Value))
#define is_wrapped(Name, Value) (Xen_is_pair(Value) && (Xen_car(Value) == xg_ ## Name ## _symbol))
@@ -619,7 +621,6 @@ Xm_type_Ptr(GtkTreeStore_, GtkTreeStore*)
#define Xen_to_C_GtkTreeViewDropPosition(Arg) (GtkTreeViewDropPosition)(Xen_integer_to_C_int(Arg))
#define Xen_is_GtkTreeViewDropPosition(Arg) Xen_is_integer(Arg)
Xm_type_Ptr_1(GtkViewport_, GtkViewport*)
-Xm_type_Ptr_1(GtkAllocation_, GtkAllocation*)
#define Xen_to_C_GtkDirectionType(Arg) (GtkDirectionType)(Xen_integer_to_C_int(Arg))
#define Xen_is_GtkDirectionType(Arg) Xen_is_integer(Arg)
Xm_type_Ptr_2(AtkObject_, AtkObject*)
@@ -696,7 +697,6 @@ Xm_type_Ptr(GdkScreen_, GdkScreen*)
#define C_to_Xen_GtkCalendarDisplayOptions(Arg) C_int_to_Xen_integer(Arg)
#define Xen_to_C_GtkCalendarDisplayOptions(Arg) (GtkCalendarDisplayOptions)(Xen_integer_to_C_int(Arg))
#define Xen_is_GtkCalendarDisplayOptions(Arg) Xen_is_integer(Arg)
-Xm_type_Ptr_1(GtkEventBox_, GtkEventBox*)
Xm_type_Ptr(GtkToolItem_, GtkToolItem*)
#define C_to_Xen_GtkFileChooserAction(Arg) C_int_to_Xen_integer(Arg)
#define Xen_to_C_GtkFileChooserAction(Arg) (GtkFileChooserAction)(Xen_integer_to_C_int(Arg))
@@ -926,6 +926,7 @@ Xm_type_Ptr_1(GtkPopover_, GtkPopover*)
#endif
#if GTK_CHECK_VERSION(3, 14, 0)
+Xm_type_Ptr_1(GtkAllocation_, GtkAllocation*)
Xm_type_Ptr(GtkGesture_, GtkGesture*)
#define C_to_Xen_GtkEventSequenceState(Arg) C_int_to_Xen_integer(Arg)
#define Xen_to_C_GtkEventSequenceState(Arg) (GtkEventSequenceState)(Xen_integer_to_C_int(Arg))
@@ -988,6 +989,8 @@ Xm_type(GtkDrawingAreaDrawFunc, GtkDrawingAreaDrawFunc)
Xm_type_Ptr(GdkDrawContext_, GdkDrawContext*)
Xm_type_Ptr(GtkCheckButton_, GtkCheckButton*)
Xm_type_Ptr(GtkCenterBox_, GtkCenterBox*)
+Xm_type_Ptr(GtkScrollbar_, GtkScrollbar*)
+Xm_type_Ptr_1(GdkEventScroll_, GdkEventScroll*)
#endif
Xm_type_Ptr(cairo_surface_t_, cairo_surface_t*)
@@ -1502,6 +1505,17 @@ static gboolean gxg_func4(GtkPrintOperation *op, GtkPrintContext *context, gint
__func__)));
}
+#if (!GTK_CHECK_VERSION(3, 90, 0))
+static Xen gxg_gtk_widget_set_events(Xen widget, Xen events)
+{
+ #define H_gtk_widget_set_events "void gtk_widget_set_events(GtkWidget* widget, gint events)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_events", "GtkWidget*");
+ Xen_check_type(Xen_is_gint(events), events, 2, "gtk_widget_set_events", "gint");
+ gtk_widget_set_events(Xen_to_C_GtkWidget_(widget), Xen_to_C_gint(events));
+ return(Xen_false);
+}
+#endif
+
/* ---------------------------------------- functions ---------------------------------------- */
@@ -5319,12 +5333,6 @@ gint* [y])"
return(Xen_list_2(C_to_Xen_gint(ref_x), C_to_Xen_gint(ref_y)));
}
-static Xen gxg_gtk_event_box_new(void)
-{
- #define H_gtk_event_box_new "GtkWidget* gtk_event_box_new( void)"
- return(C_to_Xen_GtkWidget_(gtk_event_box_new()));
-}
-
static Xen gxg_gtk_fixed_new(void)
{
#define H_gtk_fixed_new "GtkWidget* gtk_fixed_new( void)"
@@ -11927,15 +11935,6 @@ static Xen gxg_gtk_widget_queue_resize(Xen widget)
return(Xen_false);
}
-static Xen gxg_gtk_widget_size_allocate(Xen widget, Xen allocation)
-{
- #define H_gtk_widget_size_allocate "void gtk_widget_size_allocate(GtkWidget* widget, GtkAllocation* allocation)"
- Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_size_allocate", "GtkWidget*");
- Xen_check_type(Xen_is_GtkAllocation_(allocation), allocation, 2, "gtk_widget_size_allocate", "GtkAllocation*");
- gtk_widget_size_allocate(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkAllocation_(allocation));
- return(Xen_false);
-}
-
static Xen gxg_gtk_widget_add_accelerator(Xen widget, Xen accel_signal, Xen accel_group, Xen accel_key, Xen accel_mods, Xen accel_flags)
{
#define H_gtk_widget_add_accelerator "void gtk_widget_add_accelerator(GtkWidget* widget, gchar* accel_signal, \
@@ -14953,40 +14952,6 @@ static Xen gxg_gtk_entry_get_completion(Xen entry)
return(C_to_Xen_GtkEntryCompletion_(gtk_entry_get_completion(Xen_to_C_GtkEntry_(entry))));
}
-static Xen gxg_gtk_event_box_get_visible_window(Xen event_box)
-{
- #define H_gtk_event_box_get_visible_window "gboolean gtk_event_box_get_visible_window(GtkEventBox* event_box)"
- Xen_check_type(Xen_is_GtkEventBox_(event_box), event_box, 1, "gtk_event_box_get_visible_window", "GtkEventBox*");
- return(C_to_Xen_gboolean(gtk_event_box_get_visible_window(Xen_to_C_GtkEventBox_(event_box))));
-}
-
-static Xen gxg_gtk_event_box_set_visible_window(Xen event_box, Xen visible_window)
-{
- #define H_gtk_event_box_set_visible_window "void gtk_event_box_set_visible_window(GtkEventBox* event_box, \
-gboolean visible_window)"
- Xen_check_type(Xen_is_GtkEventBox_(event_box), event_box, 1, "gtk_event_box_set_visible_window", "GtkEventBox*");
- Xen_check_type(Xen_is_gboolean(visible_window), visible_window, 2, "gtk_event_box_set_visible_window", "gboolean");
- gtk_event_box_set_visible_window(Xen_to_C_GtkEventBox_(event_box), Xen_to_C_gboolean(visible_window));
- return(Xen_false);
-}
-
-static Xen gxg_gtk_event_box_get_above_child(Xen event_box)
-{
- #define H_gtk_event_box_get_above_child "gboolean gtk_event_box_get_above_child(GtkEventBox* event_box)"
- Xen_check_type(Xen_is_GtkEventBox_(event_box), event_box, 1, "gtk_event_box_get_above_child", "GtkEventBox*");
- return(C_to_Xen_gboolean(gtk_event_box_get_above_child(Xen_to_C_GtkEventBox_(event_box))));
-}
-
-static Xen gxg_gtk_event_box_set_above_child(Xen event_box, Xen above_child)
-{
- #define H_gtk_event_box_set_above_child "void gtk_event_box_set_above_child(GtkEventBox* event_box, \
-gboolean above_child)"
- Xen_check_type(Xen_is_GtkEventBox_(event_box), event_box, 1, "gtk_event_box_set_above_child", "GtkEventBox*");
- Xen_check_type(Xen_is_gboolean(above_child), above_child, 2, "gtk_event_box_set_above_child", "gboolean");
- gtk_event_box_set_above_child(Xen_to_C_GtkEventBox_(event_box), Xen_to_C_gboolean(above_child));
- return(Xen_false);
-}
-
static Xen gxg_gtk_menu_attach(Xen menu, Xen child, Xen left_attach, Xen right_attach, Xen top_attach, Xen bottom_attach)
{
#define H_gtk_menu_attach "void gtk_menu_attach(GtkMenu* menu, GtkWidget* child, guint left_attach, \
@@ -22208,20 +22173,6 @@ static Xen gxg_gtk_tree_view_is_rubber_banding_active(Xen tree_view)
return(C_to_Xen_gboolean(gtk_tree_view_is_rubber_banding_active(Xen_to_C_GtkTreeView_(tree_view))));
}
-static Xen gxg_gtk_icon_view_convert_widget_to_bin_window_coords(Xen icon_view, Xen wx, Xen wy, Xen ignore_bx, Xen ignore_by)
-{
- #define H_gtk_icon_view_convert_widget_to_bin_window_coords "void gtk_icon_view_convert_widget_to_bin_window_coords(GtkIconView* icon_view, \
-gint wx, gint wy, gint* [bx], gint* [by])"
- gint ref_bx;
- gint ref_by;
- Xen_check_type(Xen_is_GtkIconView_(icon_view), icon_view, 1, "gtk_icon_view_convert_widget_to_bin_window_coords", "GtkIconView*");
- Xen_check_type(Xen_is_gint(wx), wx, 2, "gtk_icon_view_convert_widget_to_bin_window_coords", "gint");
- Xen_check_type(Xen_is_gint(wy), wy, 3, "gtk_icon_view_convert_widget_to_bin_window_coords", "gint");
- gtk_icon_view_convert_widget_to_bin_window_coords(Xen_to_C_GtkIconView_(icon_view), Xen_to_C_gint(wx), Xen_to_C_gint(wy),
- &ref_bx, &ref_by);
- return(Xen_list_2(C_to_Xen_gint(ref_bx), C_to_Xen_gint(ref_by)));
-}
-
static Xen gxg_gtk_icon_view_set_tooltip_item(Xen icon_view, Xen tooltip, Xen path)
{
#define H_gtk_icon_view_set_tooltip_item "void gtk_icon_view_set_tooltip_item(GtkIconView* icon_view, \
@@ -22495,13 +22446,6 @@ static Xen gxg_gtk_entry_get_text_length(Xen entry)
return(C_to_Xen_guint16(gtk_entry_get_text_length(Xen_to_C_GtkEntry_(entry))));
}
-static Xen gxg_gtk_layout_get_bin_window(Xen layout)
-{
- #define H_gtk_layout_get_bin_window "GdkWindow* gtk_layout_get_bin_window(GtkLayout* layout)"
- Xen_check_type(Xen_is_GtkLayout_(layout), layout, 1, "gtk_layout_get_bin_window", "GtkLayout*");
- return(C_to_Xen_GdkWindow_(gtk_layout_get_bin_window(Xen_to_C_GtkLayout_(layout))));
-}
-
static Xen gxg_gtk_menu_get_accel_path(Xen menu)
{
#define H_gtk_menu_get_accel_path "gchar* gtk_menu_get_accel_path(GtkMenu* menu)"
@@ -24185,13 +24129,6 @@ gint* [slider_end])"
return(Xen_list_2(C_to_Xen_gint(ref_slider_start), C_to_Xen_gint(ref_slider_end)));
}
-static Xen gxg_gtk_paned_get_handle_window(Xen paned)
-{
- #define H_gtk_paned_get_handle_window "GdkWindow* gtk_paned_get_handle_window(GtkPaned* paned)"
- Xen_check_type(Xen_is_GtkPaned_(paned), paned, 1, "gtk_paned_get_handle_window", "GtkPaned*");
- return(C_to_Xen_GdkWindow_(gtk_paned_get_handle_window(Xen_to_C_GtkPaned_(paned))));
-}
-
static Xen gxg_gtk_widget_set_realized(Xen widget, Xen realized)
{
#define H_gtk_widget_set_realized "void gtk_widget_set_realized(GtkWidget* widget, gboolean realized)"
@@ -27719,17 +27656,6 @@ static Xen gxg_gtk_grid_get_baseline_row(Xen grid)
return(C_to_Xen_gint(gtk_grid_get_baseline_row(Xen_to_C_GtkGrid_(grid))));
}
-static Xen gxg_gtk_widget_size_allocate_with_baseline(Xen widget, Xen allocation, Xen baseline)
-{
- #define H_gtk_widget_size_allocate_with_baseline "void gtk_widget_size_allocate_with_baseline(GtkWidget* widget, \
-GtkAllocation* allocation, gint baseline)"
- Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_size_allocate_with_baseline", "GtkWidget*");
- Xen_check_type(Xen_is_GtkAllocation_(allocation), allocation, 2, "gtk_widget_size_allocate_with_baseline", "GtkAllocation*");
- Xen_check_type(Xen_is_gint(baseline), baseline, 3, "gtk_widget_size_allocate_with_baseline", "gint");
- gtk_widget_size_allocate_with_baseline(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkAllocation_(allocation), Xen_to_C_gint(baseline));
- return(Xen_false);
-}
-
static Xen gxg_gtk_widget_get_allocated_baseline(Xen widget)
{
#define H_gtk_widget_get_allocated_baseline "int gtk_widget_get_allocated_baseline(GtkWidget* widget)"
@@ -29309,15 +29235,6 @@ static Xen gxg_gdk_window_show_window_menu(Xen window, Xen event)
return(C_to_Xen_gboolean(gdk_window_show_window_menu(Xen_to_C_GdkWindow_(window), Xen_to_C_GdkEvent_(event))));
}
-static Xen gxg_gtk_widget_set_clip(Xen widget, Xen clip)
-{
- #define H_gtk_widget_set_clip "void gtk_widget_set_clip(GtkWidget* widget, GtkAllocation* clip)"
- Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_set_clip", "GtkWidget*");
- Xen_check_type(Xen_is_GtkAllocation_(clip), clip, 2, "gtk_widget_set_clip", "GtkAllocation*");
- gtk_widget_set_clip(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkAllocation_(clip));
- return(Xen_false);
-}
-
static Xen gxg_gtk_widget_get_clip(Xen widget, Xen clip)
{
#define H_gtk_widget_get_clip "void gtk_widget_get_clip(GtkWidget* widget, GtkAllocation* clip)"
@@ -32130,6 +32047,125 @@ static Xen gxg_gtk_get_event_target(Xen event)
return(C_to_Xen_GtkWidget_(gtk_get_event_target(Xen_to_C_GdkEvent_(event))));
}
+static Xen gxg_gtk_accel_label_set_label(Xen accel_label, Xen text)
+{
+ #define H_gtk_accel_label_set_label "void gtk_accel_label_set_label(GtkAccelLabel* accel_label, char* text)"
+ Xen_check_type(Xen_is_GtkAccelLabel_(accel_label), accel_label, 1, "gtk_accel_label_set_label", "GtkAccelLabel*");
+ Xen_check_type(Xen_is_char_(text), text, 2, "gtk_accel_label_set_label", "char*");
+ gtk_accel_label_set_label(Xen_to_C_GtkAccelLabel_(accel_label), (const char*)Xen_to_C_char_(text));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_accel_label_get_label(Xen accel_label)
+{
+ #define H_gtk_accel_label_get_label "char* gtk_accel_label_get_label(GtkAccelLabel* accel_label)"
+ Xen_check_type(Xen_is_GtkAccelLabel_(accel_label), accel_label, 1, "gtk_accel_label_get_label", "GtkAccelLabel*");
+ return(C_to_Xen_char_((char*)gtk_accel_label_get_label(Xen_to_C_GtkAccelLabel_(accel_label))));
+}
+
+static Xen gxg_gtk_accel_label_set_use_underline(Xen accel_label, Xen setting)
+{
+ #define H_gtk_accel_label_set_use_underline "void gtk_accel_label_set_use_underline(GtkAccelLabel* accel_label, \
+gboolean setting)"
+ Xen_check_type(Xen_is_GtkAccelLabel_(accel_label), accel_label, 1, "gtk_accel_label_set_use_underline", "GtkAccelLabel*");
+ Xen_check_type(Xen_is_gboolean(setting), setting, 2, "gtk_accel_label_set_use_underline", "gboolean");
+ gtk_accel_label_set_use_underline(Xen_to_C_GtkAccelLabel_(accel_label), Xen_to_C_gboolean(setting));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_accel_label_get_use_underline(Xen accel_label)
+{
+ #define H_gtk_accel_label_get_use_underline "gboolean gtk_accel_label_get_use_underline(GtkAccelLabel* accel_label)"
+ Xen_check_type(Xen_is_GtkAccelLabel_(accel_label), accel_label, 1, "gtk_accel_label_get_use_underline", "GtkAccelLabel*");
+ return(C_to_Xen_gboolean(gtk_accel_label_get_use_underline(Xen_to_C_GtkAccelLabel_(accel_label))));
+}
+
+static Xen gxg_gtk_scrollbar_set_adjustment(Xen self, Xen adjustment)
+{
+ #define H_gtk_scrollbar_set_adjustment "void gtk_scrollbar_set_adjustment(GtkScrollbar* self, GtkAdjustment* adjustment)"
+ Xen_check_type(Xen_is_GtkScrollbar_(self), self, 1, "gtk_scrollbar_set_adjustment", "GtkScrollbar*");
+ Xen_check_type(Xen_is_GtkAdjustment_(adjustment), adjustment, 2, "gtk_scrollbar_set_adjustment", "GtkAdjustment*");
+ gtk_scrollbar_set_adjustment(Xen_to_C_GtkScrollbar_(self), Xen_to_C_GtkAdjustment_(adjustment));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_scrollbar_get_adjustment(Xen self)
+{
+ #define H_gtk_scrollbar_get_adjustment "GtkAdjustment* gtk_scrollbar_get_adjustment(GtkScrollbar* self)"
+ Xen_check_type(Xen_is_GtkScrollbar_(self), self, 1, "gtk_scrollbar_get_adjustment", "GtkScrollbar*");
+ return(C_to_Xen_GtkAdjustment_(gtk_scrollbar_get_adjustment(Xen_to_C_GtkScrollbar_(self))));
+}
+
+static Xen gxg_gtk_scrollbar_get_wheel_delta(Xen self, Xen event)
+{
+ #define H_gtk_scrollbar_get_wheel_delta "double gtk_scrollbar_get_wheel_delta(GtkScrollbar* self, GdkEventScroll* event)"
+ Xen_check_type(Xen_is_GtkScrollbar_(self), self, 1, "gtk_scrollbar_get_wheel_delta", "GtkScrollbar*");
+ Xen_check_type(Xen_is_GdkEventScroll_(event), event, 2, "gtk_scrollbar_get_wheel_delta", "GdkEventScroll*");
+ return(C_to_Xen_double(gtk_scrollbar_get_wheel_delta(Xen_to_C_GtkScrollbar_(self), Xen_to_C_GdkEventScroll_(event))));
+}
+
+static Xen gxg_gtk_spin_button_get_text(Xen spin_button)
+{
+ #define H_gtk_spin_button_get_text "char* gtk_spin_button_get_text(GtkSpinButton* spin_button)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_get_text", "GtkSpinButton*");
+ return(C_to_Xen_char_((char*)gtk_spin_button_get_text(Xen_to_C_GtkSpinButton_(spin_button))));
+}
+
+static Xen gxg_gtk_spin_button_set_text(Xen spin_button, Xen text)
+{
+ #define H_gtk_spin_button_set_text "void gtk_spin_button_set_text(GtkSpinButton* spin_button, char* text)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_set_text", "GtkSpinButton*");
+ Xen_check_type(Xen_is_char_(text), text, 2, "gtk_spin_button_set_text", "char*");
+ gtk_spin_button_set_text(Xen_to_C_GtkSpinButton_(spin_button), (const char*)Xen_to_C_char_(text));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_spin_button_get_max_width_chars(Xen spin_button)
+{
+ #define H_gtk_spin_button_get_max_width_chars "int gtk_spin_button_get_max_width_chars(GtkSpinButton* spin_button)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_get_max_width_chars", "GtkSpinButton*");
+ return(C_to_Xen_int(gtk_spin_button_get_max_width_chars(Xen_to_C_GtkSpinButton_(spin_button))));
+}
+
+static Xen gxg_gtk_spin_button_set_max_width_chars(Xen spin_button, Xen max_width_chars)
+{
+ #define H_gtk_spin_button_set_max_width_chars "void gtk_spin_button_set_max_width_chars(GtkSpinButton* spin_button, \
+int max_width_chars)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_set_max_width_chars", "GtkSpinButton*");
+ Xen_check_type(Xen_is_int(max_width_chars), max_width_chars, 2, "gtk_spin_button_set_max_width_chars", "int");
+ gtk_spin_button_set_max_width_chars(Xen_to_C_GtkSpinButton_(spin_button), Xen_to_C_int(max_width_chars));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_spin_button_get_width_chars(Xen spin_button)
+{
+ #define H_gtk_spin_button_get_width_chars "int gtk_spin_button_get_width_chars(GtkSpinButton* spin_button)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_get_width_chars", "GtkSpinButton*");
+ return(C_to_Xen_int(gtk_spin_button_get_width_chars(Xen_to_C_GtkSpinButton_(spin_button))));
+}
+
+static Xen gxg_gtk_spin_button_set_width_chars(Xen spin_button, Xen width_chars;)
+{
+ #define H_gtk_spin_button_set_width_chars "void gtk_spin_button_set_width_chars(GtkSpinButton* spin_button, \
+int width_chars;)"
+ Xen_check_type(Xen_is_GtkSpinButton_(spin_button), spin_button, 1, "gtk_spin_button_set_width_chars", "GtkSpinButton*");
+ Xen_check_type(Xen_is_int(width_chars;), width_chars;, 2, "gtk_spin_button_set_width_chars", "int");
+ gtk_spin_button_set_width_chars(Xen_to_C_GtkSpinButton_(spin_button), Xen_to_C_int(width_chars;));
+ return(Xen_false);
+}
+
+static Xen gxg_gtk_widget_size_allocate(Xen widget, Xen allocation, Xen baseline, Xen out_clip)
+{
+ #define H_gtk_widget_size_allocate "void gtk_widget_size_allocate(GtkWidget* widget, GtkAllocation* allocation, \
+int baseline, GtkAllocation* out_clip)"
+ Xen_check_type(Xen_is_GtkWidget_(widget), widget, 1, "gtk_widget_size_allocate", "GtkWidget*");
+ Xen_check_type(Xen_is_GtkAllocation_(allocation), allocation, 2, "gtk_widget_size_allocate", "GtkAllocation*");
+ Xen_check_type(Xen_is_int(baseline), baseline, 3, "gtk_widget_size_allocate", "int");
+ Xen_check_type(Xen_is_GtkAllocation_(out_clip), out_clip, 4, "gtk_widget_size_allocate", "GtkAllocation*");
+ gtk_widget_size_allocate(Xen_to_C_GtkWidget_(widget), Xen_to_C_GtkAllocation_(allocation), Xen_to_C_int(baseline), Xen_to_C_GtkAllocation_(out_clip));
+ return(Xen_false);
+}
+
#endif
static Xen gxg_cairo_create(Xen target)
@@ -34584,7 +34620,6 @@ static Xen gxg_GTK_DIALOG(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_li
static Xen gxg_GTK_DRAWING_AREA(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkDrawingArea__symbol, Xen_cadr(obj)) : Xen_false);}
static Xen gxg_GTK_EDITABLE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkEditable__symbol, Xen_cadr(obj)) : Xen_false);}
static Xen gxg_GTK_ENTRY(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkEntry__symbol, Xen_cadr(obj)) : Xen_false);}
-static Xen gxg_GTK_EVENT_BOX(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkEventBox__symbol, Xen_cadr(obj)) : Xen_false);}
static Xen gxg_GTK_FIXED(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkFixed__symbol, Xen_cadr(obj)) : Xen_false);}
static Xen gxg_GTK_FRAME(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkFrame__symbol, Xen_cadr(obj)) : Xen_false);}
static Xen gxg_GTK_IMAGE(Xen obj) {return((Xen_is_wrapped_object(obj)) ? Xen_list_2(xg_GtkImage__symbol, Xen_cadr(obj)) : Xen_false);}
@@ -34826,7 +34861,6 @@ static Xen gxg_GTK_IS_DIALOG(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapp
static Xen gxg_GTK_IS_DRAWING_AREA(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_DRAWING_AREA((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
static Xen gxg_GTK_IS_EDITABLE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_EDITABLE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
static Xen gxg_GTK_IS_ENTRY(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_ENTRY((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
-static Xen gxg_GTK_IS_EVENT_BOX(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_EVENT_BOX((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
static Xen gxg_GTK_IS_FIXED(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_FIXED((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
static Xen gxg_GTK_IS_FRAME(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_FRAME((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
static Xen gxg_GTK_IS_IMAGE(Xen obj) {return(C_bool_to_Xen_boolean(Xen_is_wrapped_object(obj) && GTK_IS_IMAGE((GTypeInstance *)Xen_unwrap_C_pointer(Xen_cadr(obj)))));}
@@ -35890,7 +35924,6 @@ Xen_wrap_2_args(gxg_gtk_entry_set_text_w, gxg_gtk_entry_set_text)
Xen_wrap_1_arg(gxg_gtk_entry_get_text_w, gxg_gtk_entry_get_text)
Xen_wrap_1_arg(gxg_gtk_entry_get_layout_w, gxg_gtk_entry_get_layout)
Xen_wrap_3_optional_args(gxg_gtk_entry_get_layout_offsets_w, gxg_gtk_entry_get_layout_offsets)
-Xen_wrap_no_args(gxg_gtk_event_box_new_w, gxg_gtk_event_box_new)
Xen_wrap_no_args(gxg_gtk_fixed_new_w, gxg_gtk_fixed_new)
Xen_wrap_4_args(gxg_gtk_fixed_put_w, gxg_gtk_fixed_put)
Xen_wrap_4_args(gxg_gtk_fixed_move_w, gxg_gtk_fixed_move)
@@ -36584,7 +36617,6 @@ Xen_wrap_1_arg(gxg_gtk_widget_unrealize_w, gxg_gtk_widget_unrealize)
Xen_wrap_1_arg(gxg_gtk_widget_queue_draw_w, gxg_gtk_widget_queue_draw)
Xen_wrap_5_args(gxg_gtk_widget_queue_draw_area_w, gxg_gtk_widget_queue_draw_area)
Xen_wrap_1_arg(gxg_gtk_widget_queue_resize_w, gxg_gtk_widget_queue_resize)
-Xen_wrap_2_args(gxg_gtk_widget_size_allocate_w, gxg_gtk_widget_size_allocate)
Xen_wrap_6_args(gxg_gtk_widget_add_accelerator_w, gxg_gtk_widget_add_accelerator)
Xen_wrap_4_args(gxg_gtk_widget_remove_accelerator_w, gxg_gtk_widget_remove_accelerator)
Xen_wrap_1_arg(gxg_gtk_widget_list_accel_closures_w, gxg_gtk_widget_list_accel_closures)
@@ -36928,10 +36960,6 @@ Xen_wrap_2_args(gxg_gtk_check_menu_item_set_draw_as_radio_w, gxg_gtk_check_menu_
Xen_wrap_1_arg(gxg_gtk_check_menu_item_get_draw_as_radio_w, gxg_gtk_check_menu_item_get_draw_as_radio)
Xen_wrap_2_args(gxg_gtk_entry_set_completion_w, gxg_gtk_entry_set_completion)
Xen_wrap_1_arg(gxg_gtk_entry_get_completion_w, gxg_gtk_entry_get_completion)
-Xen_wrap_1_arg(gxg_gtk_event_box_get_visible_window_w, gxg_gtk_event_box_get_visible_window)
-Xen_wrap_2_args(gxg_gtk_event_box_set_visible_window_w, gxg_gtk_event_box_set_visible_window)
-Xen_wrap_1_arg(gxg_gtk_event_box_get_above_child_w, gxg_gtk_event_box_get_above_child)
-Xen_wrap_2_args(gxg_gtk_event_box_set_above_child_w, gxg_gtk_event_box_set_above_child)
Xen_wrap_6_args(gxg_gtk_menu_attach_w, gxg_gtk_menu_attach)
Xen_wrap_3_args(gxg_gtk_text_buffer_select_range_w, gxg_gtk_text_buffer_select_range)
Xen_wrap_2_args(gxg_gtk_text_view_set_overwrite_w, gxg_gtk_text_view_set_overwrite)
@@ -37716,7 +37744,6 @@ Xen_wrap_1_arg(gxg_gtk_widget_get_tooltip_text_w, gxg_gtk_widget_get_tooltip_tex
Xen_wrap_2_args(gxg_gtk_widget_set_tooltip_markup_w, gxg_gtk_widget_set_tooltip_markup)
Xen_wrap_1_arg(gxg_gtk_widget_get_tooltip_markup_w, gxg_gtk_widget_get_tooltip_markup)
Xen_wrap_1_arg(gxg_gtk_tree_view_is_rubber_banding_active_w, gxg_gtk_tree_view_is_rubber_banding_active)
-Xen_wrap_5_optional_args(gxg_gtk_icon_view_convert_widget_to_bin_window_coords_w, gxg_gtk_icon_view_convert_widget_to_bin_window_coords)
Xen_wrap_3_args(gxg_gtk_icon_view_set_tooltip_item_w, gxg_gtk_icon_view_set_tooltip_item)
Xen_wrap_4_args(gxg_gtk_icon_view_set_tooltip_cell_w, gxg_gtk_icon_view_set_tooltip_cell)
Xen_wrap_7_optional_args(gxg_gtk_icon_view_get_tooltip_context_w, gxg_gtk_icon_view_get_tooltip_context)
@@ -37745,7 +37772,6 @@ Xen_wrap_1_arg(gxg_gtk_dialog_get_content_area_w, gxg_gtk_dialog_get_content_are
Xen_wrap_2_args(gxg_gtk_entry_set_overwrite_mode_w, gxg_gtk_entry_set_overwrite_mode)
Xen_wrap_1_arg(gxg_gtk_entry_get_overwrite_mode_w, gxg_gtk_entry_get_overwrite_mode)
Xen_wrap_1_arg(gxg_gtk_entry_get_text_length_w, gxg_gtk_entry_get_text_length)
-Xen_wrap_1_arg(gxg_gtk_layout_get_bin_window_w, gxg_gtk_layout_get_bin_window)
Xen_wrap_1_arg(gxg_gtk_menu_get_accel_path_w, gxg_gtk_menu_get_accel_path)
Xen_wrap_1_arg(gxg_gtk_menu_get_monitor_w, gxg_gtk_menu_get_monitor)
Xen_wrap_1_arg(gxg_gtk_menu_item_get_accel_path_w, gxg_gtk_menu_item_get_accel_path)
@@ -37946,7 +37972,6 @@ Xen_wrap_2_args(gxg_gtk_range_set_slider_size_fixed_w, gxg_gtk_range_set_slider_
Xen_wrap_1_arg(gxg_gtk_range_get_slider_size_fixed_w, gxg_gtk_range_get_slider_size_fixed)
Xen_wrap_2_args(gxg_gtk_range_get_range_rect_w, gxg_gtk_range_get_range_rect)
Xen_wrap_3_optional_args(gxg_gtk_range_get_slider_range_w, gxg_gtk_range_get_slider_range)
-Xen_wrap_1_arg(gxg_gtk_paned_get_handle_window_w, gxg_gtk_paned_get_handle_window)
Xen_wrap_2_args(gxg_gtk_widget_set_realized_w, gxg_gtk_widget_set_realized)
Xen_wrap_1_arg(gxg_gtk_widget_get_realized_w, gxg_gtk_widget_get_realized)
Xen_wrap_1_arg(gxg_gtk_widget_get_mapped_w, gxg_gtk_widget_get_mapped)
@@ -38364,7 +38389,6 @@ Xen_wrap_3_args(gxg_gtk_grid_set_row_baseline_position_w, gxg_gtk_grid_set_row_b
Xen_wrap_2_args(gxg_gtk_grid_get_row_baseline_position_w, gxg_gtk_grid_get_row_baseline_position)
Xen_wrap_2_args(gxg_gtk_grid_set_baseline_row_w, gxg_gtk_grid_set_baseline_row)
Xen_wrap_1_arg(gxg_gtk_grid_get_baseline_row_w, gxg_gtk_grid_get_baseline_row)
-Xen_wrap_3_args(gxg_gtk_widget_size_allocate_with_baseline_w, gxg_gtk_widget_size_allocate_with_baseline)
Xen_wrap_1_arg(gxg_gtk_widget_get_allocated_baseline_w, gxg_gtk_widget_get_allocated_baseline)
Xen_wrap_1_arg(gxg_gtk_widget_init_template_w, gxg_gtk_widget_init_template)
Xen_wrap_2_args(gxg_gtk_window_set_titlebar_w, gxg_gtk_window_set_titlebar)
@@ -38554,7 +38578,6 @@ Xen_wrap_2_args(gxg_gtk_places_sidebar_set_show_enter_location_w, gxg_gtk_places
Xen_wrap_2_args(gxg_gtk_switch_set_state_w, gxg_gtk_switch_set_state)
Xen_wrap_1_arg(gxg_gtk_switch_get_state_w, gxg_gtk_switch_get_state)
Xen_wrap_2_args(gxg_gdk_window_show_window_menu_w, gxg_gdk_window_show_window_menu)
-Xen_wrap_2_args(gxg_gtk_widget_set_clip_w, gxg_gtk_widget_set_clip)
Xen_wrap_2_args(gxg_gtk_widget_get_clip_w, gxg_gtk_widget_get_clip)
Xen_wrap_1_arg(gxg_gtk_gesture_get_device_w, gxg_gtk_gesture_get_device)
Xen_wrap_2_args(gxg_gtk_gesture_set_state_w, gxg_gtk_gesture_set_state)
@@ -38879,6 +38902,20 @@ Xen_wrap_2_args(gxg_gdk_event_set_user_data_w, gxg_gdk_event_set_user_data)
Xen_wrap_1_arg(gxg_gdk_event_get_user_data_w, gxg_gdk_event_get_user_data)
Xen_wrap_3_args(gxg_gdk_rectangle_contains_point_w, gxg_gdk_rectangle_contains_point)
Xen_wrap_1_arg(gxg_gtk_get_event_target_w, gxg_gtk_get_event_target)
+Xen_wrap_2_args(gxg_gtk_accel_label_set_label_w, gxg_gtk_accel_label_set_label)
+Xen_wrap_1_arg(gxg_gtk_accel_label_get_label_w, gxg_gtk_accel_label_get_label)
+Xen_wrap_2_args(gxg_gtk_accel_label_set_use_underline_w, gxg_gtk_accel_label_set_use_underline)
+Xen_wrap_1_arg(gxg_gtk_accel_label_get_use_underline_w, gxg_gtk_accel_label_get_use_underline)
+Xen_wrap_2_args(gxg_gtk_scrollbar_set_adjustment_w, gxg_gtk_scrollbar_set_adjustment)
+Xen_wrap_1_arg(gxg_gtk_scrollbar_get_adjustment_w, gxg_gtk_scrollbar_get_adjustment)
+Xen_wrap_2_args(gxg_gtk_scrollbar_get_wheel_delta_w, gxg_gtk_scrollbar_get_wheel_delta)
+Xen_wrap_1_arg(gxg_gtk_spin_button_get_text_w, gxg_gtk_spin_button_get_text)
+Xen_wrap_2_args(gxg_gtk_spin_button_set_text_w, gxg_gtk_spin_button_set_text)
+Xen_wrap_1_arg(gxg_gtk_spin_button_get_max_width_chars_w, gxg_gtk_spin_button_get_max_width_chars)
+Xen_wrap_2_args(gxg_gtk_spin_button_set_max_width_chars_w, gxg_gtk_spin_button_set_max_width_chars)
+Xen_wrap_1_arg(gxg_gtk_spin_button_get_width_chars_w, gxg_gtk_spin_button_get_width_chars)
+Xen_wrap_2_args(gxg_gtk_spin_button_set_width_chars_w, gxg_gtk_spin_button_set_width_chars)
+Xen_wrap_4_args(gxg_gtk_widget_size_allocate_w, gxg_gtk_widget_size_allocate)
#endif
Xen_wrap_1_arg(gxg_cairo_create_w, gxg_cairo_create)
@@ -39160,6 +39197,7 @@ Xen_wrap_no_args(gxg_gtk_init_check_w, gxg_gtk_init_check)
#else
Xen_wrap_2_optional_args(gxg_gtk_init_w, gxg_gtk_init)
Xen_wrap_2_optional_args(gxg_gtk_init_check_w, gxg_gtk_init_check)
+Xen_wrap_2_args(gxg_gtk_widget_set_events_w, gxg_gtk_widget_set_events)
#endif
Xen_wrap_1_arg(gxg_GDK_DRAG_CONTEXT_w, gxg_GDK_DRAG_CONTEXT)
Xen_wrap_1_arg(gxg_GDK_DEVICE_w, gxg_GDK_DEVICE)
@@ -39190,7 +39228,6 @@ Xen_wrap_1_arg(gxg_GTK_DIALOG_w, gxg_GTK_DIALOG)
Xen_wrap_1_arg(gxg_GTK_DRAWING_AREA_w, gxg_GTK_DRAWING_AREA)
Xen_wrap_1_arg(gxg_GTK_EDITABLE_w, gxg_GTK_EDITABLE)
Xen_wrap_1_arg(gxg_GTK_ENTRY_w, gxg_GTK_ENTRY)
-Xen_wrap_1_arg(gxg_GTK_EVENT_BOX_w, gxg_GTK_EVENT_BOX)
Xen_wrap_1_arg(gxg_GTK_FIXED_w, gxg_GTK_FIXED)
Xen_wrap_1_arg(gxg_GTK_FRAME_w, gxg_GTK_FRAME)
Xen_wrap_1_arg(gxg_GTK_IMAGE_w, gxg_GTK_IMAGE)
@@ -39432,7 +39469,6 @@ Xen_wrap_1_arg(gxg_GTK_IS_DIALOG_w, gxg_GTK_IS_DIALOG)
Xen_wrap_1_arg(gxg_GTK_IS_DRAWING_AREA_w, gxg_GTK_IS_DRAWING_AREA)
Xen_wrap_1_arg(gxg_GTK_IS_EDITABLE_w, gxg_GTK_IS_EDITABLE)
Xen_wrap_1_arg(gxg_GTK_IS_ENTRY_w, gxg_GTK_IS_ENTRY)
-Xen_wrap_1_arg(gxg_GTK_IS_EVENT_BOX_w, gxg_GTK_IS_EVENT_BOX)
Xen_wrap_1_arg(gxg_GTK_IS_FIXED_w, gxg_GTK_IS_FIXED)
Xen_wrap_1_arg(gxg_GTK_IS_FRAME_w, gxg_GTK_IS_FRAME)
Xen_wrap_1_arg(gxg_GTK_IS_IMAGE_w, gxg_GTK_IS_IMAGE)
@@ -39630,7 +39666,7 @@ static void define_functions(void)
{
#if HAVE_SCHEME
s7_pointer s_boolean, s_integer, s_real, s_string, s_any, s_pair, s_float, s_gtk_enum_t, s_pair_false;
- s7_pointer pl_iur, pl_iugi, pl_iuisi, pl_iuuui, pl_iuuuui, pl_iuis, pl_iug, pl_pit, pl_piu, pl_ius, pl_iusi, pl_iu, pl_iuui, pl_pi, pl_iui, pl_iuisut, pl_t, pl_prrru, pl_tts, pl_tti, pl_dusr, pl_dusi, pl_dui, pl_du, pl_dus, pl_pr, pl_ssig, pl_ssi, pl_psgi, pl_suiig, pl_sug, pl_psiuub, pl_psgbiiiit, pl_psrrrb, pl_sui, pl_suuub, pl_psu, pl_psb, pl_su, pl_sus, pl_ps, pl_psg, pl_psi, pl_psugt, pl_psiu, pl_psiiuusu, pl_psut, pl_pur, pl_puuui, pl_pusiig, pl_pusiigu, pl_pusiiugu, pl_puuiig, pl_puur, pl_purru, pl_puiiui, pl_pugi, pl_puuig, pl_puttiiiu, pl_pubi, pl_puiig, pl_puiigi, pl_puigu, pl_puuusuug, pl_pusi, pl_pusiu, pl_putu, pl_puri, pl_pusub, pl_pust, pl_pub, pl_puuiu, pl_pugiiu, pl_pusu, pl_pu, pl_puuubu, pl_puiiu, pl_pugu, pl_puutuuiu, pl_puutu, pl_pui, pl_pussu, pl_puibu, pl_pus, pl_pug, pl_put, pl_pusigu, pl_pusig, pl_puui, pl_puiu, pl_pusiuiu, pl_pusiuibu, pl_pusiiu, pl_puuiiu, pl_b, pl_btiib, pl_bti, pl_bt, pl_tb, pl_g, pl_tg, pl_i, pl_tiu, pl_itiiub, pl_itsub, pl_itstttg, pl_itgiiut, pl_ti, pl_it, pl_s, pl_tsu, pl_tsb, pl_st, pl_tsig, pl_ts, pl_tsi, pl_tsiu, pl_tsiiuui, pl_tsiuui, pl_p, pl_tusiuiui, pl_tuuiu, pl_tussu, pl_tuuuggu, pl_tuuggu, pl_tugiis, pl_tubu, pl_tuurru, pl_tuurrrrgr, pl_tuurrrrg, pl_tuuur, pl_tusg, pl_tuuuui, pl_tugiiu, pl_tuusb, pl_tugui, pl_tuuugi, pl_tuuuub, pl_tuttti, pl_tuuttti, pl_tuisi, pl_tugb, pl_tugs, pl_tugug, pl_turgs, pl_tubi, pl_tuttigsi, pl_tuiiiiui, pl_tuurb, pl_tuuiiiirrrrg, pl_tuuiiiirrrrgi, pl_tuiggu, pl_turrrb, pl_tuubbig, pl_pt, pl_tuuti, pl_tubbi, pl_tuti, pl_tutti, pl_tutui, pl_tutisi, pl_tuuri, pl_tuusit, pl_tuurbr, pl_tuugi, pl_tuit, pl_tusr, pl_tusri, pl_tusi, pl_turi, pl_tuui, pl_tuur, pl_tuig, pl_tur, pl_tub, pl_tui, pl_tu, pl_tus, pl_tusb, pl_tut, pl_tuuut, pl_tug, pl_tutb, pl_tust, pl_tuub, pl_tuus, pl_tuug, pl_tuibu, pl_tuut, pl_tuuig, pl_tuguig, pl_tuubr, pl_tuuub, pl_tuuiuui, pl_tugu, pl_tuuir, pl_tugr, pl_tugi, pl_tuuui, pl_tuib, pl_tusu, pl_tuusi, pl_tugt, pl_tuis, pl_tubiiiu, pl_tuiu, pl_tusiis, pl_tuiiu, pl_tuuug, pl_tusuig, pl_tuuubr, pl_big, pl_bi, pl_bsu, pl_bsigb, pl_bur, pl_buug, pl_buigu, pl_buuti, pl_butib, pl_buiuig, pl_buuusuug, pl_buuit, pl_buti, pl_butti, pl_busi, pl_buusib, pl_busib, pl_buuuub, pl_buuub, pl_buttu, pl_busgu, pl_buurbr, pl_buui, pl_buus, pl_buuui, pl_bug, pl_bu, pl_bus, pl_busu, pl_but, pl_bui, pl_buib, pl_buiu, pl_bub, pl_buub, pl_pb, pl_buig, pl_buuig, pl_igi, pl_gi, pl_iiit, pl_iit, pl_sg, pl_gs, pl_gussitu, pl_gurrsiu, pl_gus, pl_guut, pl_guuut, pl_guugbuut, pl_pgr, pl_pgu, pl_pgi, pl_gug, pl_pgbi, pl_gu, pl_pg, pl_gui, pl_isigutttiiu, pl_isi, pl_isgt, pl_sig, pl_si, pl_is, pl_bpt;
+ s7_pointer pl_iur, pl_iugi, pl_iuisi, pl_iuuui, pl_iuuuui, pl_iuis, pl_iug, pl_pit, pl_piu, pl_ius, pl_iusi, pl_iu, pl_iuui, pl_pi, pl_iui, pl_iuisut, pl_t, pl_prrru, pl_tts, pl_tti, pl_dusr, pl_dusi, pl_dui, pl_du, pl_dus, pl_pr, pl_ssig, pl_ssi, pl_psgi, pl_suiig, pl_sug, pl_psiuub, pl_psgbiiiit, pl_psrrrb, pl_sui, pl_suuub, pl_psu, pl_psb, pl_su, pl_sus, pl_ps, pl_psg, pl_psi, pl_psugt, pl_psiu, pl_psiiuusu, pl_psut, pl_pur, pl_puuui, pl_pusiig, pl_pusiigu, pl_pusiiugu, pl_puuiig, pl_puur, pl_purru, pl_puiiui, pl_pugi, pl_puuig, pl_puttiiiu, pl_pubi, pl_puiig, pl_puiigi, pl_puigu, pl_puuusuug, pl_pusi, pl_pusiu, pl_putu, pl_puri, pl_pusub, pl_pust, pl_pub, pl_puuiu, pl_pugiiu, pl_pusu, pl_pu, pl_puiiu, pl_puuubu, pl_pugu, pl_puutuuiu, pl_puutu, pl_pui, pl_pussu, pl_puibu, pl_pus, pl_pug, pl_put, pl_pusigu, pl_pusig, pl_puui, pl_puiu, pl_pusiuiu, pl_pusiuibu, pl_pusiiu, pl_puuiiu, pl_b, pl_btiib, pl_bti, pl_bt, pl_tb, pl_g, pl_i, pl_tg, pl_tiu, pl_itiiub, pl_itsub, pl_itstttg, pl_itgiiut, pl_ti, pl_it, pl_s, pl_tsu, pl_tsb, pl_st, pl_tsig, pl_ts, pl_tsi, pl_tsiu, pl_tsiiuui, pl_tsiuui, pl_p, pl_tusiuiui, pl_tuuiu, pl_tussu, pl_tuuuggu, pl_tuuggu, pl_tugiis, pl_tubu, pl_tuurru, pl_tuurrrrgr, pl_tuurrrrg, pl_tuuur, pl_tusg, pl_tuuuui, pl_tugiiu, pl_tuusb, pl_tugui, pl_tuuugi, pl_tuuuub, pl_tuttti, pl_tuuttti, pl_tuisi, pl_tugb, pl_tugs, pl_tugug, pl_turgs, pl_tubi, pl_tuttigsi, pl_tuiiiiui, pl_tuurb, pl_tuuiiiirrrrg, pl_tuuiiiirrrrgi, pl_tuiggu, pl_turrrb, pl_tuubbig, pl_pt, pl_tuuti, pl_tubbi, pl_tuti, pl_tutti, pl_tutui, pl_tutisi, pl_tuuri, pl_tuusit, pl_tuurbr, pl_tuugi, pl_tuit, pl_tusr, pl_tusri, pl_tusi, pl_turi, pl_tuui, pl_tuur, pl_tuig, pl_tur, pl_tub, pl_tui, pl_tu, pl_tus, pl_tusb, pl_tut, pl_tuuut, pl_tug, pl_tutb, pl_tust, pl_tuub, pl_tuus, pl_tuug, pl_tuibu, pl_tuut, pl_tuuig, pl_tuguig, pl_tuubr, pl_tuuub, pl_tuuiuui, pl_tugu, pl_tuuir, pl_tugr, pl_tugi, pl_tuuui, pl_tuib, pl_tusu, pl_tuusi, pl_tugt, pl_tuis, pl_tubiiiu, pl_tuiu, pl_tusiis, pl_tuiiu, pl_tuuug, pl_tusuig, pl_tuuubr, pl_big, pl_bi, pl_bsu, pl_bsigb, pl_bur, pl_buug, pl_buigu, pl_buuti, pl_butib, pl_buiuig, pl_buuusuug, pl_buuit, pl_buti, pl_butti, pl_busi, pl_buusib, pl_busib, pl_buuuub, pl_buuub, pl_buttu, pl_busgu, pl_buurbr, pl_buui, pl_buus, pl_buuui, pl_bug, pl_bu, pl_bus, pl_busu, pl_but, pl_bui, pl_buib, pl_buiu, pl_bub, pl_buub, pl_pb, pl_buig, pl_buuig, pl_igi, pl_gi, pl_iiit, pl_iit, pl_sg, pl_gs, pl_isigutttiiu, pl_isi, pl_isgt, pl_sig, pl_si, pl_is, pl_gussitu, pl_gurrsiu, pl_gus, pl_guut, pl_guuut, pl_guugbuut, pl_pgr, pl_pgu, pl_pgi, pl_gug, pl_pgbi, pl_gu, pl_pg, pl_gui, pl_bpt;
#endif
xm_gc_table = Xen_make_vector(1, Xen_false);
@@ -39725,8 +39761,8 @@ static void define_functions(void)
pl_pugiiu = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_gtk_enum_t, s_integer, s_integer, s_pair_false);
pl_pusu = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_string, s_pair_false);
pl_pu = s7_make_circular_signature(s7, 1, 2, s_pair, s_pair_false);
- pl_puuubu = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_pair_false, s_pair_false, s_boolean, s_pair_false);
pl_puiiu = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_integer, s_integer, s_pair_false);
+ pl_puuubu = s7_make_circular_signature(s7, 5, 6, s_pair, s_pair_false, s_pair_false, s_pair_false, s_boolean, s_pair_false);
pl_pugu = s7_make_circular_signature(s7, 3, 4, s_pair, s_pair_false, s_gtk_enum_t, s_pair_false);
pl_puutuuiu = s7_make_circular_signature(s7, 7, 8, s_pair, s_pair_false, s_pair_false, s_any, s_pair_false, s_pair_false, s_integer, s_pair_false);
pl_puutu = s7_make_circular_signature(s7, 4, 5, s_pair, s_pair_false, s_pair_false, s_any, s_pair_false);
@@ -39750,8 +39786,8 @@ static void define_functions(void)
pl_bt = s7_make_circular_signature(s7, 1, 2, s_boolean, s_any);
pl_tb = s7_make_circular_signature(s7, 1, 2, s_any, s_boolean);
pl_g = s7_make_circular_signature(s7, 0, 1, s_gtk_enum_t);
- pl_tg = s7_make_circular_signature(s7, 1, 2, s_any, s_gtk_enum_t);
pl_i = s7_make_circular_signature(s7, 0, 1, s_integer);
+ pl_tg = s7_make_circular_signature(s7, 1, 2, s_any, s_gtk_enum_t);
pl_tiu = s7_make_circular_signature(s7, 2, 3, s_any, s_integer, s_pair_false);
pl_itiiub = s7_make_circular_signature(s7, 5, 6, s_integer, s_any, s_integer, s_integer, s_pair_false, s_boolean);
pl_itsub = s7_make_circular_signature(s7, 4, 5, s_integer, s_any, s_string, s_pair_false, s_boolean);
@@ -39905,6 +39941,12 @@ static void define_functions(void)
pl_iit = s7_make_circular_signature(s7, 2, 3, s_integer, s_integer, s_any);
pl_sg = s7_make_circular_signature(s7, 1, 2, s_string, s_gtk_enum_t);
pl_gs = s7_make_circular_signature(s7, 1, 2, s_gtk_enum_t, s_string);
+ pl_isigutttiiu = s7_make_circular_signature(s7, 10, 11, s_integer, s_string, s_integer, s_gtk_enum_t, s_pair_false, s_any, s_any, s_any, s_integer, s_integer, s_pair_false);
+ pl_isi = s7_make_circular_signature(s7, 2, 3, s_integer, s_string, s_integer);
+ pl_isgt = s7_make_circular_signature(s7, 3, 4, s_integer, s_string, s_gtk_enum_t, s_any);
+ pl_sig = s7_make_circular_signature(s7, 2, 3, s_string, s_integer, s_gtk_enum_t);
+ pl_si = s7_make_circular_signature(s7, 1, 2, s_string, s_integer);
+ pl_is = s7_make_circular_signature(s7, 1, 2, s_integer, s_string);
pl_gussitu = s7_make_circular_signature(s7, 6, 7, s_gtk_enum_t, s_pair_false, s_string, s_string, s_integer, s_any, s_pair_false);
pl_gurrsiu = s7_make_circular_signature(s7, 6, 7, s_gtk_enum_t, s_pair_false, s_real, s_real, s_string, s_integer, s_pair_false);
pl_gus = s7_make_circular_signature(s7, 2, 3, s_gtk_enum_t, s_pair_false, s_string);
@@ -39919,12 +39961,6 @@ static void define_functions(void)
pl_gu = s7_make_circular_signature(s7, 1, 2, s_gtk_enum_t, s_pair_false);
pl_pg = s7_make_circular_signature(s7, 1, 2, s_pair, s_gtk_enum_t);
pl_gui = s7_make_circular_signature(s7, 2, 3, s_gtk_enum_t, s_pair_false, s_integer);
- pl_isigutttiiu = s7_make_circular_signature(s7, 10, 11, s_integer, s_string, s_integer, s_gtk_enum_t, s_pair_false, s_any, s_any, s_any, s_integer, s_integer, s_pair_false);
- pl_isi = s7_make_circular_signature(s7, 2, 3, s_integer, s_string, s_integer);
- pl_isgt = s7_make_circular_signature(s7, 3, 4, s_integer, s_string, s_gtk_enum_t, s_any);
- pl_sig = s7_make_circular_signature(s7, 2, 3, s_string, s_integer, s_gtk_enum_t);
- pl_si = s7_make_circular_signature(s7, 1, 2, s_string, s_integer);
- pl_is = s7_make_circular_signature(s7, 1, 2, s_integer, s_string);
pl_bpt = s7_make_signature(s7, 2, s_pair_false, s_any);
#endif
@@ -40315,7 +40351,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_entry_get_text, gxg_gtk_entry_get_text_w, 1, 0, 0, H_gtk_entry_get_text, pl_su);
Xg_define_procedure(gtk_entry_get_layout, gxg_gtk_entry_get_layout_w, 1, 0, 0, H_gtk_entry_get_layout, pl_pu);
Xg_define_procedure(gtk_entry_get_layout_offsets, gxg_gtk_entry_get_layout_offsets_w, 1, 2, 0, H_gtk_entry_get_layout_offsets, pl_pu);
- Xg_define_procedure(gtk_event_box_new, gxg_gtk_event_box_new_w, 0, 0, 0, H_gtk_event_box_new, pl_p);
Xg_define_procedure(gtk_fixed_new, gxg_gtk_fixed_new_w, 0, 0, 0, H_gtk_fixed_new, pl_p);
Xg_define_procedure(gtk_fixed_put, gxg_gtk_fixed_put_w, 4, 0, 0, H_gtk_fixed_put, pl_tuui);
Xg_define_procedure(gtk_fixed_move, gxg_gtk_fixed_move_w, 4, 0, 0, H_gtk_fixed_move, pl_tuui);
@@ -41009,7 +41044,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_widget_queue_draw, gxg_gtk_widget_queue_draw_w, 1, 0, 0, H_gtk_widget_queue_draw, pl_tu);
Xg_define_procedure(gtk_widget_queue_draw_area, gxg_gtk_widget_queue_draw_area_w, 5, 0, 0, H_gtk_widget_queue_draw_area, pl_tui);
Xg_define_procedure(gtk_widget_queue_resize, gxg_gtk_widget_queue_resize_w, 1, 0, 0, H_gtk_widget_queue_resize, pl_tu);
- Xg_define_procedure(gtk_widget_size_allocate, gxg_gtk_widget_size_allocate_w, 2, 0, 0, H_gtk_widget_size_allocate, pl_tu);
Xg_define_procedure(gtk_widget_add_accelerator, gxg_gtk_widget_add_accelerator_w, 6, 0, 0, H_gtk_widget_add_accelerator, pl_tusuig);
Xg_define_procedure(gtk_widget_remove_accelerator, gxg_gtk_widget_remove_accelerator_w, 4, 0, 0, H_gtk_widget_remove_accelerator, pl_buuig);
Xg_define_procedure(gtk_widget_list_accel_closures, gxg_gtk_widget_list_accel_closures_w, 1, 0, 0, H_gtk_widget_list_accel_closures, pl_pu);
@@ -41353,10 +41387,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_check_menu_item_get_draw_as_radio, gxg_gtk_check_menu_item_get_draw_as_radio_w, 1, 0, 0, H_gtk_check_menu_item_get_draw_as_radio, pl_bu);
Xg_define_procedure(gtk_entry_set_completion, gxg_gtk_entry_set_completion_w, 2, 0, 0, H_gtk_entry_set_completion, pl_tu);
Xg_define_procedure(gtk_entry_get_completion, gxg_gtk_entry_get_completion_w, 1, 0, 0, H_gtk_entry_get_completion, pl_pu);
- Xg_define_procedure(gtk_event_box_get_visible_window, gxg_gtk_event_box_get_visible_window_w, 1, 0, 0, H_gtk_event_box_get_visible_window, pl_bu);
- Xg_define_procedure(gtk_event_box_set_visible_window, gxg_gtk_event_box_set_visible_window_w, 2, 0, 0, H_gtk_event_box_set_visible_window, pl_tub);
- Xg_define_procedure(gtk_event_box_get_above_child, gxg_gtk_event_box_get_above_child_w, 1, 0, 0, H_gtk_event_box_get_above_child, pl_bu);
- Xg_define_procedure(gtk_event_box_set_above_child, gxg_gtk_event_box_set_above_child_w, 2, 0, 0, H_gtk_event_box_set_above_child, pl_tub);
Xg_define_procedure(gtk_menu_attach, gxg_gtk_menu_attach_w, 6, 0, 0, H_gtk_menu_attach, pl_tuui);
Xg_define_procedure(gtk_text_buffer_select_range, gxg_gtk_text_buffer_select_range_w, 3, 0, 0, H_gtk_text_buffer_select_range, pl_tu);
Xg_define_procedure(gtk_text_view_set_overwrite, gxg_gtk_text_view_set_overwrite_w, 2, 0, 0, H_gtk_text_view_set_overwrite, pl_tub);
@@ -42141,7 +42171,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_widget_set_tooltip_markup, gxg_gtk_widget_set_tooltip_markup_w, 2, 0, 0, H_gtk_widget_set_tooltip_markup, pl_tus);
Xg_define_procedure(gtk_widget_get_tooltip_markup, gxg_gtk_widget_get_tooltip_markup_w, 1, 0, 0, H_gtk_widget_get_tooltip_markup, pl_su);
Xg_define_procedure(gtk_tree_view_is_rubber_banding_active, gxg_gtk_tree_view_is_rubber_banding_active_w, 1, 0, 0, H_gtk_tree_view_is_rubber_banding_active, pl_bu);
- Xg_define_procedure(gtk_icon_view_convert_widget_to_bin_window_coords, gxg_gtk_icon_view_convert_widget_to_bin_window_coords_w, 3, 2, 0, H_gtk_icon_view_convert_widget_to_bin_window_coords, pl_puiiu);
Xg_define_procedure(gtk_icon_view_set_tooltip_item, gxg_gtk_icon_view_set_tooltip_item_w, 3, 0, 0, H_gtk_icon_view_set_tooltip_item, pl_tu);
Xg_define_procedure(gtk_icon_view_set_tooltip_cell, gxg_gtk_icon_view_set_tooltip_cell_w, 4, 0, 0, H_gtk_icon_view_set_tooltip_cell, pl_tu);
Xg_define_procedure(gtk_icon_view_get_tooltip_context, gxg_gtk_icon_view_get_tooltip_context_w, 3, 4, 0, H_gtk_icon_view_get_tooltip_context, pl_puuubu);
@@ -42170,7 +42199,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_entry_set_overwrite_mode, gxg_gtk_entry_set_overwrite_mode_w, 2, 0, 0, H_gtk_entry_set_overwrite_mode, pl_tub);
Xg_define_procedure(gtk_entry_get_overwrite_mode, gxg_gtk_entry_get_overwrite_mode_w, 1, 0, 0, H_gtk_entry_get_overwrite_mode, pl_bu);
Xg_define_procedure(gtk_entry_get_text_length, gxg_gtk_entry_get_text_length_w, 1, 0, 0, H_gtk_entry_get_text_length, pl_iu);
- Xg_define_procedure(gtk_layout_get_bin_window, gxg_gtk_layout_get_bin_window_w, 1, 0, 0, H_gtk_layout_get_bin_window, pl_pu);
Xg_define_procedure(gtk_menu_get_accel_path, gxg_gtk_menu_get_accel_path_w, 1, 0, 0, H_gtk_menu_get_accel_path, pl_su);
Xg_define_procedure(gtk_menu_get_monitor, gxg_gtk_menu_get_monitor_w, 1, 0, 0, H_gtk_menu_get_monitor, pl_iu);
Xg_define_procedure(gtk_menu_item_get_accel_path, gxg_gtk_menu_item_get_accel_path_w, 1, 0, 0, H_gtk_menu_item_get_accel_path, pl_su);
@@ -42371,7 +42399,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_range_get_slider_size_fixed, gxg_gtk_range_get_slider_size_fixed_w, 1, 0, 0, H_gtk_range_get_slider_size_fixed, pl_bu);
Xg_define_procedure(gtk_range_get_range_rect, gxg_gtk_range_get_range_rect_w, 2, 0, 0, H_gtk_range_get_range_rect, pl_tu);
Xg_define_procedure(gtk_range_get_slider_range, gxg_gtk_range_get_slider_range_w, 1, 2, 0, H_gtk_range_get_slider_range, pl_pu);
- Xg_define_procedure(gtk_paned_get_handle_window, gxg_gtk_paned_get_handle_window_w, 1, 0, 0, H_gtk_paned_get_handle_window, pl_pu);
Xg_define_procedure(gtk_widget_set_realized, gxg_gtk_widget_set_realized_w, 2, 0, 0, H_gtk_widget_set_realized, pl_tub);
Xg_define_procedure(gtk_widget_get_realized, gxg_gtk_widget_get_realized_w, 1, 0, 0, H_gtk_widget_get_realized, pl_bu);
Xg_define_procedure(gtk_widget_get_mapped, gxg_gtk_widget_get_mapped_w, 1, 0, 0, H_gtk_widget_get_mapped, pl_bu);
@@ -42789,7 +42816,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_grid_get_row_baseline_position, gxg_gtk_grid_get_row_baseline_position_w, 2, 0, 0, H_gtk_grid_get_row_baseline_position, pl_gui);
Xg_define_procedure(gtk_grid_set_baseline_row, gxg_gtk_grid_set_baseline_row_w, 2, 0, 0, H_gtk_grid_set_baseline_row, pl_tui);
Xg_define_procedure(gtk_grid_get_baseline_row, gxg_gtk_grid_get_baseline_row_w, 1, 0, 0, H_gtk_grid_get_baseline_row, pl_iu);
- Xg_define_procedure(gtk_widget_size_allocate_with_baseline, gxg_gtk_widget_size_allocate_with_baseline_w, 3, 0, 0, H_gtk_widget_size_allocate_with_baseline, pl_tuui);
Xg_define_procedure(gtk_widget_get_allocated_baseline, gxg_gtk_widget_get_allocated_baseline_w, 1, 0, 0, H_gtk_widget_get_allocated_baseline, pl_iu);
Xg_define_procedure(gtk_widget_init_template, gxg_gtk_widget_init_template_w, 1, 0, 0, H_gtk_widget_init_template, pl_tu);
Xg_define_procedure(gtk_window_set_titlebar, gxg_gtk_window_set_titlebar_w, 2, 0, 0, H_gtk_window_set_titlebar, pl_tu);
@@ -42979,7 +43005,6 @@ static void define_functions(void)
Xg_define_procedure(gtk_switch_set_state, gxg_gtk_switch_set_state_w, 2, 0, 0, H_gtk_switch_set_state, pl_tub);
Xg_define_procedure(gtk_switch_get_state, gxg_gtk_switch_get_state_w, 1, 0, 0, H_gtk_switch_get_state, pl_bu);
Xg_define_procedure(gdk_window_show_window_menu, gxg_gdk_window_show_window_menu_w, 2, 0, 0, H_gdk_window_show_window_menu, pl_bu);
- Xg_define_procedure(gtk_widget_set_clip, gxg_gtk_widget_set_clip_w, 2, 0, 0, H_gtk_widget_set_clip, pl_tu);
Xg_define_procedure(gtk_widget_get_clip, gxg_gtk_widget_get_clip_w, 2, 0, 0, H_gtk_widget_get_clip, pl_tu);
Xg_define_procedure(gtk_gesture_get_device, gxg_gtk_gesture_get_device_w, 1, 0, 0, H_gtk_gesture_get_device, pl_pu);
Xg_define_procedure(gtk_gesture_set_state, gxg_gtk_gesture_set_state_w, 2, 0, 0, H_gtk_gesture_set_state, pl_bui);
@@ -43304,6 +43329,20 @@ static void define_functions(void)
Xg_define_procedure(gdk_event_get_user_data, gxg_gdk_event_get_user_data_w, 1, 0, 0, H_gdk_event_get_user_data, pl_pu);
Xg_define_procedure(gdk_rectangle_contains_point, gxg_gdk_rectangle_contains_point_w, 3, 0, 0, H_gdk_rectangle_contains_point, pl_bui);
Xg_define_procedure(gtk_get_event_target, gxg_gtk_get_event_target_w, 1, 0, 0, H_gtk_get_event_target, pl_pu);
+ Xg_define_procedure(gtk_accel_label_set_label, gxg_gtk_accel_label_set_label_w, 2, 0, 0, H_gtk_accel_label_set_label, pl_tus);
+ Xg_define_procedure(gtk_accel_label_get_label, gxg_gtk_accel_label_get_label_w, 1, 0, 0, H_gtk_accel_label_get_label, pl_su);
+ Xg_define_procedure(gtk_accel_label_set_use_underline, gxg_gtk_accel_label_set_use_underline_w, 2, 0, 0, H_gtk_accel_label_set_use_underline, pl_tub);
+ Xg_define_procedure(gtk_accel_label_get_use_underline, gxg_gtk_accel_label_get_use_underline_w, 1, 0, 0, H_gtk_accel_label_get_use_underline, pl_bu);
+ Xg_define_procedure(gtk_scrollbar_set_adjustment, gxg_gtk_scrollbar_set_adjustment_w, 2, 0, 0, H_gtk_scrollbar_set_adjustment, pl_tu);
+ Xg_define_procedure(gtk_scrollbar_get_adjustment, gxg_gtk_scrollbar_get_adjustment_w, 1, 0, 0, H_gtk_scrollbar_get_adjustment, pl_pu);
+ Xg_define_procedure(gtk_scrollbar_get_wheel_delta, gxg_gtk_scrollbar_get_wheel_delta_w, 2, 0, 0, H_gtk_scrollbar_get_wheel_delta, pl_du);
+ Xg_define_procedure(gtk_spin_button_get_text, gxg_gtk_spin_button_get_text_w, 1, 0, 0, H_gtk_spin_button_get_text, pl_su);
+ Xg_define_procedure(gtk_spin_button_set_text, gxg_gtk_spin_button_set_text_w, 2, 0, 0, H_gtk_spin_button_set_text, pl_tus);
+ Xg_define_procedure(gtk_spin_button_get_max_width_chars, gxg_gtk_spin_button_get_max_width_chars_w, 1, 0, 0, H_gtk_spin_button_get_max_width_chars, pl_iu);
+ Xg_define_procedure(gtk_spin_button_set_max_width_chars, gxg_gtk_spin_button_set_max_width_chars_w, 2, 0, 0, H_gtk_spin_button_set_max_width_chars, pl_tui);
+ Xg_define_procedure(gtk_spin_button_get_width_chars, gxg_gtk_spin_button_get_width_chars_w, 1, 0, 0, H_gtk_spin_button_get_width_chars, pl_iu);
+ Xg_define_procedure(gtk_spin_button_set_width_chars, gxg_gtk_spin_button_set_width_chars_w, 2, 0, 0, H_gtk_spin_button_set_width_chars, pl_tui);
+ Xg_define_procedure(gtk_widget_size_allocate, gxg_gtk_widget_size_allocate_w, 4, 0, 0, H_gtk_widget_size_allocate, pl_tuuiu);
#endif
Xg_define_procedure(cairo_create, gxg_cairo_create_w, 1, 0, 0, H_cairo_create, pl_pu);
@@ -43602,7 +43641,6 @@ static void define_functions(void)
Xg_define_procedure(GTK_DRAWING_AREA, gxg_GTK_DRAWING_AREA_w, 1, 0, 0, "(GTK_DRAWING_AREA obj) casts obj to GTK_DRAWING_AREA", pl_bpt);
Xg_define_procedure(GTK_EDITABLE, gxg_GTK_EDITABLE_w, 1, 0, 0, "(GTK_EDITABLE obj) casts obj to GTK_EDITABLE", pl_bpt);
Xg_define_procedure(GTK_ENTRY, gxg_GTK_ENTRY_w, 1, 0, 0, "(GTK_ENTRY obj) casts obj to GTK_ENTRY", pl_bpt);
- Xg_define_procedure(GTK_EVENT_BOX, gxg_GTK_EVENT_BOX_w, 1, 0, 0, "(GTK_EVENT_BOX obj) casts obj to GTK_EVENT_BOX", pl_bpt);
Xg_define_procedure(GTK_FIXED, gxg_GTK_FIXED_w, 1, 0, 0, "(GTK_FIXED obj) casts obj to GTK_FIXED", pl_bpt);
Xg_define_procedure(GTK_FRAME, gxg_GTK_FRAME_w, 1, 0, 0, "(GTK_FRAME obj) casts obj to GTK_FRAME", pl_bpt);
Xg_define_procedure(GTK_IMAGE, gxg_GTK_IMAGE_w, 1, 0, 0, "(GTK_IMAGE obj) casts obj to GTK_IMAGE", pl_bpt);
@@ -43827,6 +43865,7 @@ static void define_functions(void)
#else
Xg_define_procedure(gtk_init, gxg_gtk_init_w, 0, 2, 0, H_gtk_init, NULL);
Xg_define_procedure(gtk_init_check, gxg_gtk_init_check_w, 0, 2, 0, H_gtk_init_check, NULL);
+ Xg_define_procedure(gtk_widget_set_events, gxg_gtk_widget_set_events_w, 2, 0, 0, H_gtk_widget_set_events, pl_tui);
#endif
Xg_define_procedure(GDK_IS_DRAG_CONTEXT, gxg_GDK_IS_DRAG_CONTEXT_w, 1, 0, 0, "(GDK_IS_DRAG_CONTEXT obj): " PROC_TRUE " if obj is a GdkDragContext*", pl_bt);
Xg_define_procedure(GDK_IS_DEVICE, gxg_GDK_IS_DEVICE_w, 1, 0, 0, "(GDK_IS_DEVICE obj): " PROC_TRUE " if obj is a GdkDevice*", pl_bt);
@@ -43857,7 +43896,6 @@ static void define_functions(void)
Xg_define_procedure(GTK_IS_DRAWING_AREA, gxg_GTK_IS_DRAWING_AREA_w, 1, 0, 0, "(GTK_IS_DRAWING_AREA obj): " PROC_TRUE " if obj is a GtkDrawingArea*", pl_bt);
Xg_define_procedure(GTK_IS_EDITABLE, gxg_GTK_IS_EDITABLE_w, 1, 0, 0, "(GTK_IS_EDITABLE obj): " PROC_TRUE " if obj is a GtkEditable*", pl_bt);
Xg_define_procedure(GTK_IS_ENTRY, gxg_GTK_IS_ENTRY_w, 1, 0, 0, "(GTK_IS_ENTRY obj): " PROC_TRUE " if obj is a GtkEntry*", pl_bt);
- Xg_define_procedure(GTK_IS_EVENT_BOX, gxg_GTK_IS_EVENT_BOX_w, 1, 0, 0, "(GTK_IS_EVENT_BOX obj): " PROC_TRUE " if obj is a GtkEventBox*", pl_bt);
Xg_define_procedure(GTK_IS_FIXED, gxg_GTK_IS_FIXED_w, 1, 0, 0, "(GTK_IS_FIXED obj): " PROC_TRUE " if obj is a GtkFixed*", pl_bt);
Xg_define_procedure(GTK_IS_FRAME, gxg_GTK_IS_FRAME_w, 1, 0, 0, "(GTK_IS_FRAME obj): " PROC_TRUE " if obj is a GtkFrame*", pl_bt);
Xg_define_procedure(GTK_IS_IMAGE, gxg_GTK_IS_IMAGE_w, 1, 0, 0, "(GTK_IS_IMAGE obj): " PROC_TRUE " if obj is a GtkImage*", pl_bt);
@@ -45499,6 +45537,8 @@ static void define_atoms(void)
static void define_symbols(void)
{
+ xg_GdkEventScroll__symbol = C_string_to_Xen_symbol("GdkEventScroll_");
+ xg_GtkScrollbar__symbol = C_string_to_Xen_symbol("GtkScrollbar_");
xg_GtkCenterBox__symbol = C_string_to_Xen_symbol("GtkCenterBox_");
xg_GtkCheckButton__symbol = C_string_to_Xen_symbol("GtkCheckButton_");
xg_GdkDrawContext__symbol = C_string_to_Xen_symbol("GdkDrawContext_");
@@ -45538,6 +45578,7 @@ static void define_symbols(void)
xg_GdkEventSequence__symbol = C_string_to_Xen_symbol("GdkEventSequence_");
xg_GtkEventSequenceState_symbol = C_string_to_Xen_symbol("GtkEventSequenceState");
xg_GtkGesture__symbol = C_string_to_Xen_symbol("GtkGesture_");
+ xg_GtkAllocation__symbol = C_string_to_Xen_symbol("GtkAllocation_");
xg_GtkPopover__symbol = C_string_to_Xen_symbol("GtkPopover_");
xg_GtkActionBar__symbol = C_string_to_Xen_symbol("GtkActionBar_");
xg_GtkFlowBox__symbol = C_string_to_Xen_symbol("GtkFlowBox_");
@@ -45724,7 +45765,6 @@ static void define_symbols(void)
xg_GtkTreeModelFilter__symbol = C_string_to_Xen_symbol("GtkTreeModelFilter_");
xg_GtkFileChooserAction_symbol = C_string_to_Xen_symbol("GtkFileChooserAction");
xg_GtkToolItem__symbol = C_string_to_Xen_symbol("GtkToolItem_");
- xg_GtkEventBox__symbol = C_string_to_Xen_symbol("GtkEventBox_");
xg_GtkCalendarDisplayOptions_symbol = C_string_to_Xen_symbol("GtkCalendarDisplayOptions");
xg_GdkScreen__symbol = C_string_to_Xen_symbol("GdkScreen_");
xg_PangoLayoutRun__symbol = C_string_to_Xen_symbol("PangoLayoutRun_");
@@ -45769,7 +45809,6 @@ static void define_symbols(void)
xg_GtkTextDirection_symbol = C_string_to_Xen_symbol("GtkTextDirection");
xg_AtkObject__symbol = C_string_to_Xen_symbol("AtkObject_");
xg_GtkDirectionType_symbol = C_string_to_Xen_symbol("GtkDirectionType");
- xg_GtkAllocation__symbol = C_string_to_Xen_symbol("GtkAllocation_");
xg_GtkViewport__symbol = C_string_to_Xen_symbol("GtkViewport_");
xg_GtkTreeViewSearchEqualFunc_symbol = C_string_to_Xen_symbol("GtkTreeViewSearchEqualFunc");
xg_GtkTreeViewDropPosition_symbol = C_string_to_Xen_symbol("GtkTreeViewDropPosition");
@@ -45987,14 +46026,12 @@ static void define_symbols(void)
xg_PangoFontDescription__symbol = C_string_to_Xen_symbol("PangoFontDescription_");
xg_idler_symbol = C_string_to_Xen_symbol("idler");
xg_GtkCellRendererPixbuf__symbol = C_string_to_Xen_symbol("GtkCellRendererPixbuf_");
- xg_GtkScrollbar__symbol = C_string_to_Xen_symbol("GtkScrollbar_");
xg_GtkSeparator__symbol = C_string_to_Xen_symbol("GtkSeparator_");
xg_GtkSeparatorMenuItem__symbol = C_string_to_Xen_symbol("GtkSeparatorMenuItem_");
xg_GdkEventExpose__symbol = C_string_to_Xen_symbol("GdkEventExpose_");
xg_GdkEventNoExpose__symbol = C_string_to_Xen_symbol("GdkEventNoExpose_");
xg_GdkEventVisibility__symbol = C_string_to_Xen_symbol("GdkEventVisibility_");
xg_GdkEventButton__symbol = C_string_to_Xen_symbol("GdkEventButton_");
- xg_GdkEventScroll__symbol = C_string_to_Xen_symbol("GdkEventScroll_");
xg_GdkEventCrossing__symbol = C_string_to_Xen_symbol("GdkEventCrossing_");
xg_GdkEventFocus__symbol = C_string_to_Xen_symbol("GdkEventFocus_");
xg_GdkEventConfigure__symbol = C_string_to_Xen_symbol("GdkEventConfigure_");
@@ -47310,7 +47347,7 @@ void Init_libxg(void)
Xen_provide_feature("gtk2");
#endif
#endif
- Xen_define("xg-version", C_string_to_Xen_string("01-Aug-17"));
+ Xen_define("xg-version", C_string_to_Xen_string("08-Sep-17"));
xg_already_inited = true;
#if HAVE_SCHEME
#if USE_SND
diff --git a/xm.c b/xm.c
index a9e999f..fd105ad 100644
--- a/xm.c
+++ b/xm.c
@@ -387,7 +387,9 @@ static Xen make_xm_obj(void *ptr)
static void define_xm_obj(void)
{
#if HAVE_SCHEME
- xm_obj_tag = s7_new_type_x(s7, "<XmObj>", NULL, xm_obj_free, s7_equalp_xm, NULL, NULL, NULL, NULL, NULL, NULL, NULL);
+ xm_obj_tag = s7_make_c_type(s7, "<XmObj>");
+ s7_c_type_set_free(s7, xm_obj_tag, xm_obj_free);
+ s7_c_type_set_equal(s7, xm_obj_tag, s7_equalp_xm);
#else
xm_obj_tag = Xen_make_object_type("XmObj", sizeof(void *));
#endif